[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