[Rcpp-devel] [Rcpp-commits] r213 - in pkg: inst inst/examples/RcppInline src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Dec 27 10:09:27 CET 2009
Author: romain
Date: 2009-12-27 10:09:26 +0100 (Sun, 27 Dec 2009)
New Revision: 213
Modified:
pkg/inst/ChangeLog
pkg/inst/examples/RcppInline/RcppSexpTests.r
pkg/src/RcppSexp.cpp
pkg/src/RcppSexp.h
Log:
added support for bool and vector<bool> in RcppSexp + examples/tests
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2009-12-26 18:52:12 UTC (rev 212)
+++ pkg/inst/ChangeLog 2009-12-27 09:09:26 UTC (rev 213)
@@ -1,4 +1,13 @@
+2009-12-27 Romain Francois <francoisromain at free.fr>
+
+ * src/RcppSexp.{h,cpp} : added RcppSexp(bool), RcppSexp(vector<bool>)
+ constructors and RcppSexp.asBool(), RcppSexp.asStdVectorBool() methods
+
+ * inst/examples/RcppInline/RcppSexpTests.r: examples/tests of the
+ above
+
2009-12-26 Romain Francois <francoisromain at free.fr>
+
* src/RcppSexp.{h,cpp} : added std::set<{int,double,Rbyte,string}> as
accepted input type for the RcppSexp class (needed by RProtoBuf)
Modified: pkg/inst/examples/RcppInline/RcppSexpTests.r
===================================================================
--- pkg/inst/examples/RcppInline/RcppSexpTests.r 2009-12-26 18:52:12 UTC (rev 212)
+++ pkg/inst/examples/RcppInline/RcppSexpTests.r 2009-12-27 09:09:26 UTC (rev 213)
@@ -49,7 +49,27 @@
funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
cat( funx(x=as.raw(2)), "\n")
+cat("\n=== logical \n")
+foo <- '
+bool b = RcppSexp(x).asBool();
+std::cout << "flip " << ( b ? "TRUE" : "FALSE" ) << " : ";
+return(RcppSexp( !b ).asSexp());
+'
+funx <- cfunction(signature(x="logical"), foo, Rcpp=TRUE, verbose=FALSE)
+cat( res <- funx(x=TRUE) , "\n") ; stopifnot( !res )
+cat( res <- funx(x=FALSE), "\n" ) ; stopifnot( res)
+funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
+cat( res <- funx(x=2) , "\n") ; stopifnot( !res )
+cat( res <- funx(x=0.0), "\n") ; stopifnot( res)
+funx <- cfunction(signature(x="integer"), foo, Rcpp=TRUE, verbose=FALSE)
+cat( res <- funx(x=2L), "\n") ; stopifnot( !res )
+cat( res <- funx(x=0L), "\n") ; stopifnot( res)
+funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
+cat( res <- funx(x=as.raw(2)), "\n") ; stopifnot( !res )
+cat( res <- funx(x=as.raw(0)), "\n") ; stopifnot( res)
+### vectors
+
cat("\n===Int Vector via RcppResultSet.getSEXP\n")
foo <- '
std::vector<int> iv = RcppSexp(x).asStdVectorInt();
@@ -117,6 +137,25 @@
funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
print(funx(x=0:9+.1))
+cat("\n=== vector<bool>\n")
+foo <- '
+std::vector<bool> bv = RcppSexp(x).asStdVectorBool();
+std::cout << "Flip the value of vector : ";
+for (size_t i=0; i<bv.size(); i++) {
+ bv[i].flip() ;
+}
+return(RcppSexp( bv ).asSexp());
+'
+funx <- cfunction(signature(x="logical"), foo, Rcpp=TRUE, verbose=FALSE)
+print(funx(x=c(TRUE,FALSE)))
+funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
+print(funx(x=as.raw(0:9)))
+funx <- cfunction(signature(x="integer"), foo, Rcpp=TRUE, verbose=FALSE)
+print(funx(x=0:9))
+funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
+print(funx(x=as.numeric(0:9)))
+
+
cat("\n===String Vector\n")
foo <- '
std::vector<std::string> iv = RcppSexp(x).asStdVectorString();
Modified: pkg/src/RcppSexp.cpp
===================================================================
--- pkg/src/RcppSexp.cpp 2009-12-26 18:52:12 UTC (rev 212)
+++ pkg/src/RcppSexp.cpp 2009-12-27 09:09:26 UTC (rev 213)
@@ -22,6 +22,12 @@
#include <RcppSexp.h>
#include <algorithm>
+RcppSexp::RcppSexp(const bool & v) {
+ logTxt("RcppSexp from bool\n");
+ m_sexp = Rf_ScalarLogical(v);
+ R_PreserveObject(m_sexp);
+}
+
RcppSexp::RcppSexp(const double & v) {
logTxt("RcppSexp from double\n");
m_sexp = Rf_ScalarReal(v);
@@ -46,6 +52,14 @@
R_PreserveObject(m_sexp);
}
+RcppSexp::RcppSexp(const std::vector<bool> & v) {
+ logTxt("RcppSexp from bool vector\n");
+ int n = v.size();
+ m_sexp = Rf_allocVector(LGLSXP, n);
+ R_PreserveObject(m_sexp);
+ copy( v.begin(), v.end(), LOGICAL(m_sexp) ) ;
+}
+
RcppSexp::RcppSexp(const std::vector<int> & v) {
logTxt("RcppSexp from int vector\n");
int n = v.size();
@@ -142,6 +156,8 @@
throw std::range_error("RcppSexp::asDouble expects single value");
}
switch( TYPEOF(m_sexp) ){
+ case LGLSXP:
+ return LOGICAL(m_sexp)[0] ? 1.0 : 0.0 ;
case REALSXP:
return REAL(m_sexp)[0] ;
case INTSXP:
@@ -159,6 +175,8 @@
throw std::range_error("RcppSexp::asInt expects single value");
}
switch( TYPEOF(m_sexp)){
+ case LGLSXP:
+ return LOGICAL(m_sexp)[0] ? 1 : 0 ;
case REALSXP:
return (int)REAL(m_sexp)[0] ; // some of this might be lost
case INTSXP:
@@ -176,6 +194,8 @@
throw std::range_error("RcppSexp::asRaw expects single value");
}
switch( TYPEOF(m_sexp) ){
+ case LGLSXP:
+ return LOGICAL(m_sexp)[0] ? (Rbyte)1 : (Rbyte)0 ;
case REALSXP:
return (Rbyte)REAL(m_sexp)[0] ;
case INTSXP:
@@ -188,6 +208,25 @@
return (Rbyte)0; // never reached
}
+bool RcppSexp::asBool() const {
+ if (Rf_length(m_sexp) != 1) {
+ throw std::range_error("RcppSexp::asRaw expects single value");
+ }
+ switch( TYPEOF(m_sexp) ){
+ case LGLSXP:
+ return LOGICAL(m_sexp)[0] ? true : false ;
+ case REALSXP:
+ return (bool)REAL(m_sexp)[0] ;
+ case INTSXP:
+ return (bool)INTEGER(m_sexp)[0] ;
+ case RAWSXP:
+ return (bool)RAW(m_sexp)[0] ;
+ default:
+ throw std::range_error("RcppSexp::asRaw expects raw, double or int");
+ }
+ return false; // never reached
+}
+
std::string RcppSexp::asStdString() const {
if (Rf_length(m_sexp) != 1) {
throw std::range_error("RcppSexp::asStdString expects single value");
@@ -202,10 +241,36 @@
return m_sexp;
}
+std::vector<bool> RcppSexp::asStdVectorBool() const {
+ int n = Rf_length(m_sexp);
+ std::vector<bool> v(n);
+ switch( TYPEOF(m_sexp) ){
+ case LGLSXP:
+ v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
+ break ;
+ case INTSXP:
+ v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n ) ;
+ break;
+ case REALSXP:
+ v.assign( REAL(m_sexp), REAL(m_sexp)+n ) ;
+ break;
+ case RAWSXP:
+ v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
+ break;
+ default:
+ throw std::range_error( "RcppSexp::asStdVectorBool(): invalid R type" ) ;
+ }
+ return v;
+}
+
+
std::vector<int> RcppSexp::asStdVectorInt() const {
int n = Rf_length(m_sexp);
std::vector<int> v(n);
switch( TYPEOF(m_sexp) ){
+ case LGLSXP:
+ v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
+ break;
case INTSXP:
v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n ) ;
break;
@@ -225,6 +290,9 @@
int n = Rf_length(m_sexp);
std::vector<Rbyte> v(n);
switch( TYPEOF(m_sexp) ){
+ case LGLSXP:
+ v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
+ break ;
case RAWSXP:
v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
break ;
@@ -244,6 +312,9 @@
int n = Rf_length(m_sexp);
std::vector<double> v(n);
switch( TYPEOF(m_sexp) ){
+ case LGLSXP:
+ v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
+ break ;
case RAWSXP:
v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
break ;
Modified: pkg/src/RcppSexp.h
===================================================================
--- pkg/src/RcppSexp.h 2009-12-26 18:52:12 UTC (rev 212)
+++ pkg/src/RcppSexp.h 2009-12-27 09:09:26 UTC (rev 213)
@@ -33,10 +33,13 @@
RcppSexp(const int & v);
RcppSexp(const Rbyte & v);
RcppSexp(const std::string & v);
+ RcppSexp(const bool & v);
+
RcppSexp(const std::vector<int> & v);
RcppSexp(const std::vector<double> & v);
RcppSexp(const std::vector<std::string> & v);
RcppSexp(const std::vector<Rbyte> & v);
+ RcppSexp(const std::vector<bool> & v);
RcppSexp(const std::set<int> & v);
RcppSexp(const std::set<double> & v);
@@ -45,6 +48,7 @@
~RcppSexp();
+ bool asBool() const;
double asDouble() const;
int asInt() const;
Rbyte asRaw() const;
@@ -53,6 +57,7 @@
std::vector<double> asStdVectorDouble() const;
std::vector<std::string> asStdVectorString() const;
std::vector<Rbyte> asStdVectorRaw() const;
+ std::vector<bool> asStdVectorBool() const;
SEXP asSexp() const;
private:
_______________________________________________
Rcpp-commits mailing list
Rcpp-commits at lists.r-forge.r-project.org
https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-commits
More information about the Rcpp-devel
mailing list