[R] Rcpp

[jacinthe at gmx.de]

Hello all,

using GNU WinGW under Windows, I have experimented with the Rcpp package. Powerful package. Many thanks to Dominick Samperi.

Now I have tried to modify the RccpExample.cpp file in order to calculate two different moving averages, a simple moving average and an exponential moving average.

I call the function in R with:

params <- list(nobs=10,matype=2)
tempC <- .Call("Test_fun",x,params,PACKAGE = "RcppTemplate")

where nobs are the number of observation to calculate the moving average and matype could be 1 for a simple moving average and 2 for an exponential moving average. x is a dataframe containing the relevant data in the column labeled "Close".

For matype=1 it works fine and the output looks like:
$mab
  [1]    0.000    0.000    0.000    0.000    0.000    0.000    0.000    0.000    0.000 1450.710 1453.658 1459.822 1467.564
 [14] 1477.226 1487.114 1495.231 1496.560 1499.667 1498.295 1488.754 1478.958 1469.565 1460.120 1445.006 1429.891 1417.258
 [27] 1405.487 1393.141 1384.933 1382.347 1379.085 1370.778 1363.517 1359.175 1364.777 1365.676 1368.880 1370.997 1369.357
 [40] 1368.533 1368.512 1374.000 1379.464 1387.269 1387.010 1389.155 1393.638 1400.011 1407.004 1413.114 1421.691 1432.297
 [53] 1441.165 1450.033 1456.677 1467.145 1480.899 1495.727 1509.590 1522.596 1534.066 1545.307 1554.237 1561.848 1567.405
 [66] 1565.960 1561.789 1557.102 1559.802 1561.216 1563.193 1559.656 1560.993 1558.660 1562.106 1567.487 1569.686 1570.313
 [79] 1562.673 1556.586 1548.386 1543.358 1536.041 1532.702 1527.327 1524.134 1526.599 1529.143 1536.038 1542.074 1548.256
 [92] 1552.895 1559.588 1567.022 1574.884 1581.358 1585.991 1590.170 1591.420 1590.616

$nobs
[1] 10

$n
[1] 100

But for matype=2 it seems not to work. The output is
$mab
  [1] 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36
 [16] 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36
 [31] 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36
 [46] 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36
 [61] 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36
 [76] 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36
 [91] 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36 1483.36

$nobs
[1] 10

$n
[1] 100


The modified RcppExpamle.cpp file looks like:

#include "Rcpp.hpp"
// simple moving average
vector<double> SMAVG(vector<double> data, int nobs, int n) {
  int i,j;
  double sum;
  vector<double> mab(n);

  for (i=0;i<(n-nobs+1);i++)
  {
    sum=0.0;
    for (j=i;j<(i+nobs);j++)
    {
      sum += data[j];
    }
  mab[i+nobs-1]=sum/nobs;
  }
  return mab;
}

// exponential moving average
vector<double> EMAVG(vector<double> data, int nobs, int n) {
  int i;
  double optInK;
  optInK=2/(nobs+1);
  vector<double> mab(n);
  mab[0] = data[0];

  for (i=1;i<n;i++)
  {
    mab[i] = ((data[i]-mab[i-1])*optInK) + mab[i-1];
  }
  return mab;
}

// choose between simple and exponential moving average
RcppExport SEXP Test_fun(SEXP data, SEXP params) {
  SEXP rl=R_NilValue;

  char* exceptionMesg=NULL;
  try{
    int i=0;
    RcppParams rparam(params);
      int nobs = rparam.getIntValue("nobs");
      int matype = rparam.getIntValue("matype");
    RcppFrame datafm(data);
      vector<vector<ColDatum> > table = datafm.getTableData();
      int nrow = table.size();
    RcppVector<double> close(nrow);
      for(int row=0; row < nrow; row++) {
	     close(row)= table[row][4].getDoubleValue();
      }

    vector<double> stlvec(close.stlVector());
    vector<double> res(nrow);

    if (matype==1)
    {
       res = SMAVG(stlvec,nobs,nrow);
    }
    if (matype==2)
    {
      res = EMAVG(stlvec,nobs,nrow);
    }

    RcppVector<double> mab(nrow);
    for (i=0; i<nrow; i++) {
      mab(i)=res[i];
    }

    RcppResultSet rs;

    rs.add("mab",mab);
    rs.add("nobs",nobs);
    rs.add("n",nrow);
    rl = rs.getReturnList();
  } catch(std::exception& ex){
      exceptionMesg = copyMessageToR(ex.what());
  } catch(...){
      exceptionMesg = copyMessageToR("unknown reason");
  }
  if(exceptionMesg != NULL)
    error(exceptionMesg);
  return rl;
}

It seems that the problem is in the EMAVG function. I am not an C++ expert, perhapes I have made a mistake there. Could someone with stonger C++ skills    check this function? Or have I made a mistake by calling the function in the Test_fun function, which is later called by R?
Besides, is there a more elegant way to access in the Test_fun the Close-Column of the dataframe data which contains the columns (Date, Open, High, Low, Close, Volume)?

Best regards
Jaci
-- 
"Feel free" - 10 GB Mailbox, 100 FreeSMS/Monat ...
Jetzt GMX TopMail testen: www.gmx.net/de/go/mailfooter/topmail-out