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

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

Author: romain
Date: 2010-02-18 15:01:43 +0100 (Thu, 18 Feb 2010)
New Revision: 736

Modified:
   pkg/Rcpp/inst/ChangeLog
   pkg/Rcpp/inst/unitTests/runit.Language.R
   pkg/Rcpp/src/Rcpp/Language.h
Log:
added fixed_call to upport STL algotithms like std::generate

Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog	2010-02-18 12:33:53 UTC (rev 735)
+++ pkg/Rcpp/inst/ChangeLog	2010-02-18 14:01:43 UTC (rev 736)
@@ -1,5 +1,10 @@
 2010-02-18  Romain Francois <romain at r-enthusiasts.com>
 
+	* src/Rcpp/Language.h: added fixed_call to support STL algorithms
+	similar to generate. 
+	
+	* inst/unitTests/runit.Language.R: unit test for fixed_call
+
 	* src/Rcpp/Environment.h: Environment gains a find method
 	which searches for a binding in the associated environment
 	but also in all its parents, as opposed to get which just 

Modified: pkg/Rcpp/inst/unitTests/runit.Language.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Language.R	2010-02-18 12:33:53 UTC (rev 735)
+++ pkg/Rcpp/inst/unitTests/runit.Language.R	2010-02-18 14:01:43 UTC (rev 736)
@@ -175,4 +175,23 @@
 	
 }
 
+test.Language.fixed.call <- function(){
+	
+	funx <- cfunction(signature(), '
+	
+	Language call( Function("rnorm"), 10 ) ;
+	std::vector< std::vector<double> > result(10) ;
+	std::generate( 
+		result.begin(), result.end(), 
+		fixed_call< std::vector<double> >(call)
+		) ;
+	return wrap( result );
+	', Rcpp = TRUE, verbose = FALSE, includes = "using namespace Rcpp;" )
+	
+	set.seed(123)
+	res <- funx()
+	set.seed(123)
+	exp <- lapply( 1:10, function(n) rnorm(10) )
+	checkEquals( res, exp, msg = "std::generate" )
+}
 

Modified: pkg/Rcpp/src/Rcpp/Language.h
===================================================================
--- pkg/Rcpp/src/Rcpp/Language.h	2010-02-18 12:33:53 UTC (rev 735)
+++ pkg/Rcpp/src/Rcpp/Language.h	2010-02-18 14:01:43 UTC (rev 736)
@@ -167,6 +167,22 @@
 
 };
 
+template <typename OUT=SEXP>
+class fixed_call {
+public:
+	typedef OUT result_type ;
+	
+	fixed_call( Language call_ ) : call(call_){}
+	fixed_call( Function fun ) : call(fun){}
+	
+	OUT operator()(){
+		return as<OUT>( call.eval() ) ;
+	}
+	
+private:
+	Language call ;
+} ;
+
 template <typename T, typename OUT = SEXP>
 class unary_call : public std::unary_function<T,OUT> {
 public:
@@ -203,7 +219,6 @@
 	Language::Proxy proxy2 ;
 } ;
 
-
 } // namespace Rcpp
 
 #endif