[Rcpp-commits] r1615 - in pkg/Rcpp/inst: include/Rcpp/sugar/functions unitTests

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

Author: romain
Date: 2010-06-19 11:31:33 +0200 (Sat, 19 Jun 2010)
New Revision: 1615

Modified:
   pkg/Rcpp/inst/include/Rcpp/sugar/functions/sapply.h
   pkg/Rcpp/inst/unitTests/runit.sugar.sapply.R
Log:
adapt sapply for lists

Modified: pkg/Rcpp/inst/include/Rcpp/sugar/functions/sapply.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/functions/sapply.h	2010-06-19 09:19:19 UTC (rev 1614)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/functions/sapply.h	2010-06-19 09:31:33 UTC (rev 1615)
@@ -31,14 +31,19 @@
 	true ,
 	Sapply<RTYPE,NA,T,Function>
 > {
-public:         
+public:
+	const static int RESULT_R_TYPE = Rcpp::traits::r_sexptype_traits<
+		typename ::Rcpp::traits::result_of<Function>::type 
+		>::rtype ;
 	typedef Rcpp::VectorBase<RTYPE,NA,T> VEC ;
 	typedef typename ::Rcpp::traits::result_of<Function>::type result_type ;
+	typedef typename Rcpp::traits::r_vector_element_converter<RESULT_R_TYPE>::type converter_type ;
+	typedef typename Rcpp::traits::storage_type<RESULT_R_TYPE>::type STORAGE ;
 	
 	Sapply( const VEC& vec_, Function fun_ ) : vec(vec_), fun(fun_){}
 	
-	inline result_type operator[]( int i ) const {
-		return fun( vec[i] ) ;
+	inline STORAGE operator[]( int i ) const {
+		return converter_type::get( fun( vec[i] ) );
 	}
 	inline int size() const { return vec.size() ; }
 	         

Modified: pkg/Rcpp/inst/unitTests/runit.sugar.sapply.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugar.sapply.R	2010-06-19 09:19:19 UTC (rev 1614)
+++ pkg/Rcpp/inst/unitTests/runit.sugar.sapply.R	2010-06-19 09:31:33 UTC (rev 1615)
@@ -70,10 +70,29 @@
 	fx <- cxxfunction( signature( x = "numeric" ), '
 	
 		NumericVector xx(x) ;
-		return all( sapply( xx * xx , square<double>() ) < 10 );
+		return all( sapply( xx * xx , square<double>() ) < 10.0 );
 	
 	', include = inc, plugin = "Rcpp" )
 	
-	checkTrue( fx(1:10)  )
+	checkTrue( ! fx(1:10)  )
 }
 
+test.sugar.sapply.list <- function( ){
+
+	inc <- '
+	template <typename T>
+	class square : public std::unary_function<T,T> {
+	public:
+		T operator()( T t) const { return t*t ; }
+	} ;
+	'
+	
+	fx <- cxxfunction( signature( x = "integer" ), '
+		IntegerVector xx(x) ;
+		List res = sapply( xx, seq_len );
+		return res ;
+	', include = inc, plugin = "Rcpp" )
+	
+	checkEquals( fx(1:10), lapply( 1:10, seq_len ) )
+}
+