[Rcpp-commits] r670 - in pkg: . inst inst/unitTests src/Rcpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Feb 14 12:44:44 CET 2010
Author: romain
Date: 2010-02-14 12:44:44 +0100 (Sun, 14 Feb 2010)
New Revision: 670
Modified:
pkg/NEWS
pkg/inst/ChangeLog
pkg/inst/unitTests/runit.Language.R
pkg/src/Rcpp/Language.h
Log:
add unary_call and fix serious Language bug
Modified: pkg/NEWS
===================================================================
--- pkg/NEWS 2010-02-13 14:56:59 UTC (rev 669)
+++ pkg/NEWS 2010-02-14 11:44:44 UTC (rev 670)
@@ -1,3 +1,8 @@
+0.7.7 (under development)
+
+ o new template class Rcpp::unary_call that facilitates using
+ R language calls together with STL algorithms.
+
0.7.6 2010-02-12
o SEXP_Vector (and ExpressionVector and GenericVector, a.k.a List) now
@@ -13,7 +18,7 @@
so that STL algorithms can be applied to Rcpp objects
o CharacterVector gains a random access iterator, begin() and end() to
- support STL algorithmsl; iterator dereferences to a StringProxy
+ support STL algorithms; iterator dereferences to a StringProxy
o Restore Windows build; successfully tested on 32 and 64 bit;
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2010-02-13 14:56:59 UTC (rev 669)
+++ pkg/inst/ChangeLog 2010-02-14 11:44:44 UTC (rev 670)
@@ -1,3 +1,15 @@
+2010-02-14 Romain Francois <romain at r-enthusiasts.com>
+
+ * src/Rcpp/Language.h: fixing serious bug. The 'code bloat'
+ 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.
+
+ * inst/unitTests/runit.Language.R: unit test and example
+ of using unary_call
+
2010-02-12 Dirk Eddelbuettel <edd at debian.org>
* DESCRIPTION: Release 0.7.6
Modified: pkg/inst/unitTests/runit.Language.R
===================================================================
--- pkg/inst/unitTests/runit.Language.R 2010-02-13 14:56:59 UTC (rev 669)
+++ pkg/inst/unitTests/runit.Language.R 2010-02-14 11:44:44 UTC (rev 670)
@@ -109,3 +109,47 @@
checkEquals( funx(), call("rnorm", 10L, sd = 10L ) , msg = "Language<<" )
}
+test.Language.unary.call <- function(){
+
+ funx <- cfunction(signature(y = "integer" ), '
+
+ Language call( "seq", Named("from", 10 ), Named("to", 0 ) ) ;
+ IntegerVector x(y) ;
+ List output( x.size() ) ;
+ std::transform(
+ x.begin(), x.end(),
+ output.begin(),
+ unary_call<int>(call)
+ ) ;
+ return output ;
+ ', Rcpp = TRUE, verbose = FALSE, includes = "using namespace Rcpp;" )
+
+ checkEquals(
+ funx( 1:10 ),
+ lapply( 1:10, function(n) seq(from=n, to = 0 ) ),
+ msg = "c++ lapply using calls" )
+
+}
+
+test.Language.unary.call.index <- function(){
+
+ funx <- cfunction(signature(y = "integer" ), '
+ Language call( "seq", 10, 0 ) ;
+ IntegerVector x(y) ;
+ List output( x.size() ) ;
+ std::transform(
+ x.begin(), x.end(),
+ output.begin(),
+ unary_call<int>(call,2)
+ ) ;
+ return output ;
+ ', Rcpp = TRUE, verbose = FALSE, includes = "using namespace Rcpp;" )
+
+ checkEquals(
+ funx( 1:10 ),
+ lapply( 1:10, function(n) seq(from=n, to = 0 ) ),
+ msg = "c++ lapply using calls" )
+
+}
+
+
Modified: pkg/src/Rcpp/Language.h
===================================================================
--- pkg/src/Rcpp/Language.h 2010-02-13 14:56:59 UTC (rev 669)
+++ pkg/src/Rcpp/Language.h 2010-02-14 11:44:44 UTC (rev 670)
@@ -109,29 +109,29 @@
#else
/* <code-bloat> */
template <typename T1>
-Language( const std::string& symbol, const T1& t1) : DottedPair(symbol, t1) {}
+Language( const std::string& symbol, const T1& t1) : DottedPair(Rf_install(symbol.c_str()), t1) { update() ; }
template <typename T1, typename T2>
-Language( const std::string& symbol, const T1& t1, const T2& t2) : DottedPair(symbol, t1,t2){}
+Language( const std::string& symbol, const T1& t1, const T2& t2) : DottedPair(Rf_install(symbol.c_str()), t1,t2){ update() ; }
template <typename T1, typename T2, typename T3>
-Language( const std::string& symbol, const T1& t1, const T2& t2, const T3& t3): DottedPair(symbol, t1,t2,t3) {}
+Language( const std::string& symbol, const T1& t1, const T2& t2, const T3& t3): DottedPair(Rf_install(symbol.c_str()), t1,t2,t3) { update() ; }
template <typename T1, typename T2, typename T3, typename T4>
-Language( const std::string& symbol, const T1& t1, const T2& t2, const T3& t3, const T4& t4): DottedPair(symbol, t1,t2,t3,t4){}
+Language( const std::string& symbol, const T1& t1, const T2& t2, const T3& t3, const T4& t4): DottedPair(Rf_install(symbol.c_str()), t1,t2,t3,t4){ update() ;}
template <typename T1>
-Language( const Function& function, const T1& t1) : DottedPair(function, t1) {}
+Language( const Function& function, const T1& t1) : DottedPair(function, t1) { update() ;}
template <typename T1, typename T2>
-Language( const Function& function, const T1& t1, const T2& t2) : DottedPair(function, t1,t2){}
+Language( const Function& function, const T1& t1, const T2& t2) : DottedPair(function, t1,t2){update() ;}
template <typename T1, typename T2, typename T3>
-Language( const Function& function, const T1& t1, const T2& t2, const T3& t3): DottedPair(function, t1,t2,t3) {}
+Language( const Function& function, const T1& t1, const T2& t2, const T3& t3): DottedPair(function, t1,t2,t3) {update() ;}
template <typename T1, typename T2, typename T3, typename T4>
-Language( const Function& function, const T1& t1, const T2& t2, const T3& t3, const T4& t4): DottedPair(function, t1,t2,t3,t4){}
+Language( const Function& function, const T1& t1, const T2& t2, const T3& t3, const T4& t4): DottedPair(function, t1,t2,t3,t4){ update() ;}
/* </code-bloat> */
#endif
@@ -149,24 +149,41 @@
* sets the function
*/
void setFunction( const Function& function) ;
-
+
/**
* eval this call in the global environment
*/
SEXP eval() ;
-
+
/**
* eval this call in the requested environment
*/
SEXP eval(SEXP env) ;
-
+
~Language() ;
-
-private:
+
+private:
virtual void update() ;
-
+
};
+template <typename T>
+class unary_call : public std::unary_function<T,SEXP> {
+public:
+ unary_call( Language call_ ) : call(call_), proxy(call,1) {}
+ unary_call( Language call_, int index ) : call(call_), proxy(call_,index){}
+
+ SEXP operator()( const T& object ){
+ proxy = object ;
+ return call.eval() ;
+ }
+
+private:
+ Language call ;
+ Language::Proxy proxy ;
+} ;
+
+
} // namespace Rcpp
#endif
More information about the Rcpp-commits
mailing list