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

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

Author: romain
Date: 2010-02-14 14:12:00 +0100 (Sun, 14 Feb 2010)
New Revision: 674

Modified:
   pkg/NEWS
   pkg/inst/ChangeLog
   pkg/inst/unitTests/runit.Language.R
   pkg/src/Rcpp/Language.h
Log:
+ Rcpp::binary_call

Modified: pkg/NEWS
===================================================================
--- pkg/NEWS	2010-02-14 12:54:39 UTC (rev 673)
+++ pkg/NEWS	2010-02-14 13:12:00 UTC (rev 674)
@@ -1,7 +1,8 @@
 0.7.7	(under development)
 
-    o	new template class Rcpp::unary_call that facilitates using 
-    	R language calls together with STL algorithms.
+    o	new template classes Rcpp::unary_call and Rcpp::binary_call
+    	that facilitates using R language calls together 
+    	with STL algorithms.
     	
     o	fixed a bug in Language constructors taking a string as their
     	first argument. The created call was wrong.

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-02-14 12:54:39 UTC (rev 673)
+++ pkg/inst/ChangeLog	2010-02-14 13:12:00 UTC (rev 674)
@@ -4,11 +4,12 @@
 	constructors taking a std::string did not explicitely 
 	create a symbol, so the created calls were wrong. 
 
-	* src/Rcpp/Language.h: new template class Rcpp::unary_call
-	to allow use of Language objects in stl algorithms.
+	* src/Rcpp/Language.h: new template classes Rcpp::unary_call
+	and Rcpp::binary_call to allow use of Language objects 
+	in STL algorithms.
 
 	* inst/unitTests/runit.Language.R: unit test and example 
-	of using unary_call
+	of using unary_call and binary_call
 
 2010-02-12  Dirk Eddelbuettel  <edd at debian.org>
 

Modified: pkg/inst/unitTests/runit.Language.R
===================================================================
--- pkg/inst/unitTests/runit.Language.R	2010-02-14 12:54:39 UTC (rev 673)
+++ pkg/inst/unitTests/runit.Language.R	2010-02-14 13:12:00 UTC (rev 674)
@@ -152,4 +152,27 @@
 	
 }
 
+test.Language.binary.call <- function(){
+	
+	funx <- cfunction(signature(y1 = "integer", y2 = "integer" ), '
+	
+	Language call( "seq", Named("from", 10 ), Named("to", 0 ) ) ;
+	IntegerVector x1(y1) ;
+	IntegerVector x2(y2) ;
+	List output( x1.size() ) ;
+	std::transform( 
+		x1.begin(), x1.end(), x2.begin(),
+		output.begin(),
+		binary_call<int,int>(call)
+		) ;
+	return output ;
+	', Rcpp = TRUE, verbose = FALSE, includes = "using namespace Rcpp;" )
+	
+	checkEquals( 
+		funx( 1:10, 11:20 ), 
+		lapply( 1:10, function(n) seq(n, n+10) ), 
+		msg = "c++ lapply using calls" )
+	
+}
 
+

Modified: pkg/src/Rcpp/Language.h
===================================================================
--- pkg/src/Rcpp/Language.h	2010-02-14 12:54:39 UTC (rev 673)
+++ pkg/src/Rcpp/Language.h	2010-02-14 13:12:00 UTC (rev 674)
@@ -170,7 +170,7 @@
 template <typename T, typename OUT = SEXP>
 class unary_call : public std::unary_function<T,OUT> {
 public:
-	unary_call( Language call_ ) : call(call_), proxy(call,1) {}
+	unary_call( Language call_ ) : call(call_), proxy(call_,1) {}
 	unary_call( Language call_, int index ) : call(call_), proxy(call_,index){}
 	
 	OUT operator()( const T& object ){
@@ -183,7 +183,25 @@
 	Language::Proxy proxy ;
 } ;
 
+template <typename T1, typename T2, typename OUT = SEXP>
+class binary_call : public std::binary_function<T1,T2,OUT> {
+public:
+	binary_call( Language call_ ) : call(call_), proxy1(call_,1), proxy2(call_,2) {}
+	binary_call( Language call_, int index1, int index2 ) : call(call_), proxy1(call_,index1), proxy2(call_,index2){}
+	
+	OUT operator()( const T1& o1, const T2& o2 ){
+		proxy1 = o1 ;
+		proxy2 = o2 ;
+		return as<OUT>( call.eval() ) ;
+	}
+	
+private:
+	Language call ;
+	Language::Proxy proxy1 ;
+	Language::Proxy proxy2 ;
+} ;
 
+
 } // namespace Rcpp
 
 #endif