[Rcpp-commits] r200 - in pkg: inst inst/examples/RcppInline src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Dec 19 17:38:24 CET 2009


Author: edd
Date: 2009-12-19 17:38:24 +0100 (Sat, 19 Dec 2009)
New Revision: 200

Modified:
   pkg/inst/ChangeLog
   pkg/inst/examples/RcppInline/RcppSexpTests.r
   pkg/src/RcppSexp.cpp
   pkg/src/RcppSexp.h
Log:
added new converters for vectors of int, double, std::string to RcppSexp
expanded example to use these


Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2009-12-19 16:28:42 UTC (rev 199)
+++ pkg/inst/ChangeLog	2009-12-19 16:38:24 UTC (rev 200)
@@ -1,7 +1,10 @@
 2009-12-19  Dirk Eddelbuettel  <edd at debian.org>
 
+	* src/RcppSexp.{h,cpp}: Added converters for vectors of
+	  int, double, and std::string vectors
 	* src/RcppResultsSetp.{h,cpp}: Added simple single SEXP return
 	* src/RcppCommon.{h,cpp}: Adding simple logging facility
+	* inst/examples/RcppInline/RcppSexpTests.r: expanded for new types
 
 2009-12-18  Dirk Eddelbuettel  <edd at debian.org>
 

Modified: pkg/inst/examples/RcppInline/RcppSexpTests.r
===================================================================
--- pkg/inst/examples/RcppInline/RcppSexpTests.r	2009-12-19 16:28:42 UTC (rev 199)
+++ pkg/inst/examples/RcppInline/RcppSexpTests.r	2009-12-19 16:38:24 UTC (rev 200)
@@ -1,4 +1,4 @@
-#!/usr/bin/r
+#!/usr/bin/r -t
 
 suppressMessages(library(Rcpp))
 
@@ -25,7 +25,6 @@
 cat(funx(x=2), "\n")
 cat(funx(x=2.2), "\n")
 
-
 cat("\n===String\n")
 foo <- '
         std::string s = RcppSexp(x).asStdString();
@@ -35,3 +34,60 @@
 funx <- cfunction(signature(x="character"), foo, Rcpp=TRUE, verbose=FALSE)
 cat(funx(x="abc"), "\n")
 
+cat("\n===Int Vector via RcppResultSet.getSEXP\n")
+foo <- '
+        std::vector<int> iv = RcppSexp(x).asStdVectorInt();
+	std::cout << "Returning twice the value of vector : ";
+        for (size_t i=0; i<iv.size(); i++) {
+            iv[i] = 2*iv[i];
+        }
+        RcppResultSet rs;
+        rs.add("", iv);
+        return(rs.getSEXP());
+        '
+funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
+print(funx(x=2:5))
+
+## does not work
+#cat("\n===Int Vector\n")
+#foo <- '
+#        std::vector<int> iv = RcppSexp(x).asStdVectorInt();
+#	std::cout << "Returning twice the value of vector : ";
+#        for (size_t i=0; i<iv.size(); i++) {
+#            iv[i] = 2*iv[i];
+#        }
+#        RcppSexp t = RcppSexp( iv );
+#	return(t.asSexp());
+#        '
+#funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
+#print(funx(x=2:5))
+
+
+cat("\n===Double Vector via RcppResultSet.getSEXP\n")
+foo <- '
+        std::vector<double> iv = RcppSexp(x).asStdVectorDouble();
+	std::cout << "Returning twice the value of vector : ";
+        for (size_t i=0; i<iv.size(); i++) {
+            iv[i] = 2*iv[i];
+        }
+        RcppResultSet rs;
+        rs.add("", iv);
+        return(rs.getSEXP());
+        '
+funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
+print(funx(x=0.1+2:5))
+
+
+cat("\n===String Vector via RcppResultSet.getSEXP\n")
+foo <- '
+        std::vector<std::string> iv = RcppSexp(x).asStdVectorString();
+	std::cout << "Returning twice the value of vector : ";
+        for (size_t i=0; i<iv.size(); i++) {
+            iv[i] = iv[i] + iv[i];
+        }
+        RcppResultSet rs;
+        rs.add("", iv);
+        return(rs.getSEXP());
+        '
+funx <- cfunction(signature(x="character"), foo, Rcpp=TRUE, verbose=FALSE)
+print(funx(x=c("foo", "bar")))

Modified: pkg/src/RcppSexp.cpp
===================================================================
--- pkg/src/RcppSexp.cpp	2009-12-19 16:28:42 UTC (rev 199)
+++ pkg/src/RcppSexp.cpp	2009-12-19 16:38:24 UTC (rev 200)
@@ -22,24 +22,39 @@
 #include <RcppSexp.h>
 
 RcppSexp::RcppSexp(const double & v) {
+    logTxt("RcppSexp from double\n");
     m_sexp = PROTECT(Rf_allocVector(REALSXP, 1));
     m_nprot++;
     REAL(m_sexp)[0] = v;
 }
 
 RcppSexp::RcppSexp(const int & v) {
+    logTxt("RcppSexp from int\n");
     m_sexp = PROTECT(Rf_allocVector(INTSXP, 1));
     m_nprot++;
     INTEGER(m_sexp)[0] = v;
 }
 
 RcppSexp::RcppSexp(const std::string & v) {
+    logTxt("RcppSexp from std::string\n");
     m_sexp = PROTECT(Rf_allocVector(STRSXP, 1));
     m_nprot++;
     SET_STRING_ELT(m_sexp, 0, Rf_mkChar(v.c_str()));
 }
 
+RcppSexp::RcppSexp(const std::vector<int> & v) {
+    logTxt("RcppSexp from int vector\n");
+    int n = v.size();
+    m_sexp = PROTECT(Rf_allocVector(INTSXP, n));
+    m_nprot++;
+    for (int i = 0; i < n; i++) {
+	Rprintf("%d\n", v[i]);
+	INTEGER(m_sexp)[i] = v[i];
+    }	
+}
+
 RcppSexp::~RcppSexp() {
+    logTxt("dtor");
     UNPROTECT(m_nprot);
 }
 
@@ -88,6 +103,51 @@
 }
 
 SEXP RcppSexp::asSexp() const {
-    return m_sexp;
+    SEXP val = m_sexp;
+    return val;
 }
 
+std::vector<int> RcppSexp::asStdVectorInt() const {
+    int n = Rf_length(m_sexp);
+    std::vector<int> v(n);
+    if (Rf_isInteger(m_sexp)) {
+	for (int i = 0; i < n; i++) {
+	    v[i] = INTEGER(m_sexp)[i];
+	}
+    } else if (Rf_isReal(m_sexp)) {
+	for (int i = 0; i < n; i++) {
+	    v[i] = (int)REAL(m_sexp)[i];
+	}
+    }
+    return v;
+}
+
+
+std::vector<double> RcppSexp::asStdVectorDouble() const {
+    int n = Rf_length(m_sexp);
+    std::vector<double> v(n);
+    if (Rf_isInteger(m_sexp)) {
+	for (int i = 0; i < n; i++) {
+	    v[i] = (double)INTEGER(m_sexp)[i];
+	}
+    } else if (Rf_isReal(m_sexp)) {
+	for (int i = 0; i < n; i++) {
+	    v[i] = REAL(m_sexp)[i];
+	}
+    }
+    return v;
+}
+
+
+std::vector<std::string> RcppSexp::asStdVectorString() const {
+    int n = Rf_length(m_sexp);
+    std::vector<std::string> v(n);
+    if (!Rf_isString(m_sexp)) {
+	throw std::range_error("RcppSexp::asStdVectorString expects string");
+    }
+    for (int i = 0; i < n; i++) {
+	v[i] = std::string(CHAR(STRING_ELT(m_sexp,i)));
+    }
+    return v;
+}
+

Modified: pkg/src/RcppSexp.h
===================================================================
--- pkg/src/RcppSexp.h	2009-12-19 16:28:42 UTC (rev 199)
+++ pkg/src/RcppSexp.h	2009-12-19 16:38:24 UTC (rev 200)
@@ -26,18 +26,22 @@
 
 class RcppSexp {
 public:
-    RcppSexp(SEXP sexp, int numprot=0) : m_sexp(sexp), m_nprot(numprot) {}
-    RcppSexp() : m_sexp(R_NilValue), m_nprot(0) {}
+    RcppSexp(SEXP sexp, int numprot=0) : m_sexp(sexp), m_nprot(numprot) { }
+    RcppSexp() : m_sexp(R_NilValue), m_nprot(0) { }
     RcppSexp(const double & v);
     RcppSexp(const int & v);
     RcppSexp(const std::string & v);
+    RcppSexp(const std::vector<int> & v);
     ~RcppSexp();
 
-    double asDouble() const;
-    int asInt() const;
-    std::string asStdString() const;
-    SEXP asSexp() const;
-
+    double                   asDouble() const;
+    int                      asInt() const;
+    std::string              asStdString() const;
+    std::vector<int>         asStdVectorInt() const;
+    std::vector<double>      asStdVectorDouble() const;
+    std::vector<std::string> asStdVectorString() const;
+    SEXP                     asSexp() const;
+    
 private:
     SEXP m_sexp;
     int m_nprot;



More information about the Rcpp-commits mailing list