00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022 #include "Rcpp.h"
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036 class MyRVectorFunc : public RcppFunction {
00037 public:
00038 MyRVectorFunc(SEXP fn) : RcppFunction(fn) {}
00039
00040
00041
00042 double getSum(std::vector<double>& v) {
00043
00044
00045 setRVector(v);
00046
00047
00048
00049 SEXP result = vectorCall();
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061 double value = REAL(result)[0];
00062
00063
00064
00065 clearProtectionStack();
00066
00067 return value;
00068 }
00069 };
00070
00071
00072
00073
00074
00075
00076
00077
00078 class MyRListFunc : public RcppFunction {
00079 public:
00080 MyRListFunc(SEXP fn) : RcppFunction(fn) {}
00081 std::vector<double> addOne(double alpha, double beta, double gamma) {
00082
00083
00084 setRListSize(3);
00085 appendToRList("alpha", alpha);
00086 appendToRList("beta", beta);
00087 appendToRList("gamma", gamma);
00088
00089
00090
00091 SEXP result = listCall();
00092
00093
00094
00095 std::vector<double> vec(Rf_length(result));
00096 for(int i=0; i < Rf_length(result); i++)
00097 vec[i] = REAL(result)[i];
00098
00099
00100 clearProtectionStack();
00101
00102 return vec;
00103 }
00104 };
00105
00106
00107
00108
00109 RcppExport SEXP Rcpp_Example(SEXP params, SEXP nlist,
00110 SEXP numvec, SEXP nummat,
00111 SEXP df, SEXP datevec, SEXP stringvec,
00112 SEXP fnvec, SEXP fnlist) {
00113
00114 SEXP rl=R_NilValue;
00115 char *exceptionMesg=NULL;
00116
00117 try {
00118
00119 int i=0, j=0;
00120
00121
00122 RcppParams rparam(params);
00123 std::string method = rparam.getStringValue("method");
00124 double tolerance = rparam.getDoubleValue("tolerance");
00125 int maxIter = rparam.getIntValue("maxIter");
00126 RcppDate startDate = rparam.getDateValue("startDate");
00127
00128
00129 Rprintf("Parsing start date argument: %d/%d/%d\n",
00130 startDate.getMonth(),
00131 startDate.getDay(),
00132 startDate.getYear());
00133
00134
00135
00136
00137
00138 RcppDateVector dateVec(datevec);
00139
00140
00141 RcppStringVector stringVec(stringvec);
00142
00143
00144
00145 RcppNumList nl(nlist);
00146
00147
00148
00149
00150
00151
00152
00153
00154 RcppVector<double> vecD(numvec);
00155
00156
00157 RcppMatrix<double> matD(nummat);
00158
00159
00160 int nrows = matD.getDim1();
00161 int ncols = matD.getDim2();
00162 for(i = 0; i < nrows; i++)
00163 for(j = 0; j < ncols; j++)
00164 matD(i,j) = 2 * matD(i,j);
00165
00166 int len = vecD.size();
00167 for(i = 0; i < len; i++)
00168 vecD(i) = 3 * vecD(i);
00169
00170
00171
00172
00173 double **a = matD.cMatrix();
00174 double *v = vecD.cVector();
00175
00176
00177 std::vector<double> stlvec(vecD.stlVector());
00178 nrows = (int)stlvec.size();
00179 for(i = 0; i < nrows; i++)
00180 stlvec[i] += 1;
00181
00182
00183 std::vector<std::vector<double> > stlmat(matD.stlMatrix());
00184 nrows = (int)stlmat.size();
00185 ncols = (int)stlmat[0].size();
00186 for(i = 0; i < nrows; i++)
00187 for(j = 0; j < ncols; j++)
00188 stlmat[i][j] += 2;
00189
00190
00191
00192
00193
00194 std::vector<std::string> svec(2);
00195 svec[0] = "hello";
00196 svec[1] = "world";
00197
00198
00199 RcppFrame inframe(df);
00200
00201
00202
00203
00204
00205
00206
00207
00208
00209
00210
00211
00212
00213
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229
00230
00231
00232
00233
00234
00235
00236 int numCol=4;
00237 std::vector<std::string> colNames(numCol);
00238 colNames[0] = "alpha";
00239 colNames[1] = "beta";
00240 colNames[2] = "gamma";
00241 colNames[3] = "delta";
00242 RcppFrame frame(colNames);
00243
00244
00245
00246
00247
00248
00249 int numLevels = 2;
00250 std::string *levelNames = new std::string[2];
00251 levelNames[0] = std::string("pass");
00252 levelNames[1] = std::string("fail");
00253
00254
00255 std::vector<ColDatum> row1(numCol);
00256 row1[0].setStringValue("a");
00257 row1[1].setDoubleValue(3.14);
00258 row1[2].setFactorValue(levelNames, numLevels, 1);
00259 row1[3].setDateValue(RcppDate(7,4,2006));
00260 frame.addRow(row1);
00261
00262
00263 std::vector<ColDatum> row2(numCol);
00264 row2[0].setStringValue("b");
00265 row2[1].setDoubleValue(6.28);
00266 row2[2].setFactorValue(levelNames, numLevels, 1);
00267 row2[3].setDateValue(RcppDate(12,25,2006));
00268 frame.addRow(row2);
00269
00270
00271 delete [] levelNames;
00272
00273
00274 MyRVectorFunc vfunc(fnvec);
00275 int n = 10;
00276 std::vector<double> vecInput(n);
00277 for(int i=0; i < n; i++)
00278 vecInput[i] = i;
00279 double vecSum = vfunc.getSum(vecInput);
00280 Rprintf("Testing vector function argument: vecSum = %lf\n", vecSum);
00281
00282
00283 MyRListFunc lfunc(fnlist);
00284 double alpha=1, beta=2, gamma=3;
00285 std::vector<double> vecOut = lfunc.addOne(alpha, beta, gamma);
00286 Rprintf("Testing list function argument: %lf, %lf, %lf\n", vecOut[0], vecOut[1], vecOut[2]);
00287
00288 RcppDate aDate(12, 25, 1999);
00289
00290
00291 RcppResultSet rs;
00292
00293 rs.add("date", aDate);
00294 rs.add("dateVec", dateVec);
00295 rs.add("method", method);
00296 rs.add("tolerance", tolerance);
00297 rs.add("maxIter", maxIter);
00298 rs.add("nlFirstName", nl.getName(0));
00299 rs.add("nlFirstValue", nl.getValue(0));
00300 rs.add("matD", matD);
00301 rs.add("stlvec", stlvec);
00302 rs.add("stlmat", stlmat);
00303 rs.add("a", a, nrows, ncols);
00304 rs.add("v", v, len);
00305 rs.add("stringVec", stringVec);
00306 rs.add("strings", svec);
00307 rs.add("InputDF", inframe);
00308 rs.add("PreDF", frame);
00309
00310
00311
00312
00313
00314 rs.add("params", params, false);
00315
00316
00317
00318 rl = rs.getReturnList();
00319
00320 } catch(std::exception& ex) {
00321 exceptionMesg = copyMessageToR(ex.what());
00322 } catch(...) {
00323 exceptionMesg = copyMessageToR("unknown reason");
00324 }
00325
00326 if(exceptionMesg != NULL)
00327 Rf_error(exceptionMesg);
00328
00329 return rl;
00330 }
00331
00332
00333 RcppExport SEXP RcppParamsExample(SEXP params) {
00334
00335 SEXP rl=R_NilValue;
00336 char *exceptionMesg=NULL;
00337
00338 try {
00339
00340
00341 RcppParams rparam(params);
00342 std::string method = rparam.getStringValue("method");
00343 double tolerance = rparam.getDoubleValue("tolerance");
00344 int maxIter = rparam.getIntValue("maxIter");
00345 RcppDate startDate = rparam.getDateValue("startDate");
00346
00347 Rprintf("\nIn C++, seeing the following value\n");
00348 Rprintf("Method argument : %s\n", method.c_str());
00349 Rprintf("Tolerance argument : %f\n", tolerance);
00350 Rprintf("MaxIter argument : %d\n", maxIter);
00351 Rprintf("Start date argument: %04d-%02d-%02d\n",
00352 startDate.getYear(), startDate.getMonth(), startDate.getDay());
00353
00354
00355 RcppResultSet rs;
00356
00357 rs.add("method", method);
00358 rs.add("tolerance", tolerance);
00359 rs.add("maxIter", maxIter);
00360 rs.add("startDate", startDate);
00361
00362
00363
00364
00365 rs.add("params", params, false);
00366
00367
00368 rl = rs.getReturnList();
00369
00370 } catch(std::exception& ex) {
00371 exceptionMesg = copyMessageToR(ex.what());
00372 } catch(...) {
00373 exceptionMesg = copyMessageToR("unknown reason");
00374 }
00375
00376 if(exceptionMesg != NULL)
00377 Rf_error(exceptionMesg);
00378
00379 return rl;
00380 }
00381
00382 RcppExport SEXP RcppDateExample(SEXP dvsexp, SEXP dtvsexp) {
00383
00384 SEXP rl=R_NilValue;
00385 char *exceptionMesg=NULL;
00386
00387 try {
00388
00389 RcppDateVector dv(dvsexp);
00390 RcppDatetimeVector dtv(dtvsexp);
00391
00392 Rprintf("\nIn C++, seeing the following date value\n");
00393 for (int i=0; i<dv.size(); i++) {
00394 std::cout << dv(i) << std::endl;
00395 dv(i) = dv(i) + 7;
00396 }
00397 Rprintf("\nIn C++, seeing the following datetime value\n");
00398 for (int i=0; i<dtv.size(); i++) {
00399 std::cout << dtv(i) << std::endl;
00400 dtv(i) = dtv(i) + 0.250;
00401 }
00402
00403
00404 RcppResultSet rs;
00405 rs.add("date", dv);
00406 rs.add("datetime", dtv);
00407
00408
00409 rl = rs.getReturnList();
00410
00411 } catch(std::exception& ex) {
00412 exceptionMesg = copyMessageToR(ex.what());
00413 } catch(...) {
00414 exceptionMesg = copyMessageToR("unknown reason");
00415 }
00416
00417 if(exceptionMesg != NULL)
00418 Rf_error(exceptionMesg);
00419
00420 return rl;
00421 }
00422
00423 RcppExport SEXP RcppVectorExample(SEXP vector) {
00424
00425 SEXP rl=R_NilValue;
00426 char *exceptionMesg=NULL;
00427
00428 try {
00429
00430
00431 RcppVector<int> vec(vector);
00432 int n = vec.size();
00433
00434 Rprintf("\nIn C++, seeing a vector of length %d\n", n);
00435
00436
00437 std::vector<double> res(n);
00438
00439 for (int i=0; i<n; i++) {
00440 res[i] = sqrt(static_cast<double>(vec(i)));
00441 }
00442
00443
00444 RcppResultSet rs;
00445
00446 rs.add("result", res);
00447 rs.add("original", vec);
00448
00449
00450 rl = rs.getReturnList();
00451
00452 } catch(std::exception& ex) {
00453 exceptionMesg = copyMessageToR(ex.what());
00454 } catch(...) {
00455 exceptionMesg = copyMessageToR("unknown reason");
00456 }
00457
00458 if(exceptionMesg != NULL)
00459 Rf_error(exceptionMesg);
00460
00461 return rl;
00462 }