[Rcpp-commits] r3000 - in pkg/Rcpp: . inst/unitTests src

[noreply at r-forge.r-project.org]

Author: romain
Date: 2011-04-12 14:42:21 +0200 (Tue, 12 Apr 2011)
New Revision: 3000

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/unitTests/runit.Vector.R
   pkg/Rcpp/src/r_cast.cpp
Log:
use a callback to R's as.factor instead of coerceVector, which did not work for factors

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2011-04-12 08:31:07 UTC (rev 2999)
+++ pkg/Rcpp/ChangeLog	2011-04-12 12:42:21 UTC (rev 3000)
@@ -1,3 +1,10 @@
+2011-04-12  Romain Francois  <romain at r-enthusiasts.com>
+
+	* inst/unitTests/testRcppModules/src/stdVector.cpp: compiler disambiguation
+	
+	* src/r_cast.cpp: use a callback to R's "as.character" instead of calling
+	Rf_coerceVector, which did not work as expected for factors
+
 2011-04-11  Romain Francois  <romain at r-enthusiasts.com>
 
 	* R/loadRcppModules.R: New R function "loadRcppModules" that looks

Modified: pkg/Rcpp/inst/unitTests/runit.Vector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Vector.R	2011-04-12 08:31:07 UTC (rev 2999)
+++ pkg/Rcpp/inst/unitTests/runit.Vector.R	2011-04-12 12:42:21 UTC (rev 3000)
@@ -598,12 +598,15 @@
 	                    int b = input[1] ;
 	                    return List::create(a, b) ;
 	                '
+	            ), 
+	            "factors" = list( 
+	                signature( x = "factor" ), 
+	                '
+	                    StringVector s(x) ;
+	                    return s; 
+	                '
 	            )
-
-                
                   
-
-                  
         )
 
         if (Rcpp:::capabilities()[["initializer lists"]]) {
@@ -1246,3 +1249,10 @@
     checkEquals( fun(list(TRUE, 4)), list(TRUE, 4L) )
     checkEquals( fun(list(FALSE, -4L)), list(FALSE,-4L) )
 }
+
+test.factors <- function(){
+    fun <-    .rcpp.Vector$factors
+    x <- as.factor( c("c3", "c2", "c1") )
+    y <- fun(x)
+    checkEquals( y, as.character(x) )
+}

Modified: pkg/Rcpp/src/r_cast.cpp
===================================================================
--- pkg/Rcpp/src/r_cast.cpp	2011-04-12 08:31:07 UTC (rev 2999)
+++ pkg/Rcpp/src/r_cast.cpp	2011-04-12 12:42:21 UTC (rev 3000)
@@ -98,7 +98,14 @@
 	case LGLSXP:
 	case REALSXP:
 	case INTSXP:
-		return Rf_coerceVector( x, STRSXP );
+	    {
+	    // return Rf_coerceVector( x, STRSXP );
+	    // coerceVector does not work for some reason
+		SEXP call = PROTECT( Rf_lang2( Rf_install( "as.character" ), x ) ) ;
+		SEXP res  = PROTECT( Rf_eval( call, R_GlobalEnv ) ) ;
+		UNPROTECT(2); 
+		return res ;
+		}
 	case CHARSXP:
 		return Rf_ScalarString( x ) ;
 	case SYMSXP: