scilab/modules/signal_processing/sci_gateway/cpp/sci_corr.cpp

   1 /*
   2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
   3 * Copyright (C) 2011 - DIGITEO - Antoine ELIAS
   4 *
   5 * This file must be used under the terms of the CeCILL.
   6 * This source file is licensed as described in the file COPYING, which
   7 * you should have received as part of this distribution.  The terms
   8 * are also available at
   9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
  10 *
  11 */
  12 /*--------------------------------------------------------------------------*/
  13
  14 #include "signal_gw.hxx"
  15 #include "double.hxx"
  16 #include "string.hxx"
  17 #include "function.hxx"
  18
  19 extern "C"
  20 {
  21 #include "localization.h"
  22 #include "Scierror.h"
  23 #include "sciprint.h"
  24
  25 //fortran prototypes
  26 extern void C2F(tscccf)(double *x, double *y, int *length, double *cxy, double *xymean, int *lag, int *error);
  27
  28 }
  29
  30 /*--------------------------------------------------------------------------*/
  31 types::Function::ReturnValue sci_corr(types::typed_list &in, int _iRetCount, types::typed_list &out)
  32 {
  33     //check input parameters
  34     if(in.size() < 2 || in.size() > 5)
  35     {
  36         ScierrorW(77, _W("%ls: Wrong number of input argument(s): %d to %d expected.\n"), L"corr", 2, 5);
  37         return types::Function::Error;
  38     }
  39
  40     //call format
  41     if(in[0]->isString())
  42     {
  43         sciprintW(_W("%ls: Need to plug external call"), L"corr");
  44         return types::Function::Error;
  45
  46         types::String* pS = in[0]->getAs<types::String>();
  47         if(pS->getSize() == 1 && pS->get(0)[0] == L'f')
  48         {//[cov,mean]=corr('fft',xmacro,[ymacro],n,sect)
  49             int iErr                    = 0;
  50             int iSect                   = 0;
  51             int iTotalSize              = 0;
  52             int iSize                   = 0;
  53             int iMode                   = 0;
  54             types::Callable* pXFunction = NULL;
  55             types::Callable* pYFunction = NULL;
  56
  57             //check input parameters
  58             if(in.size() < 4 || in.size() > 5)
  59             {
  60                 ScierrorW(77, _W("%ls: Wrong number of input argument(s): %d to %d expected.\n"), L"corr", 4, 5);
  61                 return types::Function::Error;
  62             }
  63
  64             //get parameter sect
  65             int iPos = (int)(in.size() - 1);
  66             if(in[iPos]->isDouble() == false || in[iPos]->getAs<types::Double>()->isScalar() == false)
  67             {
  68                 ScierrorW(999, _W("%ls: Wrong type for input argument #%d: A scalar expected.\n"), L"corr", iPos + 1);
  69                 return types::Function::Error;
  70             }
  71
  72             iSect = (int)in[iPos]->getAs<types::Double>()->get(0);
  73
  74             //get parameter n
  75             iPos--;
  76             if(in[iPos]->isDouble() == false || in[iPos]->getAs<types::Double>()->isScalar() == false)
  77             {
  78                 ScierrorW(999, _W("%ls: Wrong type for input argument #%d: A scalar expected.\n"), L"corr", iPos + 1);
  79                 return types::Function::Error;
  80             }
  81
  82             iTotalSize = (int)in[iPos]->getAs<types::Double>()->get(0);
  83
  84             //get xmacro
  85             if(in[1]->isCallable() == false)
  86             {
  87                 ScierrorW(999, _W("%ls: Wrong type for input argument #%d: A function expected.\n"), L"corr", 2);
  88                 return types::Function::Error;
  89             }
  90
  91             pXFunction = in[1]->getAs<types::Callable>();
  92             iMode = 2;
  93
  94             if(in.size() == 5)
  95             {
  96                 //get ymacro
  97                 if(in[2]->isCallable() == false)
  98                 {
  99                     ScierrorW(999, _W("%ls: Wrong type for input argument #%d: A function expected.\n"), L"corr", 3);
 100                     return types::Function::Error;
 101                 }
 102
 103                 pYFunction = in[2]->getAs<types::Callable>();
 104                 iMode = 3;
 105             }
 106
 107         }
 108         else if(pS->getSize() == 1 && pS->get(0)[0] == L'u')
 109         {//update
 110         }
 111         else
 112         {//error
 113             ScierrorW(999, _W("%ls: Wrong value for input argument #%d: Must be in the set {%ls}.\n"), L"corr", 1, L"'fft', 'update'");
 114             return types::Function::Error;
 115         }
 116     }
 117     else
 118     {//usual case [cov,mean]=corr(x,[y],nlags)
 119         int iErr                        = 0;
 120         int iCorrelation                = 0;
 121         types::Double* pDblX            = NULL;
 122         types::Double* pDblY            = NULL;
 123         types::Double* pDblCorrelation  = NULL;
 124         types::Double* pDblMean         = NULL;
 125         int iSize                       = 0;
 126         double pdblMean[2];
 127
 128
 129         //check input parameters
 130         if(in.size() < 2 || in.size() > 3)
 131         {
 132             ScierrorW(77, _W("%ls: Wrong number of input argument(s): %d to %d expected.\n"), L"corr", 2, 3);
 133             return types::Function::Error;
 134         }
 135
 136         //get last parameter nlags
 137         int iPos = (int)(in.size() - 1);
 138         if(in[iPos]->isDouble() == false || in[iPos]->getAs<types::Double>()->isScalar() == false)
 139         {
 140             ScierrorW(999, _W("%ls: Wrong type for input argument #%d: A scalar expected.\n"), L"corr", iPos + 1);
 141             return types::Function::Error;
 142         }
 143
 144         iCorrelation = (int)in[iPos]->getAs<types::Double>()->get(0);
 145         pDblCorrelation = new types::Double(1, iCorrelation);
 146
 147         if(in.size() == 3)
 148         {
 149             if(in[1]->isDouble() == false)
 150             {
 151                 ScierrorW(999, _W("%ls: Wrong type for input argument #%d: Matrix expected.\n"), L"corr" ,2);
 152                 return types::Function::Error;
 153             }
 154
 155             pDblY = in[1]->getAs<types::Double>();
 156
 157             if(in[0]->isDouble() == false)
 158             {
 159                 ScierrorW(999, _W("%ls: Wrong type for input argument #%d: Matrix expected.\n"), L"corr" ,1);
 160                 return types::Function::Error;
 161             }
 162
 163             pDblX = in[0]->getAs<types::Double>();
 164
 165             if(pDblX->getSize() != pDblY->getSize())
 166             {
 167                 ScierrorW(60, _W("%ls: Wrong size for argument: Incompatible dimensions.\n"), L"corr");
 168                 return types::Function::Error;
 169             }
 170         }
 171         else
 172         {
 173             if(in[0]->isDouble() == false)
 174             {
 175                 ScierrorW(999, _W("%ls: Wrong type for input argument #%d: Matrix expected.\n"), L"corr" ,1);
 176                 return types::Function::Error;
 177             }
 178
 179             pDblX = in[0]->getAs<types::Double>();
 180             pDblY = pDblX;
 181         }
 182
 183         iSize = pDblX->getSize();
 184
 185         C2F(tscccf)(pDblX->get(), pDblY->get(), &iSize, pDblCorrelation->get(), pdblMean, &iCorrelation, &iErr);
 186         if(iErr == -1)
 187         {
 188             ScierrorW(999, _W("%ls: Too many coefficients are required.\n"), L"corr");
 189             return types::Function::Error;
 190         }
 191
 192         out.push_back(pDblCorrelation);
 193
 194         if(_iRetCount == 2)
 195         {
 196             if(in.size() == 3)
 197             {
 198                 pDblMean = new types::Double(1, 2);
 199             }
 200             else
 201             {
 202                 pDblMean = new types::Double(1, 1);
 203             }
 204
 205             pDblMean->set(pdblMean);
 206             out.push_back(pDblMean);
 207         }
 208     }
 209     return types::Function::OK;
 210 }