[Rcpp-commits] r175 - pkg/src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Nov 16 02:09:41 CET 2009
Author: edd
Date: 2009-11-16 02:09:41 +0100 (Mon, 16 Nov 2009)
New Revision: 175
Added:
pkg/src/RcppCommon.cpp
Removed:
pkg/src/Rcpp.cpp
Modified:
pkg/src/Rcpp.h
Log:
finalise moving class files out of Rcpp.{h,cpp} into their own per-class files
Deleted: pkg/src/Rcpp.cpp
===================================================================
--- pkg/src/Rcpp.cpp 2009-11-16 01:09:04 UTC (rev 174)
+++ pkg/src/Rcpp.cpp 2009-11-16 01:09:41 UTC (rev 175)
@@ -1,688 +0,0 @@
-// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
-//
-// Rcpp.cpp: R/C++ interface class library
-//
-// Copyright (C) 2005 - 2006 Dominick Samperi
-// Copyright (C) 2008 - 2009 Dirk Eddelbuettel
-//
-// This library is free software; you can redistribute it and/or modify it
-// under the terms of the GNU Lesser General Public License as published by
-// the Free Software Foundation; either version 2.1 of the License, or (at
-// your option) any later version.
-//
-// This library is distributed in the hope that it will be useful, but
-// WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-// or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
-// License for more details.
-//
-// You should have received a copy of the GNU Lesser General Public License
-// along with this library; if not, write to the Free Software Foundation,
-// Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-#include <Rcpp.h>
-
-RcppDateVector::RcppDateVector(SEXP vec) {
- int i;
- if (!Rf_isNumeric(vec) || Rf_isMatrix(vec) || Rf_isLogical(vec))
- throw std::range_error("RcppDateVector: invalid numeric vector in constructor");
- int len = Rf_length(vec);
- if (len == 0)
- throw std::range_error("RcppDateVector: null vector in constructor");
- v = new RcppDate[len];
- for (i = 0; i < len; i++)
- v[i] = RcppDate((int)REAL(vec)[i]);
- length = len;
-}
-
-RcppDatetimeVector::RcppDatetimeVector(SEXP vec) {
- int i;
- if (!Rf_isNumeric(vec) || Rf_isMatrix(vec) || Rf_isLogical(vec))
- throw std::range_error("RcppDatetimeVector: invalid numeric vector in constructor");
- int len = Rf_length(vec);
- if (len == 0)
- throw std::range_error("RcppDatetimeVector: null vector in constructor");
- v = new RcppDatetime[len];
- for (i = 0; i < len; i++)
- v[i] = RcppDatetime(REAL(vec)[i]);
- length = len;
-}
-
-RcppStringVector::RcppStringVector(SEXP vec) {
- int i;
- if (Rf_isMatrix(vec) || Rf_isLogical(vec))
- throw std::range_error("RcppStringVector: invalid numeric vector in constructor");
- if (!Rf_isString(vec))
- throw std::range_error("RcppStringVector: invalid string");
- int len = Rf_length(vec);
- if (len == 0)
- throw std::range_error("RcppStringVector: null vector in constructor");
- v = new std::string[len];
- for (i = 0; i < len; i++)
- v[i] = std::string(CHAR(STRING_ELT(vec,i)));
- length = len;
-}
-
-template <typename T>
-RcppVector<T>::RcppVector(SEXP vec) {
- int i;
-
- // The function Rf_isVector returns TRUE for vectors AND
- // matrices, so it does not distinguish. We could
- // check the dim attribute here to be sure that it
- // is not present (i.e., dimAttr == R_NilValue, not 0!).
- // But it is easier to simply check if it is set via
- // Rf_isMatrix (in which case we don't have a vector).
- if (!Rf_isNumeric(vec) || Rf_isMatrix(vec) || Rf_isLogical(vec))
- throw std::range_error("RcppVector: invalid numeric vector in constructor");
- len = Rf_length(vec);
- v = (T *)R_alloc(len, sizeof(T));
- if (Rf_isInteger(vec)) {
- for (i = 0; i < len; i++)
- v[i] = (T)(INTEGER(vec)[i]);
- }
- else if (Rf_isReal(vec)) {
- for (i = 0; i < len; i++)
- v[i] = (T)(REAL(vec)[i]);
- }
-}
-
-template <typename T>
-RcppVector<T>::RcppVector(int _len) {
- len = _len;
- v = (T *)R_alloc(len, sizeof(T));
- for (int i = 0; i < len; i++)
- v[i] = 0;
-}
-
-template <typename T>
-T *RcppVector<T>::cVector() {
- T* tmp = (T *)R_alloc(len, sizeof(T));
- for (int i = 0; i < len; i++)
- tmp[i] = v[i];
- return tmp;
-}
-
-template <typename T>
-std::vector<T> RcppVector<T>::stlVector() {
- std::vector<T> tmp(len);
- for (int i = 0; i < len; i++)
- tmp[i] = v[i];
- return tmp;
-}
-
-template <typename T>
-RcppMatrix<T>::RcppMatrix(SEXP mat) {
-
- if (!Rf_isNumeric(mat) || !Rf_isMatrix(mat))
- throw std::range_error("RcppMatrix: invalid numeric matrix in constructor");
-
- // Get matrix dimensions
- SEXP dimAttr = Rf_getAttrib(mat, R_DimSymbol);
- dim1 = INTEGER(dimAttr)[0];
- dim2 = INTEGER(dimAttr)[1];
-
- // We guard against the possibility that R might pass an integer matrix.
- // Can be prevented using R code: temp <- as.double(a), dim(temp) <- dim(a)
- int i,j;
- int isInt = Rf_isInteger(mat);
- T *m = (T *)R_alloc(dim1*dim2, sizeof(T));
- a = (T **)R_alloc(dim1, sizeof(T *));
- for (i = 0; i < dim1; i++)
- a[i] = m + i*dim2;
- if (isInt) {
- for (i=0; i < dim1; i++)
- for (j=0; j < dim2; j++)
- a[i][j] = (T)(INTEGER(mat)[i+dim1*j]);
- }
- else {
- for (i=0; i < dim1; i++)
- for (j=0; j < dim2; j++)
- a[i][j] = (T)(REAL(mat)[i+dim1*j]);
- }
-}
-
-template <typename T>
-RcppMatrix<T>::RcppMatrix(int _dim1, int _dim2) {
- dim1 = _dim1;
- dim2 = _dim2;
- int i,j;
- T *m = (T *)R_alloc(dim1*dim2, sizeof(T));
- a = (T **)R_alloc(dim1, sizeof(T *));
- for (i = 0; i < dim1; i++)
- a[i] = m + i*dim2;
- for (i=0; i < dim1; i++)
- for (j=0; j < dim2; j++)
- a[i][j] = 0;
-}
-
-template <typename T>
-std::vector<std::vector<T> > RcppMatrix<T>::stlMatrix() {
- int i,j;
- std::vector<std::vector<T> > temp;
- for (i = 0; i < dim1; i++) {
- temp.push_back(std::vector<T>(dim2));
- }
- for (i = 0; i < dim1; i++)
- for (j = 0; j < dim2; j++)
- temp[i][j] = a[i][j];
- return temp;
-}
-
-template <typename T>
-T **RcppMatrix<T>::cMatrix() {
- int i,j;
- T *m = (T *)R_alloc(dim1*dim2, sizeof(T));
- T **tmp = (T **)R_alloc(dim1, sizeof(T *));
- for (i = 0; i < dim1; i++)
- tmp[i] = m + i*dim2;
- for (i=0; i < dim1; i++)
- for (j=0; j < dim2; j++)
- tmp[i][j] = a[i][j];
- return tmp;
-}
-
-// Explicit instantiation (required for external linkage)
-template class RcppVector<int>;
-template class RcppVector<double>;
-template class RcppMatrix<int>;
-template class RcppMatrix<double>;
-
-template <typename T>
-RcppVectorView<T>::RcppVectorView(SEXP vec) {
- if (!Rf_isNumeric(vec) || Rf_isMatrix(vec) || Rf_isLogical(vec))
- throw std::range_error("RcppVectorView: invalid numeric vector in constructor");
- len = Rf_length(vec);
- if (Rf_isInteger(vec)) v = (T *)(INTEGER(vec));
- else if (Rf_isReal(vec)) v = (T *)(REAL(vec));
-}
-
-template class RcppVectorView<int>;
-template class RcppVectorView<double>;
-
-template <typename T>
-RcppMatrixView<T>::RcppMatrixView(SEXP mat) {
- if (!Rf_isNumeric(mat) || !Rf_isMatrix(mat))
- throw std::range_error("RcppMatrixView: invalid numeric matrix in constructor");
- // Get matrix dimensions
- SEXP dimAttr = Rf_getAttrib(mat, R_DimSymbol);
- d1 = INTEGER(dimAttr)[0];
- d2 = INTEGER(dimAttr)[1];
- if (Rf_isInteger(mat)) a = (T *)(INTEGER(mat));
- else if (Rf_isReal(mat)) a = (T *)(REAL(mat));
-}
-
-template class RcppMatrixView<int>;
-template class RcppMatrixView<double>;
-
-RcppStringVectorView::RcppStringVectorView(SEXP vec) {
- //int i;
- if (Rf_isMatrix(vec) || Rf_isLogical(vec))
- throw std::range_error("RcppStringVectorView: invalid numeric vector in constructor");
- if (!Rf_isString(vec))
- throw std::range_error("RcppStringVectorView: invalid string");
- int len = Rf_length(vec);
- if (len == 0)
- throw std::range_error("RcppStringVectorView: null vector in constructor");
- //v = new (char *)[len];
- //for (i = 0; i < len; i++)
- // v[i] = string(CHAR(STRING_ELT(vec,i)));
- length = len;
- v = vec;
-}
-
-
-void RcppResultSet::add(std::string name, RcppDate& date) {
- SEXP value = PROTECT(Rf_allocVector(REALSXP, 1));
- numProtected++;
- REAL(value)[0] = date.getJDN() - RcppDate::Jan1970Offset;
- SEXP dateclass = PROTECT(Rf_allocVector(STRSXP,1));
- numProtected++;
- SET_STRING_ELT(dateclass, 0, Rf_mkChar("Date"));
- Rf_setAttrib(value, R_ClassSymbol, dateclass);
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, RcppDatetime& datetime) {
- SEXP value = PROTECT(Rf_allocVector(REALSXP, 1));
- numProtected++;
- REAL(value)[0] = datetime.getFractionalTimestamp();
- SEXP datetimeclass = PROTECT(Rf_allocVector(STRSXP,2));
- numProtected++;
- SET_STRING_ELT(datetimeclass, 0, Rf_mkChar("POSIXt"));
- SET_STRING_ELT(datetimeclass, 1, Rf_mkChar("POSIXct"));
- Rf_setAttrib(value, R_ClassSymbol, datetimeclass);
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, double x) {
- SEXP value = PROTECT(Rf_allocVector(REALSXP, 1));
- numProtected++;
- REAL(value)[0] = x;
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, int i) {
- SEXP value = PROTECT(Rf_allocVector(INTSXP, 1));
- numProtected++;
- INTEGER(value)[0] = i;
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, std::string strvalue) {
- SEXP value = PROTECT(Rf_allocVector(STRSXP, 1));
- numProtected++;
- SET_STRING_ELT(value, 0, Rf_mkChar(strvalue.c_str()));
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, double *vec, int len) {
- if (vec == 0)
- throw std::range_error("RcppResultSet::add: NULL double vector");
- SEXP value = PROTECT(Rf_allocVector(REALSXP, len));
- numProtected++;
- for (int i = 0; i < len; i++)
- REAL(value)[i] = vec[i];
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, RcppDateVector& datevec) {
- SEXP value = PROTECT(Rf_allocVector(REALSXP, datevec.size()));
- numProtected++;
- for (int i = 0; i < datevec.size(); i++) {
- REAL(value)[i] = datevec(i).getJDN() - RcppDate::Jan1970Offset;
- }
- SEXP dateclass = PROTECT(Rf_allocVector(STRSXP,1));
- numProtected++;
- SET_STRING_ELT(dateclass, 0, Rf_mkChar("Date"));
- Rf_setAttrib(value, R_ClassSymbol, dateclass);
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, RcppDatetimeVector &dtvec) {
- SEXP value = PROTECT(Rf_allocVector(REALSXP, dtvec.size()));
- numProtected++;
- for (int i = 0; i < dtvec.size(); i++) {
- REAL(value)[i] = dtvec(i).getFractionalTimestamp();
- }
- SEXP datetimeclass = PROTECT(Rf_allocVector(STRSXP,2));
- numProtected++;
- SET_STRING_ELT(datetimeclass, 0, Rf_mkChar("POSIXt"));
- SET_STRING_ELT(datetimeclass, 1, Rf_mkChar("POSIXct"));
- Rf_setAttrib(value, R_ClassSymbol, datetimeclass);
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, RcppStringVector& stringvec) {
- int len = (int)stringvec.size();
- SEXP value = PROTECT(Rf_allocVector(STRSXP, len));
- numProtected++;
- for (int i = 0; i < len; i++)
- SET_STRING_ELT(value, i, Rf_mkChar(stringvec(i).c_str()));
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, int *vec, int len) {
- if (vec == 0)
- throw std::range_error("RcppResultSet::add: NULL int vector");
- SEXP value = PROTECT(Rf_allocVector(INTSXP, len));
- numProtected++;
- for (int i = 0; i < len; i++)
- INTEGER(value)[i] = vec[i];
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, double **mat, int nx, int ny) {
- if (mat == 0)
- throw std::range_error("RcppResultSet::add: NULL double matrix");
- SEXP value = PROTECT(Rf_allocMatrix(REALSXP, nx, ny));
- numProtected++;
- for (int i = 0; i < nx; i++)
- for (int j = 0; j < ny; j++)
- REAL(value)[i + nx*j] = mat[i][j];
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, int **mat, int nx, int ny) {
- if (mat == 0)
- throw std::range_error("RcppResultSet::add: NULL int matrix");
- SEXP value = PROTECT(Rf_allocMatrix(INTSXP, nx, ny));
- numProtected++;
- for (int i = 0; i < nx; i++)
- for (int j = 0; j < ny; j++)
- INTEGER(value)[i + nx*j] = mat[i][j];
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, std::vector<std::string>& vec) {
- if (vec.size() == 0)
- throw std::range_error("RcppResultSet::add; zero length vector<string>");
- int len = (int)vec.size();
- SEXP value = PROTECT(Rf_allocVector(STRSXP, len));
- numProtected++;
- for (int i = 0; i < len; i++)
- SET_STRING_ELT(value, i, Rf_mkChar(vec[i].c_str()));
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, std::vector<int>& vec) {
- if (vec.size() == 0)
- throw std::range_error("RcppResultSet::add; zero length vector<int>");
- int len = (int)vec.size();
- SEXP value = PROTECT(Rf_allocVector(INTSXP, len));
- numProtected++;
- for (int i = 0; i < len; i++)
- INTEGER(value)[i] = vec[i];
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, std::vector<double>& vec) {
- if (vec.size() == 0)
- throw std::range_error("RcppResultSet::add; zero length vector<double>");
- int len = (int)vec.size();
- SEXP value = PROTECT(Rf_allocVector(REALSXP, len));
- numProtected++;
- for (int i = 0; i < len; i++)
- REAL(value)[i] = vec[i];
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, std::vector<std::vector<int> >& mat) {
- if (mat.size() == 0)
- throw std::range_error("RcppResultSet::add: zero length vector<vector<int> >");
- else if (mat[0].size() == 0)
- throw std::range_error("RcppResultSet::add: no columns in vector<vector<int> >");
- int nx = (int)mat.size();
- int ny = (int)mat[0].size();
- SEXP value = PROTECT(Rf_allocMatrix(INTSXP, nx, ny));
- numProtected++;
- for (int i = 0; i < nx; i++)
- for (int j = 0; j < ny; j++)
- INTEGER(value)[i + nx*j] = mat[i][j];
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, std::vector<std::vector<double> >& mat) {
- if (mat.size() == 0)
- throw std::range_error("RcppResultSet::add: zero length vector<vector<double> >");
- else if (mat[0].size() == 0)
- throw std::range_error("RcppResultSet::add: no columns in vector<vector<double> >");
- int nx = (int)mat.size();
- int ny = (int)mat[0].size();
- SEXP value = PROTECT(Rf_allocMatrix(REALSXP, nx, ny));
- numProtected++;
- for (int i = 0; i < nx; i++)
- for (int j = 0; j < ny; j++)
- REAL(value)[i + nx*j] = mat[i][j];
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, RcppVector<int>& vec) {
- int len = vec.size();
- int *a = vec.cVector();
- SEXP value = PROTECT(Rf_allocVector(INTSXP, len));
- numProtected++;
- for (int i = 0; i < len; i++)
- INTEGER(value)[i] = a[i];
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, RcppVector<double>& vec) {
- int len = vec.size();
- double *a = vec.cVector();
- SEXP value = PROTECT(Rf_allocVector(REALSXP, len));
- numProtected++;
- for (int i = 0; i < len; i++)
- REAL(value)[i] = a[i];
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, RcppMatrix<int>& mat) {
- int nx = mat.getDim1();
- int ny = mat.getDim2();
- int **a = mat.cMatrix();
- SEXP value = PROTECT(Rf_allocMatrix(INTSXP, nx, ny));
- numProtected++;
- for (int i = 0; i < nx; i++)
- for (int j = 0; j < ny; j++)
- INTEGER(value)[i + nx*j] = a[i][j];
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, RcppMatrix<double>& mat) {
- int nx = mat.getDim1();
- int ny = mat.getDim2();
- double **a = mat.cMatrix();
- SEXP value = PROTECT(Rf_allocMatrix(REALSXP, nx, ny));
- numProtected++;
- for (int i = 0; i < nx; i++)
- for (int j = 0; j < ny; j++)
- REAL(value)[i + nx*j] = a[i][j];
- values.push_back(make_pair(name, value));
-}
-
-void RcppResultSet::add(std::string name, RcppFrame& frame) {
- std::vector<std::string> colNames = frame.getColNames();
- std::vector<std::vector<ColDatum> > table = frame.getTableData();
- int ncol = colNames.size();
- int nrow = table.size();
- SEXP rl = PROTECT(Rf_allocVector(VECSXP,ncol));
- SEXP nm = PROTECT(Rf_allocVector(STRSXP,ncol));
- numProtected += 2;
- for (int i=0; i < ncol; i++) {
- SEXP value, names;
- if (table[0][i].getType() == COLTYPE_DOUBLE) {
- value = PROTECT(Rf_allocVector(REALSXP,nrow));
- numProtected++;
- for (int j=0; j < nrow; j++)
- REAL(value)[j] = table[j][i].getDoubleValue();
- } else if (table[0][i].getType() == COLTYPE_INT) {
- value = PROTECT(Rf_allocVector(INTSXP,nrow));
- numProtected++;
- for (int j=0; j < nrow; j++)
- INTEGER(value)[j] = table[j][i].getIntValue();
- } else if (table[0][i].getType() == COLTYPE_FACTOR) {
- value = PROTECT(Rf_allocVector(INTSXP,nrow));
- numProtected++;
- int levels = table[0][i].getFactorNumLevels();
- names = PROTECT(Rf_allocVector(STRSXP,levels));
- numProtected++;
- std::string *levelNames = table[0][i].getFactorLevelNames();
- for (int k=0; k < levels; k++)
- SET_STRING_ELT(names, k, Rf_mkChar(levelNames[k].c_str()));
- for (int j=0; j < nrow; j++) {
- int level = table[j][i].getFactorLevel();
- INTEGER(value)[j] = level;
- }
- Rf_setAttrib(value, R_LevelsSymbol, names);
- SEXP factorclass = PROTECT(Rf_allocVector(STRSXP,1));
- numProtected++;
- SET_STRING_ELT(factorclass, 0, Rf_mkChar("factor"));
- Rf_setAttrib(value, R_ClassSymbol, factorclass);
- } else if (table[0][i].getType() == COLTYPE_STRING) {
- value = PROTECT(Rf_allocVector(STRSXP,nrow));
- numProtected++;
- for (int j=0; j < nrow; j++) {
- SET_STRING_ELT(value, j, Rf_mkChar(table[j][i].getStringValue().c_str()));
- }
- } else if (table[0][i].getType() == COLTYPE_LOGICAL) {
- value = PROTECT(Rf_allocVector(LGLSXP,nrow));
- numProtected++;
- for (int j=0; j < nrow; j++) {
- LOGICAL(value)[j] = table[j][i].getLogicalValue();
- }
- } else if (table[0][i].getType() == COLTYPE_DATE) {
- value = PROTECT(Rf_allocVector(REALSXP,nrow));
- numProtected++;
- for (int j=0; j < nrow; j++)
- REAL(value)[j] = table[j][i].getDateRCode();
- SEXP dateclass = PROTECT(Rf_allocVector(STRSXP,1));
- numProtected++;
- SET_STRING_ELT(dateclass, 0, Rf_mkChar("Date"));
- Rf_setAttrib(value, R_ClassSymbol, dateclass);
- } else if (table[0][i].getType() == COLTYPE_DATETIME) {
- value = PROTECT(Rf_allocVector(REALSXP,nrow));
- numProtected++;
- for (int j=0; j < nrow; j++) {
- // we could access the seconds as the internal double via getDouble but it's
- // more proper to use the proper accessor (and if we ever added code ...)
- REAL(value)[j] = table[j][i].getDatetimeValue().getFractionalTimestamp();
- }
- SEXP dateclass = PROTECT(Rf_allocVector(STRSXP,2));
- numProtected++;
- SET_STRING_ELT(dateclass, 0, Rf_mkChar("POSIXt"));
- SET_STRING_ELT(dateclass, 1, Rf_mkChar("POSIXct"));
- Rf_setAttrib(value, R_ClassSymbol, dateclass);
- } else {
- throw std::range_error("RcppResultSet::add invalid column type");
- }
- SET_VECTOR_ELT(rl, i, value);
- SET_STRING_ELT(nm, i, Rf_mkChar(colNames[i].c_str()));
- }
- Rf_setAttrib(rl, R_NamesSymbol, nm);
- values.push_back(make_pair(name, rl));
-}
-
-void RcppResultSet::add(std::string name, RcppList &list) {
- // we let RcppList export itself as a SEXP and send it along
- values.push_back(make_pair(name, list.getList()));
-}
-
-void RcppResultSet::add(std::string name, SEXP sexp, bool isProtected) {
- values.push_back(make_pair(name, sexp));
- if (isProtected)
- numProtected++;
-}
-
-SEXP RcppResultSet::getReturnList() {
- int nret = (int)values.size();
- SEXP rl = PROTECT(Rf_allocVector(VECSXP,nret));
- SEXP nm = PROTECT(Rf_allocVector(STRSXP,nret));
- std::list<std::pair<std::string,SEXP> >::iterator iter = values.begin();
- for (int i = 0; iter != values.end(); iter++, i++) {
- SET_VECTOR_ELT(rl, i, iter->second);
- SET_STRING_ELT(nm, i, Rf_mkChar(iter->first.c_str()));
- }
- Rf_setAttrib(rl, R_NamesSymbol, nm);
- UNPROTECT(numProtected+2);
- return rl;
-}
-
-SEXP RcppFunction::listCall() {
- if (names.size() != (unsigned)listSize)
- throw std::range_error("RcppFunction::listCall: no. of names != no. of items");
- if (currListPosn != listSize)
- throw std::range_error("RcppFunction::listCall: list has incorrect size");
- SEXP nm = PROTECT(Rf_allocVector(STRSXP,listSize));
- numProtected++;
- for (int i=0; i < listSize; i++)
- SET_STRING_ELT(nm, i, Rf_mkChar(names[i].c_str()));
- Rf_setAttrib(listArg, R_NamesSymbol, nm);
- SEXP R_fcall;
- PROTECT(R_fcall = Rf_lang2(fn, R_NilValue));
- numProtected++;
- SETCADR(R_fcall, listArg);
- SEXP result = Rf_eval(R_fcall, R_NilValue);
- names.clear();
- listSize = currListPosn = 0; // Ready for next call.
- return result;
-}
-
-SEXP RcppFunction::vectorCall() {
- if (vectorArg == R_NilValue)
- throw std::range_error("RcppFunction::vectorCall: vector has not been set");
- SEXP R_fcall;
- PROTECT(R_fcall = Rf_lang2(fn, R_NilValue));
- numProtected++;
- SETCADR(R_fcall, vectorArg);
- SEXP result = Rf_eval(R_fcall, R_NilValue);
- vectorArg = R_NilValue; // Ready for next call.
- return result;
-}
-
-void RcppFunction::setRVector(std::vector<double>& v) {
- vectorArg = PROTECT(Rf_allocVector(REALSXP,v.size()));
- numProtected++;
- for (int i=0; i < (int)v.size(); i++)
- REAL(vectorArg)[i] = v[i];
-}
-
-void RcppFunction::setRListSize(int n) {
- listSize = n;
- listArg = PROTECT(Rf_allocVector(VECSXP, n));
- numProtected++;
-}
-
-void RcppFunction::appendToRList(std::string name, double value) {
- if (currListPosn < 0 || currListPosn >= listSize)
- throw std::range_error("RcppFunction::appendToRList(double): list posn out of range");
- SEXP valsxp = PROTECT(Rf_allocVector(REALSXP,1));
- numProtected++;
- REAL(valsxp)[0] = value;
- SET_VECTOR_ELT(listArg, currListPosn++, valsxp);
- names.push_back(name);
-}
-
-void RcppFunction::appendToRList(std::string name, int value) {
- if (currListPosn < 0 || currListPosn >= listSize)
- throw std::range_error("RcppFunction::appendToRlist(int): posn out of range");
- SEXP valsxp = PROTECT(Rf_allocVector(INTSXP,1));
- numProtected++;
- INTEGER(valsxp)[0] = value;
- SET_VECTOR_ELT(listArg, currListPosn++, valsxp);
- names.push_back(name);
-}
-
-void RcppFunction::appendToRList(std::string name, std::string value) {
- if (currListPosn < 0 || currListPosn >= listSize)
- throw std::range_error("RcppFunction::appendToRlist(string): posn out of range");
- SEXP valsxp = PROTECT(Rf_allocVector(STRSXP,1));
- numProtected++;
- SET_STRING_ELT(valsxp, 0, Rf_mkChar(value.c_str()));
- SET_VECTOR_ELT(listArg, currListPosn++, valsxp);
- names.push_back(name);
-}
-
-void RcppFunction::appendToRList(std::string name, RcppDate& date) {
- if (currListPosn < 0 || currListPosn >= listSize)
- throw std::range_error("RcppFunction::appendToRlist(RcppDate): list posn out of range");
- SEXP valsxp = PROTECT(Rf_allocVector(REALSXP,1));
- numProtected++;
- REAL(valsxp)[0] = date.getJDN() - RcppDate::Jan1970Offset;
- SEXP dateclass = PROTECT(Rf_allocVector(STRSXP, 1));
- numProtected++;
- SET_STRING_ELT(dateclass, 0, Rf_mkChar("Date"));
- Rf_setAttrib(valsxp, R_ClassSymbol, dateclass);
- SET_VECTOR_ELT(listArg, currListPosn++, valsxp);
- names.push_back(name);
-}
-
-void RcppFunction::appendToRList(std::string name, RcppDatetime& datetime) {
- if (currListPosn < 0 || currListPosn >= listSize)
- throw std::range_error("RcppFunction::appendToRlist(RcppDatetime): list posn out of range");
- SEXP valsxp = PROTECT(Rf_allocVector(REALSXP,1));
- numProtected++;
- REAL(valsxp)[0] = datetime.getFractionalTimestamp();
- SEXP datetimeclass = PROTECT(Rf_allocVector(STRSXP, 2));
- numProtected++;
- SET_STRING_ELT(datetimeclass, 0, Rf_mkChar("POSIXt"));
- SET_STRING_ELT(datetimeclass, 1, Rf_mkChar("POSIXct"));
- Rf_setAttrib(valsxp, R_ClassSymbol, datetimeclass);
- SET_VECTOR_ELT(listArg, currListPosn++, valsxp);
- names.push_back(name);
-}
-
-#include <cstring>
-
-// Paul Roebuck has observed that the memory used by an exception message
-// is not reclaimed if error() is called inside of a catch block (due to
-// a setjmp() call), and he suggested the following work-around.
-char *copyMessageToR(const char* const mesg) {
- char* Rmesg;
- const char* prefix = "Exception: ";
- void* Rheap = R_alloc(strlen(prefix)+strlen(mesg)+1,sizeof(char));
- Rmesg = static_cast<char*>(Rheap);
- strcpy(Rmesg, prefix);
- strcat(Rmesg, mesg);
- return Rmesg;
-}
-
Modified: pkg/src/Rcpp.h
===================================================================
--- pkg/src/Rcpp.h 2009-11-16 01:09:04 UTC (rev 174)
+++ pkg/src/Rcpp.h 2009-11-16 01:09:41 UTC (rev 175)
@@ -2,7 +2,6 @@
//
// Rcpp.h: R/C++ interface class library
//
-// Copyright (C) 2005 - 2006 Dominick Samperi
// Copyright (C) 2008 - 2009 Dirk Eddelbuettel
//
// This library is free software; you can redistribute it and/or modify it
@@ -24,286 +23,20 @@
#include <RcppCommon.h>
#include <RcppDate.h>
+#include <RcppDateVector.h>
#include <RcppDatetime.h>
+#include <RcppDatetimeVector.h>
#include <RcppFrame.h>
+#include <RcppFunction.h>
#include <RcppList.h>
+#include <RcppMatrix.h>
+#include <RcppMatrixView.h>
+#include <RcppNumList.h>
#include <RcppParams.h>
+#include <RcppResultSet.h>
+#include <RcppStringVector.h>
+#include <RcppStringVectorView.h>
+#include <RcppVector.h>
+#include <RcppVectorView.h>
-class RcppNumList {
-public:
- RcppNumList(SEXP theList) {
- if (!Rf_isNewList(theList))
- throw std::range_error("RcppNumList: non-list passed to constructor");
- len = Rf_length(theList);
- names = Rf_getAttrib(theList, R_NamesSymbol);
- namedList = theList;
- }
- std::string getName(int i) {
- if (i < 0 || i >= len) {
- std::ostringstream oss;
- oss << "RcppNumList::getName: index out of bounds: " << i;
- throw std::range_error(oss.str());
- }
- return std::string(CHAR(STRING_ELT(names,i)));
- }
- double getValue(int i) {
- if (i < 0 || i >= len) {
- std::ostringstream oss;
- oss << "RcppNumList::getValue: index out of bounds: " << i;
- throw std::range_error(oss.str());
- }
- SEXP elt = VECTOR_ELT(namedList, i);
- if (Rf_isReal(elt))
- return REAL(elt)[0];
- else if (Rf_isInteger(elt))
- return (double)INTEGER(elt)[0];
- else
- throw std::range_error("RcppNumList: contains non-numeric value");
- return 0; // never get here
- }
- int size() { return len; }
-private:
- int len;
- SEXP namedList;
- SEXP names;
-};
-
-template <typename T>
-class RcppVector {
-public:
- RcppVector(SEXP vec);
- RcppVector(int len);
- int size() { return len; }
- inline T& operator()(int i) {
- if (i < 0 || i >= len) {
- std::ostringstream oss;
- oss << "RcppVector: subscript out of range: " << i;
- throw std::range_error(oss.str());
- }
- return v[i];
- }
- T *cVector();
- std::vector<T> stlVector();
-private:
- int len;
- T *v;
-};
-
-class RcppStringVector {
-public:
- RcppStringVector(SEXP vec);
- ~RcppStringVector() {
- delete [] v;
- }
- inline std::string& operator()(int i) {
- if (i < 0 || i >= length) {
- std::ostringstream oss;
- oss << "RcppStringVector: subscript out of range: " << i;
- throw std::range_error(oss.str());
- }
- return v[i];
- }
- int size() { return length; }
- inline std::vector<std::string> stlVector() {
- std::vector<std::string> tmp(length);
- for (int i = 0; i < length; i++)
- tmp[i] = v[i];
- return tmp;
- }
-private:
- std::string *v;
- int length;
-};
-
-class RcppDateVector {
-public:
- RcppDateVector(SEXP vec);
- ~RcppDateVector() {
- delete [] v;
- }
- inline RcppDate& operator()(int i) {
- if (i < 0 || i >= length) {
- std::ostringstream oss;
- oss << "RcppDateVector: subscript out of range: " << i;
- throw std::range_error(oss.str());
- }
- return v[i];
- }
- int size() { return length; }
-private:
- RcppDate *v;
- int length;
-};
-
-class RcppDatetimeVector {
-public:
- RcppDatetimeVector(SEXP vec);
- ~RcppDatetimeVector() {
- delete [] v;
- }
- inline RcppDatetime &operator()(int i) {
- if (i < 0 || i >= length) {
- std::ostringstream oss;
- oss << "RcppDatetimeVector: subscript out of range: " << i;
- throw std::range_error(oss.str());
- }
- return v[i];
- }
- int size() { return length; }
-private:
- RcppDatetime *v;
- int length;
-};
-
-template <typename T>
-class RcppMatrix {
-public:
- RcppMatrix(SEXP mat);
- RcppMatrix(int nx, int ny);
- int getDim1() { return dim1; }
- int getDim2() { return dim2; }
- int rows() { return dim1; }
- int cols() { return dim2; }
- inline T& operator()(int i, int j) {
- if (i < 0 || i >= dim1 || j < 0 || j >= dim2) {
- std::ostringstream oss;
- oss << "RcppMatrix: subscripts out of range: " << i << ", " << j;
- throw std::range_error(oss.str());
- }
- return a[i][j];
- }
- T **cMatrix();
- std::vector<std::vector<T> > stlMatrix();
-private:
- int dim1, dim2;
- T **a;
-};
-
-
-
-
-template <typename T>
-class RcppVectorView {
-public:
- RcppVectorView(SEXP vec);
- inline int size() const { return len; }
- inline T operator()(int i) const {
- if (i < 0 || i >= len) {
- std::ostringstream oss;
- oss << "RcppVectorView: subscript out of range: " << i;
- throw std::range_error(oss.str());
- }
- return v[i];
- }
-private:
- int len;
- T *v;
-};
-
-template <typename T>
-class RcppMatrixView {
-public:
- RcppMatrixView(SEXP mat);
- inline int dim1() const { return d1; }
- inline int dim2() const { return d2; }
- inline int rows() { return d1; }
- inline int cols() { return d2; }
- inline T operator()(int i, int j) const {
- if (i < 0 || i >= d1 || j < 0 || j >= d2) {
- std::ostringstream oss;
- oss << "RcppMatrixView: subscripts out of range: " << i << ", " << j;
- throw std::range_error(oss.str());
- }
- return a[i + d1 * j];
- }
-private:
- int d1, d2;
- T *a;
-};
-
-class RcppStringVectorView {
-public:
- RcppStringVectorView(SEXP vec);
- inline const char *operator()(int i) {
- if (i < 0 || i >= length) {
- std::ostringstream oss;
- oss << "RcppStringVector: subscript out of range: " << i;
- throw std::range_error(oss.str());
- }
- return CHAR(STRING_ELT(v,i));
- }
- int size() { return length; }
-private:
- SEXP v;
- int length;
-};
-
-
-class RcppFunction {
-public:
- RcppFunction(SEXP fn) : fn(fn) {
- if (!Rf_isFunction(fn))
- throw std::range_error("RcppFunction: non-function where function expected");
- numProtected = 0;
- currListPosn = 0;
- listSize = 0;
- vectorArg = listArg = R_NilValue;
- };
- ~RcppFunction() {
- UNPROTECT(numProtected);
- }
- SEXP listCall();
- SEXP vectorCall();
- void setRVector(std::vector<double>& v);
- void setRListSize(int size);
- void appendToRList(std::string name, double value);
- void appendToRList(std::string name, int value);
- void appendToRList(std::string name, std::string value);
- void appendToRList(std::string name, RcppDate& date);
- void appendToRList(std::string name, RcppDatetime& datetime);
- void clearProtectionStack() {
- UNPROTECT(numProtected);
- numProtected = 0;
- }
-
-private:
- SEXP fn, listArg, vectorArg;
- int listSize, currListPosn, numProtected;
- std::vector<std::string> names;
-};
-
-class RcppResultSet {
-public:
- RcppResultSet() { numProtected = 0; }
- void add(std::string, double);
- void add(std::string, int);
- void add(std::string, std::string);
- void add(std::string, double *, int);
- void add(std::string, int *, int);
- void add(std::string, double **, int, int);
- void add(std::string, int **, int, int);
- void add(std::string, RcppDate&);
- void add(std::string, RcppDateVector&);
- void add(std::string, RcppDatetime&);
- void add(std::string, RcppDatetimeVector&);
- void add(std::string, RcppStringVector&);
- void add(std::string, std::vector<double>&);
- void add(std::string, std::vector<int>&);
- void add(std::string, std::vector<std::vector<double> >&);
- void add(std::string, std::vector<std::vector<int> >&);
- void add(std::string, std::vector<std::string>&);
- void add(std::string, RcppVector<int>&);
- void add(std::string, RcppVector<double>&);
- void add(std::string, RcppMatrix<int>&);
- void add(std::string, RcppMatrix<double>&);
- void add(std::string, RcppFrame&);
- void add(std::string, RcppList&);
- void add(std::string, SEXP, bool isProtected);
- SEXP getReturnList();
-protected:
- int numProtected;
- std::list<std::pair<std::string,SEXP> > values;
-};
-
-
#endif
Copied: pkg/src/RcppCommon.cpp (from rev 171, pkg/src/Rcpp.cpp)
===================================================================
--- pkg/src/RcppCommon.cpp (rev 0)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rcpp -r 175
More information about the Rcpp-commits
mailing list