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 RcppParams::RcppParams(SEXP params) {
00025 if (!Rf_isNewList(params))
00026 throw std::range_error("RcppParams: non-list passed to constructor");
00027 int len = Rf_length(params);
00028 SEXP names = Rf_getAttrib(params, R_NamesSymbol);
00029 if (names == R_NilValue)
00030 throw std::range_error("RcppParams: list must have named elements");
00031 for (int i = 0; i < len; i++) {
00032 std::string nm = std::string(CHAR(STRING_ELT(names,i)));
00033 if (nm.size() == 0)
00034 throw std::range_error("RcppParams: all list elements must be named");
00035 pmap[nm] = i;
00036 }
00037 _params = params;
00038 }
00039
00040 void RcppParams::checkNames(char *inputNames[], int len) {
00041 for (int i = 0; i < len; i++) {
00042 std::map<std::string,int>::iterator iter = pmap.find(inputNames[i]);
00043 if (iter == pmap.end()) {
00044 std::string mesg = "RcppParams::checkNames: missing required parameter ";
00045 throw std::range_error(mesg+inputNames[i]);
00046 }
00047 }
00048 }
00049
00050 RcppFrame::RcppFrame(SEXP df) {
00051 if (!Rf_isNewList(df))
00052 throw std::range_error("RcppFrame::RcppFrame: invalid data frame.");
00053 int ncol = Rf_length(df);
00054 SEXP names = Rf_getAttrib(df, R_NamesSymbol);
00055 colNames.resize(ncol);
00056 SEXP colData = VECTOR_ELT(df,0);
00057 int nrow = Rf_length(colData);
00058 if (nrow == 0)
00059 throw std::range_error("RcppFrame::RcppFrame: zero lenth column.");
00060
00061
00062 table.resize(nrow);
00063 for (int r = 0; r < nrow; r++)
00064 table[r].resize(ncol);
00065
00066 for (int i=0; i < ncol; i++) {
00067 colNames[i] = std::string(CHAR(STRING_ELT(names,i)));
00068 SEXP colData = VECTOR_ELT(df,i);
00069 if (!Rf_isVector(colData) || Rf_length(colData) != nrow)
00070 throw std::range_error("RcppFrame::RcppFrame: invalid column.");
00071
00072
00073
00074
00075 bool isDateClass = false;
00076 SEXP classname = Rf_getAttrib(colData, R_ClassSymbol);
00077 if (classname != R_NilValue)
00078 isDateClass = (strcmp(CHAR(STRING_ELT(classname,0)),"Date") == 0);
00079
00080 if (Rf_isReal(colData)) {
00081 if (isDateClass) {
00082 for (int j=0; j < nrow; j++)
00083 table[j][i].setDateValue(RcppDate((int)REAL(colData)[j]));
00084 }
00085 else
00086 for (int j=0; j < nrow; j++)
00087 table[j][i].setDoubleValue(REAL(colData)[j]);
00088 }
00089 else if (Rf_isInteger(colData)) {
00090 if (isDateClass) {
00091 for (int j=0; j < nrow; j++)
00092 table[j][i].setDateValue(RcppDate(INTEGER(colData)[j]));
00093 }
00094 else
00095 for (int j=0; j < nrow; j++)
00096 table[j][i].setIntValue(INTEGER(colData)[j]);
00097 }
00098 else if (Rf_isString(colData)) {
00099 for (int j=0; j < nrow; j++)
00100 table[j][i].setStringValue(std::string(CHAR(STRING_ELT(colData,j))));
00101 }
00102 else if (Rf_isFactor(colData)) {
00103 SEXP names = Rf_getAttrib(colData, R_LevelsSymbol);
00104 int numLevels = Rf_length(names);
00105 std::string *levelNames = new std::string[numLevels];
00106 for (int k=0; k < numLevels; k++)
00107 levelNames[k] = std::string(CHAR(STRING_ELT(names,k)));
00108 for (int j=0; j < nrow; j++)
00109 table[j][i].setFactorValue(levelNames, numLevels,
00110 INTEGER(colData)[j]);
00111 delete [] levelNames;
00112 }
00113 else if (Rf_isLogical(colData)) {
00114 for (int j=0; j < nrow; j++) {
00115 table[j][i].setLogicalValue(INTEGER(colData)[j]);
00116 }
00117 }
00118 else
00119 throw std::range_error("RcppFrame::RcppFrame: unsupported data frame column type.");
00120 }
00121 }
00122
00123 double RcppParams::getDoubleValue(std::string name) {
00124 std::map<std::string,int>::iterator iter = pmap.find(name);
00125 if (iter == pmap.end()) {
00126 std::string mesg = "RcppParams::getDoubleValue: no such name: ";
00127 throw std::range_error(mesg+name);
00128 }
00129 int posn = iter->second;
00130 SEXP elt = VECTOR_ELT(_params,posn);
00131 if (!Rf_isNumeric(elt) || Rf_length(elt) != 1) {
00132 std::string mesg = "RcppParams::getDoubleValue: must be scalar ";
00133 throw std::range_error(mesg+name);
00134 }
00135 if (Rf_isInteger(elt))
00136 return (double)INTEGER(elt)[0];
00137 else if (Rf_isReal(elt))
00138 return REAL(elt)[0];
00139 else {
00140 std::string mesg = "RcppParams::getDoubleValue: invalid value for ";
00141 throw std::range_error(mesg+name);
00142 }
00143 return 0;
00144 }
00145
00146 int RcppParams::getIntValue(std::string name) {
00147 std::map<std::string,int>::iterator iter = pmap.find(name);
00148 if (iter == pmap.end()) {
00149 std::string mesg = "RcppParams::getIntValue: no such name: ";
00150 throw std::range_error(mesg+name);
00151 }
00152 int posn = iter->second;
00153 SEXP elt = VECTOR_ELT(_params,posn);
00154 if (!Rf_isNumeric(elt) || Rf_length(elt) != 1) {
00155 std::string mesg = "RcppParams::getIntValue: must be scalar: ";
00156 throw std::range_error(mesg+name);
00157 }
00158 if (Rf_isInteger(elt))
00159 return INTEGER(elt)[0];
00160 else if (Rf_isReal(elt))
00161 return (int)REAL(elt)[0];
00162 else {
00163 std::string mesg = "RcppParams::getIntValue: invalid value for: ";
00164 throw std::range_error(mesg+name);
00165 }
00166 return 0;
00167 }
00168
00169 bool RcppParams::getBoolValue(std::string name) {
00170 std::map<std::string,int>::iterator iter = pmap.find(name);
00171 if (iter == pmap.end()) {
00172 std::string mesg = "RcppParams::getBoolValue: no such name: ";
00173 throw std::range_error(mesg+name);
00174 }
00175 int posn = iter->second;
00176 SEXP elt = VECTOR_ELT(_params,posn);
00177 if (Rf_isLogical(elt))
00178 return INTEGER(elt)[0];
00179 else {
00180 std::string mesg = "RcppParams::getBoolValue: invalid value for: ";
00181 throw std::range_error(mesg+name);
00182 }
00183 return false;
00184 }
00185
00186 std::string RcppParams::getStringValue(std::string name) {
00187 std::map<std::string,int>::iterator iter = pmap.find(name);
00188 if (iter == pmap.end()) {
00189 std::string mesg = "RcppParams::getStringValue: no such name: ";
00190 throw std::range_error(mesg+name);
00191 }
00192 int posn = iter->second;
00193 SEXP elt = VECTOR_ELT(_params,posn);
00194 if (Rf_isString(elt))
00195 return std::string(CHAR(STRING_ELT(elt,0)));
00196 else {
00197 std::string mesg = "RcppParams::getStringValue: invalid value for: ";
00198 throw std::range_error(mesg+name);
00199 }
00200 return "";
00201 }
00202
00203 RcppDate RcppParams::getDateValue(std::string name) {
00204 std::map<std::string,int>::iterator iter = pmap.find(name);
00205 if (iter == pmap.end()) {
00206 std::string mesg = "RcppParams::getDateValue: no such name: ";
00207 throw std::range_error(mesg+name);
00208 }
00209 int posn = iter->second;
00210 SEXP elt = VECTOR_ELT(_params,posn);
00211 if (!Rf_isNumeric(elt) || Rf_length(elt) != 1) {
00212 std::string mesg = "RcppParams::getDateValue: invalide date: ";
00213 throw std::range_error(mesg+name);
00214 }
00215
00216 int d;
00217 if (Rf_isReal(elt))
00218 d = (int)REAL(elt)[0];
00219 else {
00220 std::string mesg = "RcppParams::getDateValue: invalid value for: ";
00221 throw std::range_error(mesg+name);
00222 }
00223 return RcppDate(d);
00224 }
00225
00226 RcppDatetime RcppParams::getDatetimeValue(std::string name) {
00227 std::map<std::string,int>::iterator iter = pmap.find(name);
00228 if (iter == pmap.end()) {
00229 std::string mesg = "RcppParams::getDatetimeValue: no such name: ";
00230 throw std::range_error(mesg+name);
00231 }
00232 int posn = iter->second;
00233 SEXP elt = VECTOR_ELT(_params, posn);
00234 if (!Rf_isNumeric(elt) || Rf_length(elt) != 1) {
00235 std::string mesg = "RcppParams::getDateValue: invalide date: ";
00236 throw std::range_error(mesg+name);
00237 }
00238 double d;
00239 if (Rf_isReal(elt))
00240 d = REAL(elt)[0];
00241 else {
00242 std::string mesg = "RcppParams::getDatetimeValue: invalid value for: ";
00243 throw std::range_error(mesg+name);
00244 }
00245 return RcppDatetime(d);
00246 }
00247
00248 RcppDateVector::RcppDateVector(SEXP vec) {
00249 int i;
00250 if (!Rf_isNumeric(vec) || Rf_isMatrix(vec) || Rf_isLogical(vec))
00251 throw std::range_error("RcppDateVector: invalid numeric vector in constructor");
00252 int len = Rf_length(vec);
00253 if (len == 0)
00254 throw std::range_error("RcppDateVector: null vector in constructor");
00255 v = new RcppDate[len];
00256 for (i = 0; i < len; i++)
00257 v[i] = RcppDate((int)REAL(vec)[i]);
00258 length = len;
00259 }
00260
00261 RcppDatetimeVector::RcppDatetimeVector(SEXP vec) {
00262 int i;
00263 if (!Rf_isNumeric(vec) || Rf_isMatrix(vec) || Rf_isLogical(vec))
00264 throw std::range_error("RcppDatetimeVector: invalid numeric vector in constructor");
00265 int len = Rf_length(vec);
00266 if (len == 0)
00267 throw std::range_error("RcppDatetimeVector: null vector in constructor");
00268 v = new RcppDatetime[len];
00269 for (i = 0; i < len; i++)
00270 v[i] = RcppDatetime(REAL(vec)[i]);
00271 length = len;
00272 }
00273
00274 RcppStringVector::RcppStringVector(SEXP vec) {
00275 int i;
00276 if (Rf_isMatrix(vec) || Rf_isLogical(vec))
00277 throw std::range_error("RcppStringVector: invalid numeric vector in constructor");
00278 if (!Rf_isString(vec))
00279 throw std::range_error("RcppStringVector: invalid string");
00280 int len = Rf_length(vec);
00281 if (len == 0)
00282 throw std::range_error("RcppStringVector: null vector in constructor");
00283 v = new std::string[len];
00284 for (i = 0; i < len; i++)
00285 v[i] = std::string(CHAR(STRING_ELT(vec,i)));
00286 length = len;
00287 }
00288
00289 template <typename T>
00290 RcppVector<T>::RcppVector(SEXP vec) {
00291 int i;
00292
00293
00294
00295
00296
00297
00298
00299 if (!Rf_isNumeric(vec) || Rf_isMatrix(vec) || Rf_isLogical(vec))
00300 throw std::range_error("RcppVector: invalid numeric vector in constructor");
00301 len = Rf_length(vec);
00302 v = (T *)R_alloc(len, sizeof(T));
00303 if (Rf_isInteger(vec)) {
00304 for (i = 0; i < len; i++)
00305 v[i] = (T)(INTEGER(vec)[i]);
00306 }
00307 else if (Rf_isReal(vec)) {
00308 for (i = 0; i < len; i++)
00309 v[i] = (T)(REAL(vec)[i]);
00310 }
00311 }
00312
00313 template <typename T>
00314 RcppVector<T>::RcppVector(int _len) {
00315 len = _len;
00316 v = (T *)R_alloc(len, sizeof(T));
00317 for (int i = 0; i < len; i++)
00318 v[i] = 0;
00319 }
00320
00321 template <typename T>
00322 T *RcppVector<T>::cVector() {
00323 T* tmp = (T *)R_alloc(len, sizeof(T));
00324 for (int i = 0; i < len; i++)
00325 tmp[i] = v[i];
00326 return tmp;
00327 }
00328
00329 template <typename T>
00330 std::vector<T> RcppVector<T>::stlVector() {
00331 std::vector<T> tmp(len);
00332 for (int i = 0; i < len; i++)
00333 tmp[i] = v[i];
00334 return tmp;
00335 }
00336
00337 template <typename T>
00338 RcppMatrix<T>::RcppMatrix(SEXP mat) {
00339
00340 if (!Rf_isNumeric(mat) || !Rf_isMatrix(mat))
00341 throw std::range_error("RcppMatrix: invalid numeric matrix in constructor");
00342
00343
00344 SEXP dimAttr = Rf_getAttrib(mat, R_DimSymbol);
00345 dim1 = INTEGER(dimAttr)[0];
00346 dim2 = INTEGER(dimAttr)[1];
00347
00348
00349
00350 int i,j;
00351 int isInt = Rf_isInteger(mat);
00352 T *m = (T *)R_alloc(dim1*dim2, sizeof(T));
00353 a = (T **)R_alloc(dim1, sizeof(T *));
00354 for (i = 0; i < dim1; i++)
00355 a[i] = m + i*dim2;
00356 if (isInt) {
00357 for (i=0; i < dim1; i++)
00358 for (j=0; j < dim2; j++)
00359 a[i][j] = (T)(INTEGER(mat)[i+dim1*j]);
00360 }
00361 else {
00362 for (i=0; i < dim1; i++)
00363 for (j=0; j < dim2; j++)
00364 a[i][j] = (T)(REAL(mat)[i+dim1*j]);
00365 }
00366 }
00367
00368 template <typename T>
00369 RcppMatrix<T>::RcppMatrix(int _dim1, int _dim2) {
00370 dim1 = _dim1;
00371 dim2 = _dim2;
00372 int i,j;
00373 T *m = (T *)R_alloc(dim1*dim2, sizeof(T));
00374 a = (T **)R_alloc(dim1, sizeof(T *));
00375 for (i = 0; i < dim1; i++)
00376 a[i] = m + i*dim2;
00377 for (i=0; i < dim1; i++)
00378 for (j=0; j < dim2; j++)
00379 a[i][j] = 0;
00380 }
00381
00382 template <typename T>
00383 std::vector<std::vector<T> > RcppMatrix<T>::stlMatrix() {
00384 int i,j;
00385 std::vector<std::vector<T> > temp;
00386 for (i = 0; i < dim1; i++) {
00387 temp.push_back(std::vector<T>(dim2));
00388 }
00389 for (i = 0; i < dim1; i++)
00390 for (j = 0; j < dim2; j++)
00391 temp[i][j] = a[i][j];
00392 return temp;
00393 }
00394
00395 template <typename T>
00396 T **RcppMatrix<T>::cMatrix() {
00397 int i,j;
00398 T *m = (T *)R_alloc(dim1*dim2, sizeof(T));
00399 T **tmp = (T **)R_alloc(dim1, sizeof(T *));
00400 for (i = 0; i < dim1; i++)
00401 tmp[i] = m + i*dim2;
00402 for (i=0; i < dim1; i++)
00403 for (j=0; j < dim2; j++)
00404 tmp[i][j] = a[i][j];
00405 return tmp;
00406 }
00407
00408
00409 template class RcppVector<int>;
00410 template class RcppVector<double>;
00411 template class RcppMatrix<int>;
00412 template class RcppMatrix<double>;
00413
00414 template <typename T>
00415 RcppVectorView<T>::RcppVectorView(SEXP vec) {
00416 if (!Rf_isNumeric(vec) || Rf_isMatrix(vec) || Rf_isLogical(vec))
00417 throw std::range_error("RcppVectorView: invalid numeric vector in constructor");
00418 len = Rf_length(vec);
00419 if (Rf_isInteger(vec)) v = (T *)(INTEGER(vec));
00420 else if (Rf_isReal(vec)) v = (T *)(REAL(vec));
00421 }
00422
00423 template class RcppVectorView<int>;
00424 template class RcppVectorView<double>;
00425
00426 template <typename T>
00427 RcppMatrixView<T>::RcppMatrixView(SEXP mat) {
00428 if (!Rf_isNumeric(mat) || !Rf_isMatrix(mat))
00429 throw std::range_error("RcppMatrixView: invalid numeric matrix in constructor");
00430
00431 SEXP dimAttr = Rf_getAttrib(mat, R_DimSymbol);
00432 d1 = INTEGER(dimAttr)[0];
00433 d2 = INTEGER(dimAttr)[1];
00434 if (Rf_isInteger(mat)) a = (T *)(INTEGER(mat));
00435 else if (Rf_isReal(mat)) a = (T *)(REAL(mat));
00436 }
00437
00438 template class RcppMatrixView<int>;
00439 template class RcppMatrixView<double>;
00440
00441 RcppStringVectorView::RcppStringVectorView(SEXP vec) {
00442
00443 if (Rf_isMatrix(vec) || Rf_isLogical(vec))
00444 throw std::range_error("RcppStringVectorView: invalid numeric vector in constructor");
00445 if (!Rf_isString(vec))
00446 throw std::range_error("RcppStringVectorView: invalid string");
00447 int len = Rf_length(vec);
00448 if (len == 0)
00449 throw std::range_error("RcppStringVectorView: null vector in constructor");
00450
00451
00452
00453 length = len;
00454 v = vec;
00455 }
00456
00457
00458 void RcppResultSet::add(std::string name, RcppDate& date) {
00459 SEXP value = PROTECT(Rf_allocVector(REALSXP, 1));
00460 numProtected++;
00461 REAL(value)[0] = date.getJDN() - RcppDate::Jan1970Offset;
00462 SEXP dateclass = PROTECT(Rf_allocVector(STRSXP,1));
00463 numProtected++;
00464 SET_STRING_ELT(dateclass, 0, Rf_mkChar("Date"));
00465 Rf_setAttrib(value, R_ClassSymbol, dateclass);
00466 values.push_back(make_pair(name, value));
00467 }
00468
00469 void RcppResultSet::add(std::string name, RcppDatetime& datetime) {
00470 SEXP value = PROTECT(Rf_allocVector(REALSXP, 1));
00471 numProtected++;
00472 REAL(value)[0] = datetime.getFractionalTimestamp();
00473 SEXP datetimeclass = PROTECT(Rf_allocVector(STRSXP,2));
00474 numProtected++;
00475 SET_STRING_ELT(datetimeclass, 0, Rf_mkChar("POSIXt"));
00476 SET_STRING_ELT(datetimeclass, 1, Rf_mkChar("POSIXct"));
00477 Rf_setAttrib(value, R_ClassSymbol, datetimeclass);
00478 values.push_back(make_pair(name, value));
00479 }
00480
00481 void RcppResultSet::add(std::string name, double x) {
00482 SEXP value = PROTECT(Rf_allocVector(REALSXP, 1));
00483 numProtected++;
00484 REAL(value)[0] = x;
00485 values.push_back(make_pair(name, value));
00486 }
00487
00488 void RcppResultSet::add(std::string name, int i) {
00489 SEXP value = PROTECT(Rf_allocVector(INTSXP, 1));
00490 numProtected++;
00491 INTEGER(value)[0] = i;
00492 values.push_back(make_pair(name, value));
00493 }
00494
00495 void RcppResultSet::add(std::string name, std::string strvalue) {
00496 SEXP value = PROTECT(Rf_allocVector(STRSXP, 1));
00497 numProtected++;
00498 SET_STRING_ELT(value, 0, Rf_mkChar(strvalue.c_str()));
00499 values.push_back(make_pair(name, value));
00500 }
00501
00502 void RcppResultSet::add(std::string name, double *vec, int len) {
00503 if (vec == 0)
00504 throw std::range_error("RcppResultSet::add: NULL double vector");
00505 SEXP value = PROTECT(Rf_allocVector(REALSXP, len));
00506 numProtected++;
00507 for (int i = 0; i < len; i++)
00508 REAL(value)[i] = vec[i];
00509 values.push_back(make_pair(name, value));
00510 }
00511
00512 void RcppResultSet::add(std::string name, RcppDateVector& datevec) {
00513 SEXP value = PROTECT(Rf_allocVector(REALSXP, datevec.size()));
00514 numProtected++;
00515 for (int i = 0; i < datevec.size(); i++) {
00516 REAL(value)[i] = datevec(i).getJDN() - RcppDate::Jan1970Offset;
00517 }
00518 SEXP dateclass = PROTECT(Rf_allocVector(STRSXP,1));
00519 numProtected++;
00520 SET_STRING_ELT(dateclass, 0, Rf_mkChar("Date"));
00521 Rf_setAttrib(value, R_ClassSymbol, dateclass);
00522 values.push_back(make_pair(name, value));
00523 }
00524
00525 void RcppResultSet::add(std::string name, RcppDatetimeVector &dtvec) {
00526 SEXP value = PROTECT(Rf_allocVector(REALSXP, dtvec.size()));
00527 numProtected++;
00528 for (int i = 0; i < dtvec.size(); i++) {
00529 REAL(value)[i] = dtvec(i).getFractionalTimestamp();
00530 }
00531 SEXP datetimeclass = PROTECT(Rf_allocVector(STRSXP,2));
00532 numProtected++;
00533 SET_STRING_ELT(datetimeclass, 0, Rf_mkChar("POSIXt"));
00534 SET_STRING_ELT(datetimeclass, 1, Rf_mkChar("POSIXct"));
00535 Rf_setAttrib(value, R_ClassSymbol, datetimeclass);
00536 values.push_back(make_pair(name, value));
00537 }
00538
00539 void RcppResultSet::add(std::string name, RcppStringVector& stringvec) {
00540 int len = (int)stringvec.size();
00541 SEXP value = PROTECT(Rf_allocVector(STRSXP, len));
00542 numProtected++;
00543 for (int i = 0; i < len; i++)
00544 SET_STRING_ELT(value, i, Rf_mkChar(stringvec(i).c_str()));
00545 values.push_back(make_pair(name, value));
00546 }
00547
00548 void RcppResultSet::add(std::string name, int *vec, int len) {
00549 if (vec == 0)
00550 throw std::range_error("RcppResultSet::add: NULL int vector");
00551 SEXP value = PROTECT(Rf_allocVector(INTSXP, len));
00552 numProtected++;
00553 for (int i = 0; i < len; i++)
00554 INTEGER(value)[i] = vec[i];
00555 values.push_back(make_pair(name, value));
00556 }
00557
00558 void RcppResultSet::add(std::string name, double **mat, int nx, int ny) {
00559 if (mat == 0)
00560 throw std::range_error("RcppResultSet::add: NULL double matrix");
00561 SEXP value = PROTECT(Rf_allocMatrix(REALSXP, nx, ny));
00562 numProtected++;
00563 for (int i = 0; i < nx; i++)
00564 for (int j = 0; j < ny; j++)
00565 REAL(value)[i + nx*j] = mat[i][j];
00566 values.push_back(make_pair(name, value));
00567 }
00568
00569 void RcppResultSet::add(std::string name, int **mat, int nx, int ny) {
00570 if (mat == 0)
00571 throw std::range_error("RcppResultSet::add: NULL int matrix");
00572 SEXP value = PROTECT(Rf_allocMatrix(INTSXP, nx, ny));
00573 numProtected++;
00574 for (int i = 0; i < nx; i++)
00575 for (int j = 0; j < ny; j++)
00576 INTEGER(value)[i + nx*j] = mat[i][j];
00577 values.push_back(make_pair(name, value));
00578 }
00579
00580 void RcppResultSet::add(std::string name, std::vector<std::string>& vec) {
00581 if (vec.size() == 0)
00582 throw std::range_error("RcppResultSet::add; zero length vector<string>");
00583 int len = (int)vec.size();
00584 SEXP value = PROTECT(Rf_allocVector(STRSXP, len));
00585 numProtected++;
00586 for (int i = 0; i < len; i++)
00587 SET_STRING_ELT(value, i, Rf_mkChar(vec[i].c_str()));
00588 values.push_back(make_pair(name, value));
00589 }
00590
00591 void RcppResultSet::add(std::string name, std::vector<int>& vec) {
00592 if (vec.size() == 0)
00593 throw std::range_error("RcppResultSet::add; zero length vector<int>");
00594 int len = (int)vec.size();
00595 SEXP value = PROTECT(Rf_allocVector(INTSXP, len));
00596 numProtected++;
00597 for (int i = 0; i < len; i++)
00598 INTEGER(value)[i] = vec[i];
00599 values.push_back(make_pair(name, value));
00600 }
00601
00602 void RcppResultSet::add(std::string name, std::vector<double>& vec) {
00603 if (vec.size() == 0)
00604 throw std::range_error("RcppResultSet::add; zero length vector<double>");
00605 int len = (int)vec.size();
00606 SEXP value = PROTECT(Rf_allocVector(REALSXP, len));
00607 numProtected++;
00608 for (int i = 0; i < len; i++)
00609 REAL(value)[i] = vec[i];
00610 values.push_back(make_pair(name, value));
00611 }
00612
00613 void RcppResultSet::add(std::string name, std::vector<std::vector<int> >& mat) {
00614 if (mat.size() == 0)
00615 throw std::range_error("RcppResultSet::add: zero length vector<vector<int> >");
00616 else if (mat[0].size() == 0)
00617 throw std::range_error("RcppResultSet::add: no columns in vector<vector<int> >");
00618 int nx = (int)mat.size();
00619 int ny = (int)mat[0].size();
00620 SEXP value = PROTECT(Rf_allocMatrix(INTSXP, nx, ny));
00621 numProtected++;
00622 for (int i = 0; i < nx; i++)
00623 for (int j = 0; j < ny; j++)
00624 INTEGER(value)[i + nx*j] = mat[i][j];
00625 values.push_back(make_pair(name, value));
00626 }
00627
00628 void RcppResultSet::add(std::string name, std::vector<std::vector<double> >& mat) {
00629 if (mat.size() == 0)
00630 throw std::range_error("RcppResultSet::add: zero length vector<vector<double> >");
00631 else if (mat[0].size() == 0)
00632 throw std::range_error("RcppResultSet::add: no columns in vector<vector<double> >");
00633 int nx = (int)mat.size();
00634 int ny = (int)mat[0].size();
00635 SEXP value = PROTECT(Rf_allocMatrix(REALSXP, nx, ny));
00636 numProtected++;
00637 for (int i = 0; i < nx; i++)
00638 for (int j = 0; j < ny; j++)
00639 REAL(value)[i + nx*j] = mat[i][j];
00640 values.push_back(make_pair(name, value));
00641 }
00642
00643 void RcppResultSet::add(std::string name, RcppVector<int>& vec) {
00644 int len = vec.size();
00645 int *a = vec.cVector();
00646 SEXP value = PROTECT(Rf_allocVector(INTSXP, len));
00647 numProtected++;
00648 for (int i = 0; i < len; i++)
00649 INTEGER(value)[i] = a[i];
00650 values.push_back(make_pair(name, value));
00651 }
00652
00653 void RcppResultSet::add(std::string name, RcppVector<double>& vec) {
00654 int len = vec.size();
00655 double *a = vec.cVector();
00656 SEXP value = PROTECT(Rf_allocVector(REALSXP, len));
00657 numProtected++;
00658 for (int i = 0; i < len; i++)
00659 REAL(value)[i] = a[i];
00660 values.push_back(make_pair(name, value));
00661 }
00662
00663 void RcppResultSet::add(std::string name, RcppMatrix<int>& mat) {
00664 int nx = mat.getDim1();
00665 int ny = mat.getDim2();
00666 int **a = mat.cMatrix();
00667 SEXP value = PROTECT(Rf_allocMatrix(INTSXP, nx, ny));
00668 numProtected++;
00669 for (int i = 0; i < nx; i++)
00670 for (int j = 0; j < ny; j++)
00671 INTEGER(value)[i + nx*j] = a[i][j];
00672 values.push_back(make_pair(name, value));
00673 }
00674
00675 void RcppResultSet::add(std::string name, RcppMatrix<double>& mat) {
00676 int nx = mat.getDim1();
00677 int ny = mat.getDim2();
00678 double **a = mat.cMatrix();
00679 SEXP value = PROTECT(Rf_allocMatrix(REALSXP, nx, ny));
00680 numProtected++;
00681 for (int i = 0; i < nx; i++)
00682 for (int j = 0; j < ny; j++)
00683 REAL(value)[i + nx*j] = a[i][j];
00684 values.push_back(make_pair(name, value));
00685 }
00686
00687 void RcppResultSet::add(std::string name, RcppFrame& frame) {
00688 std::vector<std::string> colNames = frame.getColNames();
00689 std::vector<std::vector<ColDatum> > table = frame.getTableData();
00690 int ncol = colNames.size();
00691 int nrow = table.size();
00692 SEXP rl = PROTECT(Rf_allocVector(VECSXP,ncol));
00693 SEXP nm = PROTECT(Rf_allocVector(STRSXP,ncol));
00694 numProtected += 2;
00695 for (int i=0; i < ncol; i++) {
00696 SEXP value, names;
00697 if (table[0][i].getType() == COLTYPE_DOUBLE) {
00698 value = PROTECT(Rf_allocVector(REALSXP,nrow));
00699 numProtected++;
00700 for (int j=0; j < nrow; j++)
00701 REAL(value)[j] = table[j][i].getDoubleValue();
00702 } else if (table[0][i].getType() == COLTYPE_INT) {
00703 value = PROTECT(Rf_allocVector(INTSXP,nrow));
00704 numProtected++;
00705 for (int j=0; j < nrow; j++)
00706 INTEGER(value)[j] = table[j][i].getIntValue();
00707 } else if (table[0][i].getType() == COLTYPE_FACTOR) {
00708 value = PROTECT(Rf_allocVector(INTSXP,nrow));
00709 numProtected++;
00710 int levels = table[0][i].getFactorNumLevels();
00711 names = PROTECT(Rf_allocVector(STRSXP,levels));
00712 numProtected++;
00713 std::string *levelNames = table[0][i].getFactorLevelNames();
00714 for (int k=0; k < levels; k++)
00715 SET_STRING_ELT(names, k, Rf_mkChar(levelNames[k].c_str()));
00716 for (int j=0; j < nrow; j++) {
00717 int level = table[j][i].getFactorLevel();
00718 INTEGER(value)[j] = level;
00719 }
00720 Rf_setAttrib(value, R_LevelsSymbol, names);
00721 SEXP factorclass = PROTECT(Rf_allocVector(STRSXP,1));
00722 numProtected++;
00723 SET_STRING_ELT(factorclass, 0, Rf_mkChar("factor"));
00724 Rf_setAttrib(value, R_ClassSymbol, factorclass);
00725 } else if (table[0][i].getType() == COLTYPE_STRING) {
00726 value = PROTECT(Rf_allocVector(STRSXP,nrow));
00727 numProtected++;
00728 for (int j=0; j < nrow; j++) {
00729 SET_STRING_ELT(value, j, Rf_mkChar(table[j][i].getStringValue().c_str()));
00730 }
00731 } else if (table[0][i].getType() == COLTYPE_LOGICAL) {
00732 value = PROTECT(Rf_allocVector(LGLSXP,nrow));
00733 numProtected++;
00734 for (int j=0; j < nrow; j++) {
00735 LOGICAL(value)[j] = table[j][i].getLogicalValue();
00736 }
00737 } else if (table[0][i].getType() == COLTYPE_DATE) {
00738 value = PROTECT(Rf_allocVector(REALSXP,nrow));
00739 numProtected++;
00740 for (int j=0; j < nrow; j++)
00741 REAL(value)[j] = table[j][i].getDateRCode();
00742 SEXP dateclass = PROTECT(Rf_allocVector(STRSXP,1));
00743 numProtected++;
00744 SET_STRING_ELT(dateclass, 0, Rf_mkChar("Date"));
00745 Rf_setAttrib(value, R_ClassSymbol, dateclass);
00746 } else if (table[0][i].getType() == COLTYPE_DATETIME) {
00747 value = PROTECT(Rf_allocVector(REALSXP,nrow));
00748 numProtected++;
00749 for (int j=0; j < nrow; j++) {
00750
00751
00752 REAL(value)[j] = table[j][i].getDatetimeValue().getFractionalTimestamp();
00753 }
00754 SEXP dateclass = PROTECT(Rf_allocVector(STRSXP,2));
00755 numProtected++;
00756 SET_STRING_ELT(dateclass, 0, Rf_mkChar("POSIXt"));
00757 SET_STRING_ELT(dateclass, 1, Rf_mkChar("POSIXct"));
00758 Rf_setAttrib(value, R_ClassSymbol, dateclass);
00759 } else {
00760 throw std::range_error("RcppResultSet::add invalid column type");
00761 }
00762 SET_VECTOR_ELT(rl, i, value);
00763 SET_STRING_ELT(nm, i, Rf_mkChar(colNames[i].c_str()));
00764 }
00765 Rf_setAttrib(rl, R_NamesSymbol, nm);
00766 values.push_back(make_pair(name, rl));
00767 }
00768
00769 void RcppResultSet::add(std::string name, SEXP sexp, bool isProtected) {
00770 values.push_back(make_pair(name, sexp));
00771 if (isProtected)
00772 numProtected++;
00773 }
00774
00775 SEXP RcppResultSet::getReturnList() {
00776 int nret = (int)values.size();
00777 SEXP rl = PROTECT(Rf_allocVector(VECSXP,nret));
00778 SEXP nm = PROTECT(Rf_allocVector(STRSXP,nret));
00779 std::list<std::pair<std::string,SEXP> >::iterator iter = values.begin();
00780 for (int i = 0; iter != values.end(); iter++, i++) {
00781 SET_VECTOR_ELT(rl, i, iter->second);
00782 SET_STRING_ELT(nm, i, Rf_mkChar(iter->first.c_str()));
00783 }
00784 Rf_setAttrib(rl, R_NamesSymbol, nm);
00785 UNPROTECT(numProtected+2);
00786 return rl;
00787 }
00788
00789
00790 std::ostream& operator<<(std::ostream& os, const RcppDate& date) {
00791 os << date.getYear() << "-" << date.getMonth() << "-" << date.getDay();
00792 return os;
00793 }
00794
00795
00796 RcppDate operator+(const RcppDate& date, int offset) {
00797 RcppDate temp(date.month, date.day, date.year);
00798 temp.jdn += offset;
00799 temp.jdn2mdy();
00800 return temp;
00801 }
00802
00803 int operator-(const RcppDate& date2, const RcppDate& date1) {
00804 return date2.jdn - date1.jdn;
00805 }
00806
00807 bool operator<(const RcppDate &date1, const RcppDate& date2) {
00808 return date1.jdn < date2.jdn;
00809 }
00810
00811 bool operator>(const RcppDate &date1, const RcppDate& date2) {
00812 return date1.jdn > date2.jdn;
00813 }
00814
00815 bool operator>=(const RcppDate &date1, const RcppDate& date2) {
00816 return date1.jdn >= date2.jdn;
00817 }
00818
00819 bool operator<=(const RcppDate &date1, const RcppDate& date2) {
00820 return date1.jdn <= date2.jdn;
00821 }
00822
00823 bool operator==(const RcppDate &date1, const RcppDate& date2) {
00824 return date1.jdn == date2.jdn;
00825 }
00826
00827
00828 const int RcppDate::Jan1970Offset = 2440588;
00829
00830
00831 const int RcppDate::QLtoJan1970Offset = 25569;
00832
00833
00834
00835
00836
00837
00838
00839
00840
00841
00842
00843
00844
00845
00846 void RcppDate::mdy2jdn() {
00847 int m = month, d = day, y = year;
00848 int a = (14 - m)/12;
00849 y += 4800 - a;
00850 m += 12*a - 3;
00851 jdn = (d + (153*m + 2)/5 + 365*y
00852 + y/4 - y/100 + y/400 - 32045);
00853 }
00854
00855
00856 void RcppDate::jdn2mdy() {
00857 int jul = jdn + 32044;
00858 int g = jul/146097;
00859 int dg = jul % 146097;
00860 int c = (dg/36524 + 1)*3/4;
00861 int dc = dg - c*36524;
00862 int b = dc/1461;
00863 int db = dc % 1461;
00864 int a = (db/365 + 1)*3/4;
00865 int da = db - a*365;
00866 int y = g*400 + c*100 + b*4 + a;
00867 int m = (da*5 + 308)/153 - 2;
00868 int d = da - (m + 4)*153 /5 + 122;
00869 y = y - 4800 + (m + 2)/12;
00870 m = (m + 2) % 12 + 1;
00871 d = d + 1;
00872 month = m;
00873 day = d;
00874 year = y;
00875 }
00876
00877 SEXP RcppFunction::listCall() {
00878 if (names.size() != (unsigned)listSize)
00879 throw std::range_error("RcppFunction::listCall: no. of names != no. of items");
00880 if (currListPosn != listSize)
00881 throw std::range_error("RcppFunction::listCall: list has incorrect size");
00882 SEXP nm = PROTECT(Rf_allocVector(STRSXP,listSize));
00883 numProtected++;
00884 for (int i=0; i < listSize; i++)
00885 SET_STRING_ELT(nm, i, Rf_mkChar(names[i].c_str()));
00886 Rf_setAttrib(listArg, R_NamesSymbol, nm);
00887 SEXP R_fcall;
00888 PROTECT(R_fcall = Rf_lang2(fn, R_NilValue));
00889 numProtected++;
00890 SETCADR(R_fcall, listArg);
00891 SEXP result = Rf_eval(R_fcall, R_NilValue);
00892 names.clear();
00893 listSize = currListPosn = 0;
00894 return result;
00895 }
00896
00897 SEXP RcppFunction::vectorCall() {
00898 if (vectorArg == R_NilValue)
00899 throw std::range_error("RcppFunction::vectorCall: vector has not been set");
00900 SEXP R_fcall;
00901 PROTECT(R_fcall = Rf_lang2(fn, R_NilValue));
00902 numProtected++;
00903 SETCADR(R_fcall, vectorArg);
00904 SEXP result = Rf_eval(R_fcall, R_NilValue);
00905 vectorArg = R_NilValue;
00906 return result;
00907 }
00908
00909 void RcppFunction::setRVector(std::vector<double>& v) {
00910 vectorArg = PROTECT(Rf_allocVector(REALSXP,v.size()));
00911 numProtected++;
00912 for (int i=0; i < (int)v.size(); i++)
00913 REAL(vectorArg)[i] = v[i];
00914 }
00915
00916 void RcppFunction::setRListSize(int n) {
00917 listSize = n;
00918 listArg = PROTECT(Rf_allocVector(VECSXP, n));
00919 numProtected++;
00920 }
00921
00922 void RcppFunction::appendToRList(std::string name, double value) {
00923 if (currListPosn < 0 || currListPosn >= listSize)
00924 throw std::range_error("RcppFunction::appendToRList(double): list posn out of range");
00925 SEXP valsxp = PROTECT(Rf_allocVector(REALSXP,1));
00926 numProtected++;
00927 REAL(valsxp)[0] = value;
00928 SET_VECTOR_ELT(listArg, currListPosn++, valsxp);
00929 names.push_back(name);
00930 }
00931
00932 void RcppFunction::appendToRList(std::string name, int value) {
00933 if (currListPosn < 0 || currListPosn >= listSize)
00934 throw std::range_error("RcppFunction::appendToRlist(int): posn out of range");
00935 SEXP valsxp = PROTECT(Rf_allocVector(INTSXP,1));
00936 numProtected++;
00937 INTEGER(valsxp)[0] = value;
00938 SET_VECTOR_ELT(listArg, currListPosn++, valsxp);
00939 names.push_back(name);
00940 }
00941
00942 void RcppFunction::appendToRList(std::string name, std::string value) {
00943 if (currListPosn < 0 || currListPosn >= listSize)
00944 throw std::range_error("RcppFunction::appendToRlist(string): posn out of range");
00945 SEXP valsxp = PROTECT(Rf_allocVector(STRSXP,1));
00946 numProtected++;
00947 SET_STRING_ELT(valsxp, 0, Rf_mkChar(value.c_str()));
00948 SET_VECTOR_ELT(listArg, currListPosn++, valsxp);
00949 names.push_back(name);
00950 }
00951
00952 void RcppFunction::appendToRList(std::string name, RcppDate& date) {
00953 if (currListPosn < 0 || currListPosn >= listSize)
00954 throw std::range_error("RcppFunction::appendToRlist(RcppDate): list posn out of range");
00955 SEXP valsxp = PROTECT(Rf_allocVector(REALSXP,1));
00956 numProtected++;
00957 REAL(valsxp)[0] = date.getJDN() - RcppDate::Jan1970Offset;
00958 SEXP dateclass = PROTECT(Rf_allocVector(STRSXP, 1));
00959 numProtected++;
00960 SET_STRING_ELT(dateclass, 0, Rf_mkChar("Date"));
00961 Rf_setAttrib(valsxp, R_ClassSymbol, dateclass);
00962 SET_VECTOR_ELT(listArg, currListPosn++, valsxp);
00963 names.push_back(name);
00964 }
00965
00966 void RcppFunction::appendToRList(std::string name, RcppDatetime& datetime) {
00967 if (currListPosn < 0 || currListPosn >= listSize)
00968 throw std::range_error("RcppFunction::appendToRlist(RcppDatetime): list posn out of range");
00969 SEXP valsxp = PROTECT(Rf_allocVector(REALSXP,1));
00970 numProtected++;
00971 REAL(valsxp)[0] = datetime.getFractionalTimestamp();
00972 SEXP datetimeclass = PROTECT(Rf_allocVector(STRSXP, 2));
00973 numProtected++;
00974 SET_STRING_ELT(datetimeclass, 0, Rf_mkChar("POSIXt"));
00975 SET_STRING_ELT(datetimeclass, 1, Rf_mkChar("POSIXct"));
00976 Rf_setAttrib(valsxp, R_ClassSymbol, datetimeclass);
00977 SET_VECTOR_ELT(listArg, currListPosn++, valsxp);
00978 names.push_back(name);
00979 }
00980
00981 #include <cstring>
00982
00983
00984
00985
00986 char *copyMessageToR(const char* const mesg) {
00987 char* Rmesg;
00988 const char* prefix = "Exception: ";
00989 void* Rheap = R_alloc(strlen(prefix)+strlen(mesg)+1,sizeof(char));
00990 Rmesg = static_cast<char*>(Rheap);
00991 strcpy(Rmesg, prefix);
00992 strcat(Rmesg, mesg);
00993 return Rmesg;
00994 }
00995