[Rcpp-commits] r1793 - in pkg/Rcpp: . inst inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 6 21:57:38 CEST 2010
Author: edd
Date: 2010-07-06 21:57:38 +0200 (Tue, 06 Jul 2010)
New Revision: 1793
Modified:
pkg/Rcpp/DESCRIPTION
pkg/Rcpp/inst/ChangeLog
pkg/Rcpp/inst/unitTests/runit.RObject.R
Log:
converted to 'one cxxfunction call of lists of sigs and bodies' scheme
Modified: pkg/Rcpp/DESCRIPTION
===================================================================
--- pkg/Rcpp/DESCRIPTION 2010-07-06 19:26:21 UTC (rev 1792)
+++ pkg/Rcpp/DESCRIPTION 2010-07-06 19:57:38 UTC (rev 1793)
@@ -1,6 +1,6 @@
Package: Rcpp
Title: Seamless R and C++ Integration
-Version: 0.8.3.2
+Version: 0.8.3.3
Date: $Date$
Author: Dirk Eddelbuettel and Romain Francois, with contributions
by Simon Urbanek, David Reiss and Douglas Bates; based on code written during
Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog 2010-07-06 19:26:21 UTC (rev 1792)
+++ pkg/Rcpp/inst/ChangeLog 2010-07-06 19:57:38 UTC (rev 1793)
@@ -1,29 +1,34 @@
+2010-07-06 Dirk Eddelbuettel <edd at debian.org>
+
+ * src/Date.cpp: Imported mktime() from R (which is due to Arthur Olson)
+
2010-07-06 Romain Francois <romain at r-enthusiasts.com>
- * inst/include/Rcpp/sugar/functions/ifelse.h: using compile time dispatch
+ * inst/include/Rcpp/sugar/functions/ifelse.h: using compile time dispatch
based on the NA-ness of the condition type. ifelse handles primitive
arguments on the lhs, rhs or both
-
+
* inst/include/Rcpp/sugar/functions/rev.h: new sugar function: rev
2010-07-05 Romain Francois <romain at r-enthusiasts.com>
- * inst/include/Rcpp/RcppCommon.h : no more using variadic macros in RCPP_DEBUG
-
- * inst/include/Rcpp/vector/Matrix.h: move ncol, nrow, rows and cols in
- Matrix (used to be in Vector)
-
- * inst/include/Rcpp/traits/matrix_interface.h: new SFINAE helper to detect
- matrix interface (helps matrix sugar expressions)
+ * inst/include/Rcpp/RcppCommon.h : no more using variadic macros in
+ RCPP_DEBUG
-2010-07-02 Romain Francois <romain at r-enthusiasts.com>
+ * inst/include/Rcpp/vector/Matrix.h: move ncol, nrow, rows and cols
+ in Matrix (used to be in Vector)
+ * inst/include/Rcpp/traits/matrix_interface.h: new SFINAE helper to
+ detect matrix interface (helps matrix sugar expressions)
+
+2010-07-03 Romain Francois <romain at r-enthusiasts.com>
+
* inst/include/Rcpp/traits/result_of.h : also deal with functions
taking two arguments (useful for e.g. outer)
* inst/include/Rcpp/vector/MatrixBase.h : new CRTP base class
for Matrix to facilitate sugar syntax on matrices.
-
+
* inst/include/Rcpp/sugar/matrix/outer.h : new sugar function: outer
* inst/include/Rcpp/sugar/matrix/row.h: new sugar function: row
* inst/include/Rcpp/sugar/matrix/col.h: new sugar function: col
@@ -33,7 +38,7 @@
* inst/include/Rcpp/sugar/functions/rep.h: new sugar function : rep
* inst/include/Rcpp/sugar/functions/rep_len.h: new sugar function : rep_len
* inst/include/Rcpp/sugar/functions/rep_each.h: new sugar function : rep_each
-
+
2010-07-02 Dirk Eddelbuettel <edd at debian.org>
* src/RcppStringVector: Now uses std::vector<std::string>
Modified: pkg/Rcpp/inst/unitTests/runit.RObject.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RObject.R 2010-07-06 19:26:21 UTC (rev 1792)
+++ pkg/Rcpp/inst/unitTests/runit.RObject.R 2010-07-06 19:57:38 UTC (rev 1793)
@@ -1,4 +1,5 @@
#!/usr/bin/r -t
+# -*- mode: R; tab-width: 4 -*-
#
# Copyright (C) 2009 - 2010 Romain Francois and Dirk Eddelbuettel
#
@@ -18,16 +19,158 @@
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
.setUp <- function(){
- suppressMessages( require( datasets ) )
- data( iris )
+ suppressMessages( require( datasets ) )
+ data( iris )
+
+ tests <- ".Rcpp.RObject"
+ if( ! exists(tests, globalenv() )) {
+ ## definition of all the functions at once
+ f <- list("asDouble"=list(
+ signature(x="numeric"),
+ 'double d = as<double>(x);
+ return(wrap( 2*d ) );')
+
+ ,"asInt"=list(
+ signature(x="numeric"),
+ 'int i = as<int>(x) ;
+ return(wrap( 2*i ) ); ')
+
+ ,"asStdString"=list(
+ signature(x="character"),
+ 'std::string s = as<std::string>(x) ;
+ return(wrap( s+s ) );')
+
+ ,"asRaw"=list(
+ signature(x="raw"),
+ 'Rbyte i = as<Rbyte>(x);
+ return(wrap( (Rbyte)(2*i) ) ); ')
+
+ ,"asLogical"=list(
+ signature(x="logical"),
+ 'bool b = as<bool>(x);
+ return(wrap( !b ));')
+
+ ,"asStdVectorIntResultsSet"=list(
+ signature(x="numeric"),
+ 'std::vector<int> iv = as<std::vector<int> >( x );
+ for (size_t i=0; i<iv.size(); i++) {
+ iv[i] = 2*iv[i];
+ }
+ RcppResultSet rs;
+ rs.add("", iv);
+ return(rs.getSEXP());')
+
+ ,"asStdVectorInt"=list(
+ signature(x="numeric"),
+ 'std::vector<int> iv = as< std::vector<int> >(x);
+ for (size_t i=0; i<iv.size(); i++) {
+ iv[i] = 2*iv[i];
+ }
+ return(Rcpp::wrap( iv ) );')
+
+ ,"asStdVectorDouble"=list(
+ signature(x="numeric"),
+ 'std::vector<double> iv = as< std::vector<double> >( x );
+ for (size_t i=0; i<iv.size(); i++) {
+ iv[i] = 2*iv[i];
+ }
+ return(Rcpp::wrap( iv ));')
+
+ ,"asStdVectorRaw"=list(
+ signature(x="raw"),
+ 'std::vector<Rbyte> iv = as< std::vector<Rbyte> >( x );
+ for (size_t i=0; i<iv.size(); i++) {
+ iv[i] = 2*iv[i];
+ }
+ return(Rcpp::wrap( iv ));')
+
+ ,"asStdVectorBool"=list(
+ signature(x="logical"),
+ 'std::vector<bool> bv = as< std::vector<bool> >( x );
+ for (size_t i=0; i<bv.size(); i++) {
+ bv[i].flip() ;
+ }
+ return(Rcpp::wrap( bv ));')
+
+ ,"asStdVectorString"=list(
+ signature(x="character"),
+ 'std::vector<std::string> iv = as< std::vector<std::string> >( x );
+ for (size_t i=0; i<iv.size(); i++) {
+ iv[i] = iv[i] + iv[i];
+ }
+ return(Rcpp::wrap( iv ));')
+
+ ,"stdsetint"=list(
+ signature(),
+ 'std::set<int> iv ;
+ iv.insert( 0 ) ;
+ iv.insert( 1 ) ;
+ iv.insert( 0 ) ;
+ return Rcpp::wrap( iv );')
+
+ ,"stdsetdouble"=list(
+ signature(),
+ 'std::set<double> ds;
+ ds.insert( 0.0 );
+ ds.insert( 1.0 );
+ ds.insert( 0.0 );
+ return(Rcpp::wrap( ds )); ')
+
+ ,"stdsetraw"=list(
+ signature(),
+ 'std::set<Rbyte> bs ;
+ bs.insert( (Rbyte)0 ) ;
+ bs.insert( (Rbyte)1 ) ;
+ bs.insert( (Rbyte)0 ) ;
+ return(Rcpp::wrap( bs )); ')
+
+ ,"stdsetstring"=list(
+ signature(),
+ 'std::set<std::string> ss ;
+ ss.insert( "foo" ) ;
+ ss.insert( "bar" ) ;
+ ss.insert( "foo" ) ;
+ return(Rcpp::wrap( ss )); ')
+
+ ,"attributeNames"=list(
+ signature(x="data.frame"),
+ 'std::vector<std::string> iv = RObject(x).attributeNames();
+ return(wrap( iv ));' )
+
+ ,"hasAttribute"=list(
+ signature(x="data.frame"),
+ 'bool has_class = RObject(x).hasAttribute( "class" ) ;
+ return wrap( has_class ) ;')
+
+ ,"attr"=list(
+ signature(x="data.frame"),
+ 'return RObject(x).attr( "row.names" ) ;')
+
+ ,"attr_set"=list(
+ signature(),
+ 'RObject y = wrap("blabla") ;
+ y.attr("foo") = 10 ;
+ return y ; ')
+
+ ,"isNULL"=list(
+ signature(x="ANY"),
+ 'bool is_null = RObject(x).isNULL() ;
+ return wrap( is_null ) ; ' )
+
+ )
+
+ signatures <- lapply(f, "[[", 1L)
+ bodies <- lapply(f, "[[", 2L)
+ fun <- cxxfunction(signatures, bodies,
+ plugin = "Rcpp", includes = "using namespace std;",
+ cxxargs = ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x",""))
+ getDynLib( fun ) # just forcing loading the dll now
+ assign( tests, fun, globalenv() )
+ }
}
test.RObject.asDouble <- function(){
- foo <- '
- double d = as<double>(x);
- return(wrap( 2*d ) );
- '
- funx <- cppfunction(signature(x="numeric"), foo )
+ funx <- .Rcpp.RObject$asDouble
checkEquals( funx(2.123), 4.246, msg = "as<double>( REALSXP ) " )
checkEquals( funx(2L), 4.0, msg = "as<double>( INTSXP ) " )
checkEquals( funx(as.raw(2L)), 4.0, msg = "as<double>( RAWSXP )" )
@@ -36,24 +179,17 @@
}
test.RObject.asInt <- function(){
- foo <- '
- int i = as<int>(x) ;
- return(wrap( 2*i ) ); '
- funx <- cppfunction(signature(x="numeric"), foo)
+ funx <- .Rcpp.RObject$asInt
checkEquals( funx(2.123), 4L, msg = "as<int>( REALSXP )" )
checkEquals( funx(2), 4L, msg = "as<int>( REALSXP )" )
checkEquals( funx(2L), 4.0, msg = "as<int>( INTSXP )" )
checkEquals( funx(as.raw(2L)), 4.0, msg = "as<int>( RAWSXP )" )
checkException( funx(x='2'), msg = "as<int> can not convert character" )
checkException( funx(x=2:3), msg = "as<int> expects the vector to be of length 1" )
-
}
test.RObject.asStdString <- function(){
- foo <- '
- std::string s = as<std::string>(x) ;
- return(wrap( s+s ) );'
- funx <- cppfunction(signature(x="character"), foo )
+ funx <- .Rcpp.RObject$asStdString
checkEquals( funx("abc"), "abcabc", msg = "as<std::string>" )
checkException( funx(NULL), msg = "as<std::string> expects character vector" )
checkException( funx(0L), msg = "as<std::string> expects character vector" )
@@ -61,14 +197,10 @@
checkException( funx(as.raw(0L)), msg = "as<std::string> expects character vector" )
checkException( funx(letters), msg = "as<std::string> expects single string" )
-
}
test.RObject.asRaw <- function(){
- foo <- '
- Rbyte i = as<Rbyte>(x);
- return(wrap( (Rbyte)(2*i) ) ); '
- funx <- cppfunction(signature(x="raw"), foo )
+ funx <- .Rcpp.RObject$asRaw
checkEquals( funx(1L), as.raw(2L), msg = "as<Rbyte>(integer)" )
checkEquals( funx(1.3), as.raw(2L), msg = "as<Rbyte>(numeric)" )
checkEquals( funx(as.raw(1)), as.raw(2L), msg = "as<Rbyte>(raw)" )
@@ -83,10 +215,7 @@
}
test.RObject.asLogical <- function(){
- foo <- '
- bool b = as<bool>(x);
- return(wrap( !b ));'
- funx <- cppfunction(signature(x="logical"), foo )
+ funx <- .Rcpp.RObject$asLogical
checkTrue( !funx(TRUE), msg = "as<bool>(TRUE) -> true" )
checkTrue( funx(FALSE), msg = "as<bool>(FALSE) -> false" )
checkTrue( !funx(1L), msg = "as<bool>(1L) -> true" )
@@ -108,6 +237,7 @@
}
test.RObject.asStdVectorIntResultsSet <- function(){
+ funx <- .Rcpp.RObject$asStdVectorIntResultsSet
foo <- '
std::vector<int> iv = as<std::vector<int> >( x );
for (size_t i=0; i<iv.size(); i++) {
@@ -121,49 +251,28 @@
checkEquals( funx(x=2:5+.1), 2:5*2L, msg = "as<std::vector<int> >(numeric) via RcppResultSet" )
checkEquals( funx(x=as.raw(2:5)), 2:5*2L, msg = "as<std::vector<int> >(raw) via RcppResultSet" )
checkException( funx("foo"), msg = "as<std::vector<int> >(character) -> exception" )
-
}
test.RObject.asStdVectorInt <- function(){
- foo <- '
- std::vector<int> iv = as< std::vector<int> >(x);
- for (size_t i=0; i<iv.size(); i++) {
- iv[i] = 2*iv[i];
- }
- return(Rcpp::wrap( iv ) );'
- funx <- cppfunction(signature(x="numeric"), foo )
+ funx <- .Rcpp.RObject$asStdVectorInt
checkEquals( funx(x=2:5), 2:5*2L, msg = "as< std::vector<int> >(integer)" )
checkEquals( funx(x=2:5+.1), 2:5*2L, msg = "as< std::vector<int> >(numeric)" )
checkEquals( funx(x=as.raw(2:5)), 2:5*2L, msg = "as< std::vector<int> >(raw)" )
checkException( funx("foo"), msg = "as< std::vector<int> >(character) -> exception" )
checkException( funx(NULL), msg = "as< std::vector<int> >(NULL) -> exception" )
-
}
test.RObject.asStdVectorDouble <- function(){
- foo <- '
- std::vector<double> iv = as< std::vector<double> >( x );
- for (size_t i=0; i<iv.size(); i++) {
- iv[i] = 2*iv[i];
- }
- return(Rcpp::wrap( iv ));'
- funx <- cppfunction(signature(x="numeric"), foo )
+ funx <- .Rcpp.RObject$asStdVectorDouble
checkEquals( funx(x=0.1+2:5), 2*(0.1+2:5), msg = "as< std::vector<double> >( numeric )" )
checkEquals( funx(x=2:5), 2*(2:5), msg = "as< std::vector<double> >(integer)" )
checkEquals( funx(x=as.raw(2:5)), 2*(2:5), msg = "as< std::vector<double> >(raw)" )
checkException( funx("foo"), msg = "as< std::vector<double> >(character) -> exception" )
checkException( funx(NULL), msg = "as< std::vector<double> >(NULL) -> exception" )
-
}
test.RObject.asStdVectorRaw <- function(){
- foo <- '
- std::vector<Rbyte> iv = as< std::vector<Rbyte> >( x );
- for (size_t i=0; i<iv.size(); i++) {
- iv[i] = 2*iv[i];
- }
- return(Rcpp::wrap( iv ));'
- funx <- cppfunction(signature(x="raw"), foo )
+ funx <- .Rcpp.RObject$asStdVectorRaw
checkEquals( funx(x=as.raw(0:9)), as.raw(2*(0:9)), msg = "as< std::vector<Rbyte> >(raw)" )
checkEquals( funx(x=0:9), as.raw(2*(0:9)), msg = "as< std::vector<Rbyte> >( integer )" )
checkEquals( funx(x=as.numeric(0:9)), as.raw(2*(0:9)), msg = "as< std::vector<Rbyte> >(numeric)" )
@@ -173,13 +282,7 @@
}
test.RObject.asStdVectorBool <- function(){
- foo <- '
- std::vector<bool> bv = as< std::vector<bool> >( x );
- for (size_t i=0; i<bv.size(); i++) {
- bv[i].flip() ;
- }
- return(Rcpp::wrap( bv ));'
- funx <- cppfunction(signature(x="logical"), foo )
+ funx <- .Rcpp.RObject$asStdVectorBool
checkEquals( funx(x=c(TRUE,FALSE)), c(FALSE, TRUE), msg = "as< std::vector<bool> >(logical)" )
checkEquals( funx(x=c(1L, 0L)), c(FALSE, TRUE), msg = "as< std::vector<bool> >(integer)" )
checkEquals( funx(x=c(1.0, 0.0)), c(FALSE, TRUE), msg = "as< std::vector<bool> >(numeric)" )
@@ -189,13 +292,7 @@
}
test.RObject.asStdVectorString <- function(){
- foo <- '
- std::vector<std::string> iv = as< std::vector<std::string> >( x );
- for (size_t i=0; i<iv.size(); i++) {
- iv[i] = iv[i] + iv[i];
- }
- return(Rcpp::wrap( iv ));'
- funx <- cppfunction(signature(x="character"), foo )
+ funx <- .Rcpp.RObject$asStdVectorString
checkEquals( funx(c("foo", "bar")), c("foofoo", "barbar"), msg = "as< std::vector<std::string> >(character)" )
checkException( funx(1L), msg = "as< std::vector<std::string> >(integer) -> exception" )
checkException( funx(1.0), msg = "as< std::vector<std::string> >(numeric) -> exception" )
@@ -205,83 +302,47 @@
}
test.RObject.stdsetint <- function(){
- foo <- '
- std::set<int> iv ;
- iv.insert( 0 ) ;
- iv.insert( 1 ) ;
- iv.insert( 0 ) ;
- return Rcpp::wrap( iv );'
- funx <- cppfunction(signature(), foo, includes = "#include <set>" )
+ funx <- .Rcpp.RObject$stdsetint
checkEquals( funx(), c(0L, 1L), msg = "wrap( set<int> )" )
}
test.RObject.stdsetdouble <- function(){
- foo <- '
- std::set<double> ds;
- ds.insert( 0.0 );
- ds.insert( 1.0 );
- ds.insert( 0.0 );
- return(Rcpp::wrap( ds )); '
- funx <- cppfunction(signature(), foo, includes = "#include <set>")
+ funx <- .Rcpp.RObject$stdsetdouble
checkEquals( funx(), as.numeric(0:1), msg = "wrap( set<double>" )
}
test.RObject.stdsetraw <- function(){
- foo <- '
- std::set<Rbyte> bs ;
- bs.insert( (Rbyte)0 ) ;
- bs.insert( (Rbyte)1 ) ;
- bs.insert( (Rbyte)0 ) ;
- return(Rcpp::wrap( bs )); '
- funx <- cppfunction(signature(), foo, includes = "#include <set>")
+ funx <- .Rcpp.RObject$stdsetraw
checkEquals( funx(), as.raw(0:1), msg = "wrap(set<raw>)" )
}
test.RObject.stdsetstring <- function(){
- foo <- '
- std::set<std::string> ss ;
- ss.insert( "foo" ) ;
- ss.insert( "bar" ) ;
- ss.insert( "foo" ) ;
- return(Rcpp::wrap( ss )); '
- funx <- cppfunction(signature(), foo, include = "#include <set>" )
+ funx <- .Rcpp.RObject$stdsetstring
checkEquals( funx(), c("bar", "foo"), msg = "wrap(set<string>)" )
}
test.RObject.attributeNames <- function(){
- funx <- cppfunction(signature(x="data.frame"), '
- std::vector<std::string> iv = RObject(x).attributeNames();
- return(wrap( iv ));' )
+ funx <- .Rcpp.RObject$attributeNames
checkTrue( all( c("names","row.names","class") %in% funx(iris)), msg = "RObject.attributeNames" )
}
test.RObject.hasAttribute <- function(){
- funx <- cppfunction(signature(x="data.frame"), '
- bool has_class = RObject(x).hasAttribute( "class" ) ;
- return wrap( has_class ) ;')
+ funx <- .Rcpp.RObject$hasAttribute
checkTrue( funx( iris ), msg = "RObject.hasAttribute" )
}
test.RObject.attr <- function(){
- funx <- cppfunction(signature(x="data.frame"), '
- return RObject(x).attr( "row.names" ) ;
- ')
+ funx <- .Rcpp.RObject$attr
checkEquals( funx( iris ), 1:150, msg = "RObject.attr" )
}
test.RObject.attr.set <- function(){
- funx <- cppfunction(signature(), '
- RObject y = wrap("blabla") ;
- y.attr("foo") = 10 ;
- return y ; ')
+ funx <- .Rcpp.RObject$attr_set
checkEquals( attr(funx(), "foo"), 10L, msg = "RObject.attr() = " )
}
test.RObject.isNULL <- function(){
- funx <- cppfunction(signature(x="ANY"), '
- bool is_null = RObject(x).isNULL() ;
- return wrap( is_null ) ;
- ' )
+ funx <- .Rcpp.RObject$isNULL
checkTrue( !funx( iris ), msg = "RObject.isNULL(iris) -> false" )
checkTrue( funx(NULL), msg = "RObject.isNULL(NULL) -> true" )
checkTrue( !funx(1L), msg = "RObject.isNULL(integer) -> false" )
More information about the Rcpp-commits
mailing list