[Rcpp-commits] r428 - in pkg: inst src src/Rcpp

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

Author: romain
Date: 2010-01-22 16:32:18 +0100 (Fri, 22 Jan 2010)
New Revision: 428

Modified:
   pkg/inst/ChangeLog
   pkg/src/Rcpp/as.h
   pkg/src/as.cpp
Log:
use transform instead of assign to improve portability

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-22 15:01:58 UTC (rev 427)
+++ pkg/inst/ChangeLog	2010-01-22 15:32:18 UTC (rev 428)
@@ -16,6 +16,8 @@
 	* src/RcppFunction.{h,cpp}: listen to some suncc warnings
 
 	* src/RcppFrame.cpp: listen to some suncc warnings
+	
+	* src/as.cpp: use transform instead of assign
 
 2010-01-21  Dirk Eddelbuettel  <edd at debian.org>
 

Modified: pkg/src/Rcpp/as.h
===================================================================
--- pkg/src/Rcpp/as.h	2010-01-22 15:01:58 UTC (rev 427)
+++ pkg/src/Rcpp/as.h	2010-01-22 15:32:18 UTC (rev 428)
@@ -24,6 +24,7 @@
 
 #include <RcppCommon.h>
 #include <Rcpp/RObject.h>
+#include <algorithm>
 
 namespace Rcpp{ 
 
@@ -44,6 +45,27 @@
 template<> std::vector<Rbyte>       	as< std::vector<Rbyte> >(SEXP m_sexp) ;
 template<> std::vector<bool>        	as< std::vector<bool> >(SEXP m_sexp) ;
 
+/* these do not take care of coercion*/
+inline bool Rboolean_to_bool( int x){ return x == TRUE ; }
+inline bool int_to_bool(int x){ return x != 0 ; }
+inline bool double_to_bool(double x){ return x != 0.0 ; }
+inline bool Rbyte_to_bool(Rbyte x){ return x != static_cast<Rbyte>(0) ; }
+
+/* these take care of coercion */
+inline int Rboolean_to_int(int x){ return (x==NA_LOGICAL) ? NA_INTEGER : x ; }
+inline int double_to_int(double x){ 
+	if (ISNAN(x)) return NA_INTEGER;
+	else if (x > INT_MAX || x <= INT_MIN ) {
+		return NA_INTEGER;
+	}
+	return static_cast<int>(x);
+}
+inline int Rbyte_to_int(Rbyte x){ return static_cast<int>(x); }
+
+inline int int_to_RBoolean(int x){ return ( x == NA_INTEGER ) ? NA_LOGICAL : (x!=0); }
+
+
+
 } // namespace Rcpp      
 
 #endif

Modified: pkg/src/as.cpp
===================================================================
--- pkg/src/as.cpp	2010-01-22 15:01:58 UTC (rev 427)
+++ pkg/src/as.cpp	2010-01-22 15:32:18 UTC (rev 428)
@@ -114,16 +114,16 @@
     std::vector<bool> v(n);
     switch( TYPEOF(m_sexp) ){
     case LGLSXP:
-    	v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
+    	transform( LOGICAL(m_sexp), LOGICAL(m_sexp)+n, v.begin(), Rboolean_to_bool ) ;
     	break ;
     case INTSXP:
-    	v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n ) ;
+    	transform( INTEGER(m_sexp), INTEGER(m_sexp)+n, v.begin(), int_to_bool ) ;
     	break;
     case REALSXP:
-    	v.assign( REAL(m_sexp), REAL(m_sexp)+n ) ;
+    	transform( REAL(m_sexp), REAL(m_sexp)+n, v.begin(), double_to_bool ) ;
     	break;
     case RAWSXP:
-    	v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
+    	transform( RAW(m_sexp), RAW(m_sexp)+n, v.begin(), Rbyte_to_bool ) ;
     	break;
     default:
     		throw std::range_error( "as< vector<bool> >: invalid R type" ) ; 
@@ -136,17 +136,17 @@
     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;
+    case LGLSXP:
+    	transform( LOGICAL(m_sexp), LOGICAL(m_sexp)+n, v.begin(), Rboolean_to_int ) ;
+    	break;
     case REALSXP:
-    	v.assign( REAL(m_sexp), REAL(m_sexp)+n ) ;
+    	transform( LOGICAL(m_sexp), LOGICAL(m_sexp)+n, v.begin(), double_to_int ) ;
     	break;
     case RAWSXP:
-    	v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
+    	transform( RAW(m_sexp), RAW(m_sexp)+n, v.begin(), Rbyte_to_int ) ;
     	break;
     default:
     		throw std::range_error( "as< vector<int> >: invalid R type" ) ;