[Rcpp-devel] [Rcpp-commits] r209 - in pkg: . inst/examples/RcppInline src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Dec 23 10:37:13 CET 2009


Author: romain
Date: 2009-12-23 10:37:11 +0100 (Wed, 23 Dec 2009)
New Revision: 209

Modified:
   pkg/DESCRIPTION
   pkg/inst/examples/RcppInline/RcppSexpTests.r
   pkg/src/RcppSexp.cpp
Log:
more uses of vector::assign in RcppSexp

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2009-12-22 09:48:29 UTC (rev 208)
+++ pkg/DESCRIPTION	2009-12-23 09:37:11 UTC (rev 209)
@@ -1,6 +1,6 @@
 Package: Rcpp
 Title: Rcpp R/C++ interface package
-Version: 0.7.0
+Version: 0.7.1
 Date: $Date$
 Author: Dirk Eddelbuettel with contributions by Simon Urbanek and David Reiss;
  based on code written during 2005 and 2006 by Dominick Samperi 

Modified: pkg/inst/examples/RcppInline/RcppSexpTests.r
===================================================================
--- pkg/inst/examples/RcppInline/RcppSexpTests.r	2009-12-22 09:48:29 UTC (rev 208)
+++ pkg/inst/examples/RcppInline/RcppSexpTests.r	2009-12-23 09:37:11 UTC (rev 209)
@@ -24,6 +24,8 @@
 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
 cat(funx(x=2), "\n")
 cat(funx(x=2.2), "\n")
+funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
+cat(funx(x=as.raw(2)), "\n")
 
 cat("\n===String\n")
 foo <- '
@@ -37,10 +39,14 @@
 cat("\n===Raw (bytes)\n")
 foo <- '
         Rbyte i = RcppSexp(x).asRaw();
-	std::cout << "Returning twice the value of " << i << " : ";
+	std::cout << "Returning twice the value of " << (int)i << " : ";
 	return(RcppSexp( (Rbyte)(2*i) ).asSexp());
         '
 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
+cat( funx(x=2), "\n")
+funx <- cfunction(signature(x="integer"), foo, Rcpp=TRUE, verbose=FALSE)
+cat( funx(x=2L), "\n")
+funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
 cat( funx(x=as.raw(2)), "\n")
 
 
@@ -57,6 +63,10 @@
         '
 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
 print(funx(x=2:5))
+funx <- cfunction(signature(x="integer"), foo, Rcpp=TRUE, verbose=FALSE)
+print(funx(x=2:5))
+funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
+print(funx(x=as.raw(2:5)))
 
 cat("\n===Int Vector\n")
 foo <- '
@@ -68,7 +78,11 @@
 	return(RcppSexp( iv ).asSexp());
         '
 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
+print(funx(x=2:5+.1))
+funx <- cfunction(signature(x="integer"), foo, Rcpp=TRUE, verbose=FALSE)
 print(funx(x=2:5))
+funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
+print(funx(x=as.raw(2:5)))
 
 
 cat("\n===Double Vector\n")
@@ -82,6 +96,10 @@
         '
 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
 print(funx(x=0.1+2:5))
+funx <- cfunction(signature(x="integer"), foo, Rcpp=TRUE, verbose=FALSE)
+print(funx(x=2:5))
+funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
+print(funx(x=as.raw(2:5)))
 
 cat("\n===Raw Vector\n")
 foo <- '
@@ -92,8 +110,12 @@
         }
  	return(RcppSexp( iv ).asSexp());
         '
+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.raw(0:9)))
+print(funx(x=0:9+.1))
 
 cat("\n===String Vector\n")
 foo <- '

Modified: pkg/src/RcppSexp.cpp
===================================================================
--- pkg/src/RcppSexp.cpp	2009-12-22 09:48:29 UTC (rev 208)
+++ pkg/src/RcppSexp.cpp	2009-12-23 09:37:11 UTC (rev 209)
@@ -20,19 +20,18 @@
 // along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
 #include <RcppSexp.h>
+#include <algorithm>
 
 RcppSexp::RcppSexp(const double & v) {
     logTxt("RcppSexp from double\n");
-    m_sexp = Rf_allocVector(REALSXP, 1);
+    m_sexp = Rf_ScalarReal(v);
     R_PreserveObject(m_sexp);
-    REAL(m_sexp)[0] = v;
 }
 
 RcppSexp::RcppSexp(const int & v) {
     logTxt("RcppSexp from int\n");
-    m_sexp = Rf_allocVector(INTSXP, 1);
+    m_sexp = Rf_ScalarInteger(v);
     R_PreserveObject(m_sexp);
-    INTEGER(m_sexp)[0] = v;
 }
 
 RcppSexp::RcppSexp(const Rbyte & v) {
@@ -43,9 +42,8 @@
 
 RcppSexp::RcppSexp(const std::string & v) {
     logTxt("RcppSexp from std::string\n");
-    m_sexp = Rf_allocVector(STRSXP, 1);
+    m_sexp = Rf_mkString(v.c_str());
     R_PreserveObject(m_sexp);
-    SET_STRING_ELT(m_sexp, 0, Rf_mkChar(v.c_str()));
 }
 
 RcppSexp::RcppSexp(const std::vector<int> & v) {
@@ -53,9 +51,7 @@
     int n = v.size();
     m_sexp = Rf_allocVector(INTSXP, n);
     R_PreserveObject(m_sexp);
-    for (int i = 0; i < n; i++) {
-	INTEGER(m_sexp)[i] = v[i];
-    }	
+    copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
 }
 
 RcppSexp::RcppSexp(const std::vector<double> & v) {
@@ -63,9 +59,7 @@
     int n = v.size();
     m_sexp = Rf_allocVector(REALSXP, n);
     R_PreserveObject(m_sexp);
-    for (int i = 0; i < n; i++) {
-	REAL(m_sexp)[i] = v[i];
-    }	
+    copy( v.begin(), v.end(), REAL(m_sexp) ) ;
 }
 
 RcppSexp::RcppSexp(const std::vector<Rbyte> & v) {
@@ -73,9 +67,9 @@
     int n = v.size();
     m_sexp = Rf_allocVector(RAWSXP, n);
     R_PreserveObject(m_sexp);
-    for (int i = 0; i < n; i++) {
-	RAW(m_sexp)[i] = v[i];
-    }	
+    // copy the content of the byte vector 
+    // into the raw vector
+    copy( v.begin(), v.end(), RAW(m_sexp) ) ;
 }
 
 RcppSexp::RcppSexp(const std::vector<std::string> & v) {
@@ -83,6 +77,8 @@
     int n = v.size();
     m_sexp = Rf_allocVector(STRSXP, n);
     R_PreserveObject(m_sexp);
+    // maybe we can use transform here
+    // but this might involve creating an iterator over R character vector
     for (int i = 0; i < n; i++) {
 	SET_STRING_ELT(m_sexp, i, Rf_mkChar(v[i].c_str()));
     }	
@@ -97,33 +93,33 @@
     if (Rf_length(m_sexp) != 1) {
 	throw std::range_error("RcppSexp::asDouble expects single value");
     }
-    if (!Rf_isNumeric(m_sexp)) {
-	throw std::range_error("RcppSexp::asDouble expect numeric type");
+    switch( TYPEOF(m_sexp) ){
+    	case REALSXP:
+    		return REAL(m_sexp)[0] ; 
+    	case INTSXP:
+    		return (double)INTEGER(m_sexp)[0]; 
+    	case RAWSXP:
+    		return (double)RAW(m_sexp)[0];
+    	default:
+    		throw std::range_error("RcppSexp::asDouble invalid type");
     }
-    if (Rf_isInteger(m_sexp)) {
-	return (double)INTEGER(m_sexp)[0];
-    } else if (Rf_isReal(m_sexp)) {
-	return REAL(m_sexp)[0];
-    } else {
-	throw std::range_error("RcppSexp::asDouble invalid type");
-    }
-    return 0; 	// never reached
+    return 0.0 ; 	// never reached
 }
 
 int RcppSexp::asInt() const {
     if (Rf_length(m_sexp) != 1) {
 	throw std::range_error("RcppSexp::asInt expects single value");
     }
-    if (!Rf_isNumeric(m_sexp)) {
-	throw std::range_error("RcppSexp::asInt expects numeric type");
+    switch( TYPEOF(m_sexp)){
+    	case REALSXP:
+    		return (int)REAL(m_sexp)[0] ; // some of this might be lost
+    	case INTSXP:
+    		return INTEGER(m_sexp)[0]; 
+    	case RAWSXP:
+    		return (int)RAW(m_sexp)[0];
+    	default:
+    		throw std::range_error("RcppSexp::asInt invalid type");
     }
-    if (Rf_isInteger(m_sexp)) {
-	return INTEGER(m_sexp)[0];
-    } else	if (Rf_isReal(m_sexp)) {
-	return (int)REAL(m_sexp)[0];
-    } else {
-	std::string mesg = "RcppParams::asInt unknown type";
-    }
     return 0; 	// never reached
 }
 
@@ -132,12 +128,12 @@
 	throw std::range_error("RcppSexp::asRaw expects single value");
     }
     switch( TYPEOF(m_sexp) ){
-    	case RAWSXP:
-    		return RAW(m_sexp)[0] ;
-    	case INTSXP:
-    		return (Rbyte)INTEGER(m_sexp)[0] ;
     	case REALSXP:
     		return (Rbyte)REAL(m_sexp)[0] ;
+    	case INTSXP:
+    		return (Rbyte)INTEGER(m_sexp)[0] ;
+    	case RAWSXP:
+    		return RAW(m_sexp)[0] ;
     	default:
     		throw std::range_error("RcppSexp::asRaw expects raw, double or int");
     }
@@ -161,14 +157,18 @@
 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];
-	}
+    switch( TYPEOF(m_sexp) ){
+    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::asStdVectorInt(): invalid R type" ) ; 
     }
     return v;
 }
@@ -178,24 +178,14 @@
     std::vector<Rbyte> v(n);
     switch( TYPEOF(m_sexp) ){
     case RAWSXP:
-    	{
-    		v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
-    		break ;
-    	}
+    	v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
+    	break ;
     case REALSXP:
-    	{
-    		for (int i = 0; i < n; i++) {
-			    v[i] = (Rbyte)REAL(m_sexp)[i];
-			}
-			break ;
-    	}
+    	v.assign( REAL(m_sexp), REAL(m_sexp)+n) ;
+    	break;
     case INTSXP:
-    	{
-    		for (int i = 0; i < n; i++) {
-			    v[i] = (Rbyte)INTEGER(m_sexp)[i];
-			}
-    		break;
-    	}
+    	v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n) ;
+    	break;
     default:
     	std::range_error("RcppSexp::asStdVectorRaw expects raw, double or int");
     }
@@ -205,14 +195,18 @@
 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];
-	}
+    switch( TYPEOF(m_sexp) ){
+    case RAWSXP:
+    	v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
+    	break ;
+    case REALSXP:
+    	v.assign( REAL(m_sexp), REAL(m_sexp)+n) ;
+    	break;
+    case INTSXP:
+    	v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n) ;
+    	break;
+    default:
+    	std::range_error("RcppSexp::asStdVectorDouble expects raw, double or int");
     }
     return v;
 }

_______________________________________________
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