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