utf: module signal_processing
[scilab.git] / scilab / modules / signal_processing / sci_gateway / cpp / sci_corr.cpp
index cff64bc..d8df066 100644 (file)
@@ -1,6 +1,8 @@
 /*
 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
 * Copyright (C) 2011 - DIGITEO - Antoine ELIAS
+* Copyright (C) 2014 - Scilab Enterprises - Anais AUBERT
+* Copyright (C) 2014 - Scilab Enterprises - Sylvain GENIN
 *
 * This file must be used under the terms of the CeCILL.
 * This source file is licensed as described in the file COPYING, which
@@ -14,7 +16,9 @@
 #include "signal_gw.hxx"
 #include "double.hxx"
 #include "string.hxx"
+#include "internal.hxx"
 #include "function.hxx"
+#include "signalprocessingfunctions.hxx"
 
 extern "C"
 {
@@ -22,100 +26,374 @@ extern "C"
 #include "Scierror.h"
 #include "sciprint.h"
 
-//fortran prototypes
-extern void C2F(tscccf)(double *x, double *y, int *length, double *cxy, double *xymean, int *lag, int *error);
-
 }
 
 /*--------------------------------------------------------------------------*/
 types::Function::ReturnValue sci_corr(types::typed_list &in, int _iRetCount, types::typed_list &out)
 {
     //check input parameters
-    if(in.size() < 2 || in.size() > 5)
+    if (in.size() < 2 || in.size() > 5)
     {
-        ScierrorW(77, _W("%ls: Wrong number of input argument(s): %d to %d expected.\n"), L"corr", 2, 5);
+        Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "corr", 2, 5);
         return types::Function::Error;
     }
 
     //call format
-    if(in[0]->isString())
+    if (in[0]->isString())
     {
-        sciprintW(_W("%ls: Need to plug external call"), L"corr");
-        return types::Function::Error;
-
         types::String* pS = in[0]->getAs<types::String>();
-        if(pS->getSize() == 1 && pS->get(0)[0] == L'f')
-        {//[cov,mean]=corr('fft',xmacro,[ymacro],n,sect)
-            int iErr                    = 0;
-            int iSect                   = 0;
-            int iTotalSize              = 0;
-            int iSize                   = 0;
-            int iMode                   = 0;
-            types::Callable* pXFunction = NULL;
-            types::Callable* pYFunction = NULL;
+        if (pS->getSize() == 1 && pS->get(0)[0] == L'f')
+        {
+            //[cov,mean]=corr('fft',xmacro,[ymacro],n,sect)
+            types::InternalType* pXFunction = NULL;
+            types::InternalType* pYFunction = NULL;
+
+            int iErr        = 0;
+            int iSect       = 0;
+            int iOutSize    = 0;
+            int iTotalSize  = 0;
+            int iSize       = 0;
+            int iMode       = 0;
+
+            double* xa = NULL;
+            double* xi = NULL;
+            double* xr = NULL;
+            double* zr = NULL;
+            double* zi = NULL;
+
+            char *dx = NULL;
+            char *dy = NULL;
+            bool bOK = false;
 
             //check input parameters
-            if(in.size() < 4 || in.size() > 5)
+            if (in.size() < 4 || in.size() > 5)
             {
-                ScierrorW(77, _W("%ls: Wrong number of input argument(s): %d to %d expected.\n"), L"corr", 4, 5);
+                Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "corr", 4, 5);
                 return types::Function::Error;
             }
 
             //get parameter sect
             int iPos = (int)(in.size() - 1);
-            if(in[iPos]->isDouble() == false || in[iPos]->getAs<types::Double>()->isScalar() == false)
+            if (in[iPos]->isDouble() == false || in[iPos]->getAs<types::Double>()->isScalar() == false)
             {
-                ScierrorW(999, _W("%ls: Wrong type for input argument #%d: A scalar expected.\n"), L"corr", iPos + 1);
+                Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "corr", iPos + 1);
                 return types::Function::Error;
             }
 
-            iSect = (int)in[iPos]->getAs<types::Double>()->get(0);
+            iOutSize = (int)in[iPos]->getAs<types::Double>()->get(0);
+            iSect = iOutSize * 2;
 
             //get parameter n
             iPos--;
-            if(in[iPos]->isDouble() == false || in[iPos]->getAs<types::Double>()->isScalar() == false)
+            if (in[iPos]->isDouble() == false || in[iPos]->getAs<types::Double>()->isScalar() == false)
             {
-                ScierrorW(999, _W("%ls: Wrong type for input argument #%d: A scalar expected.\n"), L"corr", iPos + 1);
+                Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "corr", iPos + 1);
                 return types::Function::Error;
             }
 
             iTotalSize = (int)in[iPos]->getAs<types::Double>()->get(0);
 
+            Signalprocessingfunctions* spFunctionsManager = new Signalprocessingfunctions("corr");
+            Signalprocessing::addSignalprocessingfunctions(spFunctionsManager);
+
             //get xmacro
-            if(in[1]->isCallable() == false)
+            if (in[1]->isCallable())
+            {
+                pXFunction = in[1]->getAs<types::Callable>();
+                spFunctionsManager->setDgetx(in[1]->getAs<types::Callable>());
+            }
+            else if (in[1]->isString())
             {
-                ScierrorW(999, _W("%ls: Wrong type for input argument #%d: A function expected.\n"), L"corr", 2);
+                pXFunction = in[1]->getAs<types::String>();
+                spFunctionsManager->setDgetx(in[1]->getAs<types::String>());
+            }
+            else
+            {
+                Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "corr", iPos + 1);
                 return types::Function::Error;
             }
 
-            pXFunction = in[1]->getAs<types::Callable>();
             iMode = 2;
 
-            if(in.size() == 5)
+            if (in.size() == 5)
             {
                 //get ymacro
-                if(in[2]->isCallable() == false)
+                if (in[2]->isCallable())
+                {
+                    pYFunction = in[2]->getAs<types::Callable>();
+                    spFunctionsManager->setDgety(in[2]->getAs<types::Callable>());
+                }
+                else if (in[2]->isString())
+                {
+                    pYFunction = in[2]->getAs<types::String>();
+                    spFunctionsManager->setDgety(in[2]->getAs<types::String>());
+                }
+                else
                 {
-                    ScierrorW(999, _W("%ls: Wrong type for input argument #%d: A function expected.\n"), L"corr", 3);
+                    Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "corr", iPos + 2);
                     return types::Function::Error;
                 }
 
-                pYFunction = in[2]->getAs<types::Callable>();
                 iMode = 3;
             }
 
+            xa = new double[iSect];
+            xr = new double[iSect];
+            xi = new double[iSect];
+            zr = new double[iSect / 2 + 1];
+            zi = new double[iSect / 2 + 1];
+            C2F(cmpse2)(&iSect, &iTotalSize, &iMode, (void*) dgetx_f, (void*) dgety_f, xa, xr, xi, zr, zi, &iErr);
+
+            delete[] xi;
+            delete[] zr;
+            delete[] zi;
+
+            if (iErr > 0)
+            {
+                delete[] xa;
+                delete[] xr;
+                Scierror(999, _("fft call : needs power of two!"));
+                return types::Function::Error;
+            }
+
+            types::Double *pDblOut1 = new types::Double(1, iOutSize);
+            pDblOut1->set(xa);
+            delete[] xa;
+            out.push_back(pDblOut1);
+
+            types::Double *pDblOut2 = new types::Double(1, iMode - 1);
+            pDblOut2->set(xr);
+            delete[] xr;
+            out.push_back(pDblOut2);
+
+            return types::Function::OK;
         }
-        else if(pS->getSize() == 1 && pS->get(0)[0] == L'u')
-        {//update
+        else if (pS->getSize() == 1 && pS->get(0)[0] == L'u')
+        {
+            types::Double* pDblIn1 = NULL;
+            types::Double* pDblIn2 = NULL;
+            types::Double* pDblIn3 = NULL;
+            types::Double* pDblIn4 = NULL;
+
+            int iErr = 0;
+            int mnx = 0;
+            int mny = 0;
+            int mfft = 0;
+            int nbx = 0;
+            int ichaud = 0;
+            int iMode = 0;
+
+            double* x = NULL;
+            double* xu = NULL;
+            double* xui = NULL;
+            double* w = NULL;
+            double* wi = NULL;
+            double* y = NULL;
+            double* yi = NULL;
+
+            if (in[1]->isDouble() == false)
+            {
+                Scierror(999, _("%s: Wrong type for input argument #%d: Matrix expected.\n"), "corr" , 2);
+                return types::Function::Error;
+            }
+
+            pDblIn1 = in[1]->getAs<types::Double>();
+            if (pDblIn1->isComplex())
+            {
+                Scierror(999, _("%s: Wrong type for input argument #%d: Real matrix expected.\n"), "corr" , 2);
+                return types::Function::Error;
+            }
+
+            mnx = pDblIn1->getRows() * pDblIn1->getCols();
+
+            x = pDblIn1->get();
+
+
+            if (in[2]->isDouble() == false)
+            {
+                Scierror(999, _("%s: Wrong type for input argument #%d: Matrix expected.\n"), "corr" , 3);
+                return types::Function::Error;
+            }
+
+            pDblIn2 = in[2]->getAs<types::Double>();
+
+            mny = pDblIn2->getRows() * pDblIn2->getCols();
+
+            if (mnx == mny)
+            {
+                iMode = 1;
+                if (pDblIn2->isComplex())
+                {
+                    Scierror(999, _("%s: Wrong type for input argument #%d: Real matrix expected.\n"), "corr" , 3);
+                    return types::Function::Error;
+                }
+
+                y = pDblIn2->get();
+            }
+
+            if (iMode == 0)
+            {
+                mfft = mny;
+                if (pDblIn2->isComplex() == false)
+                {
+                    double* wtempo = NULL;
+                    w = new double[pDblIn2->getSize()];
+                    wi = new double[mfft];
+                    memset(wi, 0x00, sizeof(double) * mfft);
+
+                    wtempo = pDblIn2->get();
+                    memcpy(w, wtempo, sizeof(double) * pDblIn2->getSize());
+                }
+                else
+                {
+                    double* wtempo = NULL;
+                    double* witempo = NULL;
+                    w = new double[pDblIn2->getSize()];
+                    wi = new double[pDblIn2->getSize()];
+
+                    wtempo = pDblIn2->getReal();
+                    witempo = pDblIn2->getImg();
+
+                    memcpy(w, wtempo, sizeof(double) * pDblIn2->getSize());
+                    memcpy(wi, witempo, sizeof(double) * pDblIn2->getSize());
+                }
+
+
+                if (in.size() == 4)
+                {
+                    pDblIn3 = in[3]->getAs<types::Double>();
+                    if (pDblIn3->isComplex())
+                    {
+                        Scierror(999, _("%s: Wrong type for input argument #%d: Real matrix expected.\n"), "corr" , 4);
+                        return types::Function::Error;
+                    }
+
+                    xui = new double[mfft * 2];
+                    double* xutempo = NULL;
+                    xutempo = pDblIn3->get();
+                    xu = new double[mfft * 2];
+                    memset(xu, 0x00, sizeof(double) * mfft * 2);
+                    memcpy(xu, xutempo, sizeof(double) * pDblIn3->getSize());
+
+                    nbx =  pDblIn3->getSize();
+                    ichaud = 1;
+                }
+                else
+                {
+                    xu = new double[mfft * 2];
+                    xui = new double[mfft * 2];
+                }
+
+                yi = new double[mny];
+                C2F(cmpse3)(&mfft, &mnx, &iMode, x, yi, xu, xui, w, wi, &iErr, &ichaud, &nbx);
+                if (iErr > 0)
+                {
+                    delete[] xu;
+                    delete[] xui;
+                    delete[] wi;
+                    delete[] w;
+                    Scierror(999, _("fft call : needs power of two!"));
+                    return types::Function::Error;
+                }
+
+            }
+            else
+            {
+                pDblIn3 = in[3]->getAs<types::Double>();
+                mfft  =   pDblIn3->getRows() * pDblIn3->getCols();
+                if (pDblIn3->isComplex() == false)
+                {
+                    wi = new double[mfft];
+                    memset(wi, 0x00, sizeof(double) * mfft);
+
+                    w = new double[pDblIn3->getSize()];
+                    double* wtempo = NULL;
+                    wtempo = pDblIn3->get();
+                    memcpy(w, wtempo, sizeof(double) * pDblIn3->getSize());
+
+                }
+                else
+                {
+                    double* wtempo = NULL;
+                    double* witempo = NULL;
+                    w = new double[pDblIn3->getSize()];
+                    wi = new double[pDblIn3->getSize()];
+
+                    wtempo = pDblIn3->getReal();
+                    witempo = pDblIn3->getImg();
+
+                    memcpy(w, wtempo, sizeof(double) * pDblIn3->getSize());
+                    memcpy(wi, witempo, sizeof(double) * pDblIn3->getSize());
+                }
+                if (in.size() == 5)
+                {
+                    pDblIn4 = in[4]->getAs<types::Double>();
+                    nbx = pDblIn4->getSize();
+                    double* xutempo = NULL;
+                    xutempo = pDblIn4->get();
+                    xu = new double[mfft * 2];
+                    memset(xu, 0x00, sizeof(double) * mfft * 2);
+                    memcpy(xu, xutempo, sizeof(double) * pDblIn4->getSize());
+                    ichaud = 1;
+
+                    xui = new double[mfft * 2];
+                }
+                else
+                {
+                    xu = new double[mfft * 2];
+                    xui = new double[mfft * 2];
+                }
+
+                C2F(cmpse3)(&mfft, &mnx, &iMode, x, y, xu, xui, w, wi, &iErr, &ichaud, &nbx);
+                if (iErr > 0)
+                {
+                    delete[] xu;
+                    delete[] xui;
+                    delete[] wi;
+                    delete[] w;
+                    Scierror(999, _("fft call : needs power of two!"));
+                    return types::Function::Error;
+                }
+
+            }
+
+            types::Double *pDblOut1 = NULL;
+            pDblOut1 = new types::Double(1, mfft, true);
+            pDblOut1->set(w);
+            pDblOut1->setImg(wi);
+            out.push_back(pDblOut1);
+
+            if (_iRetCount == 2)
+            {
+                types::Double *pDblOut2 = NULL;
+                pDblOut2 = new types::Double(1, mfft / 2);
+
+                for (int i = 0; i < mfft / 2; i++)
+                {
+                    xui[i] = x[mnx - mfft / 2 + i];
+                }
+
+                pDblOut2->set(xui);
+                out.push_back(pDblOut2);
+
+            }
+            delete[] w;
+            delete[] wi;
+            delete[] xui;
+            delete[] xu;
+            return types::Function::OK;
+
         }
         else
-        {//error
-            ScierrorW(999, _W("%ls: Wrong value for input argument #%d: Must be in the set {%ls}.\n"), L"corr", 1, L"'fft', 'update'");
+        {
+            //error
+            Scierror(999, _("%s: Wrong value for input argument #%d: Must be in the set {%s}.\n"), "corr", 1, "'fft', 'update'");
             return types::Function::Error;
         }
     }
     else
-    {//usual case [cov,mean]=corr(x,[y],nlags)
+    {
+        //usual case [cov,mean]=corr(x,[y],nlags)
         int iErr                        = 0;
         int iCorrelation                = 0;
         types::Double* pDblX            = NULL;
@@ -125,54 +403,52 @@ types::Function::ReturnValue sci_corr(types::typed_list &in, int _iRetCount, typ
         int iSize                       = 0;
         double pdblMean[2];
 
-
         //check input parameters
-        if(in.size() < 2 || in.size() > 3)
+        if (in.size() < 2 || in.size() > 3)
         {
-            ScierrorW(77, _W("%ls: Wrong number of input argument(s): %d to %d expected.\n"), L"corr", 2, 3);
+            Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "corr", 2, 3);
             return types::Function::Error;
         }
 
         //get last parameter nlags
         int iPos = (int)(in.size() - 1);
-        if(in[iPos]->isDouble() == false || in[iPos]->getAs<types::Double>()->isScalar() == false)
+        if (in[iPos]->isDouble() == false || in[iPos]->getAs<types::Double>()->isScalar() == false)
         {
-            ScierrorW(999, _W("%ls: Wrong type for input argument #%d: A scalar expected.\n"), L"corr", iPos + 1);
+            Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "corr", iPos + 1);
             return types::Function::Error;
         }
 
         iCorrelation = (int)in[iPos]->getAs<types::Double>()->get(0);
-        pDblCorrelation = new types::Double(1, iCorrelation);
 
-        if(in.size() == 3)
+        if (in.size() == 3)
         {
-            if(in[1]->isDouble() == false)
+            if (in[1]->isDouble() == false)
             {
-                ScierrorW(999, _W("%ls: Wrong type for input argument #%d: Matrix expected.\n"), L"corr" ,2);
+                Scierror(999, _("%s: Wrong type for input argument #%d: Matrix expected.\n"), "corr" , 2);
                 return types::Function::Error;
             }
 
             pDblY = in[1]->getAs<types::Double>();
 
-            if(in[0]->isDouble() == false)
+            if (in[0]->isDouble() == false)
             {
-                ScierrorW(999, _W("%ls: Wrong type for input argument #%d: Matrix expected.\n"), L"corr" ,1);
+                Scierror(999, _("%s: Wrong type for input argument #%d: Matrix expected.\n"), "corr" , 1);
                 return types::Function::Error;
             }
 
             pDblX = in[0]->getAs<types::Double>();
 
-            if(pDblX->getSize() != pDblY->getSize())
+            if (pDblX->getSize() != pDblY->getSize())
             {
-                ScierrorW(60, _W("%ls: Wrong size for argument: Incompatible dimensions.\n"), L"corr");
+                Scierror(60, _("%s: Wrong size for argument: Incompatible dimensions.\n"), "corr");
                 return types::Function::Error;
             }
         }
         else
         {
-            if(in[0]->isDouble() == false)
+            if (in[0]->isDouble() == false)
             {
-                ScierrorW(999, _W("%ls: Wrong type for input argument #%d: Matrix expected.\n"), L"corr" ,1);
+                Scierror(999, _("%s: Wrong type for input argument #%d: Matrix expected.\n"), "corr" , 1);
                 return types::Function::Error;
             }
 
@@ -181,19 +457,20 @@ types::Function::ReturnValue sci_corr(types::typed_list &in, int _iRetCount, typ
         }
 
         iSize = pDblX->getSize();
-
+        pDblCorrelation = new types::Double(1, iCorrelation);
         C2F(tscccf)(pDblX->get(), pDblY->get(), &iSize, pDblCorrelation->get(), pdblMean, &iCorrelation, &iErr);
-        if(iErr == -1)
+        if (iErr == -1)
         {
-            ScierrorW(999, _W("%ls: Too many coefficients are required.\n"), L"corr");
+            delete pDblCorrelation;
+            Scierror(999, _("%s: Too many coefficients are required.\n"), "corr");
             return types::Function::Error;
         }
 
         out.push_back(pDblCorrelation);
 
-        if(_iRetCount == 2)
+        if (_iRetCount == 2)
         {
-            if(in.size() == 3)
+            if (in.size() == 3)
             {
                 pDblMean = new types::Double(1, 2);
             }
@@ -206,5 +483,7 @@ types::Function::ReturnValue sci_corr(types::typed_list &in, int _iRetCount, typ
             out.push_back(pDblMean);
         }
     }
+
     return types::Function::OK;
-}
\ No newline at end of file
+}
+