[Rcpp-commits] r1805 - pkg/Rcpp/inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jul 7 14:30:28 CEST 2010
Author: romain
Date: 2010-07-07 14:30:28 +0200 (Wed, 07 Jul 2010)
New Revision: 1805
Modified:
pkg/Rcpp/inst/unitTests/runit.Matrix.R
pkg/Rcpp/inst/unitTests/runit.NumericVector.R
Log:
faster
Modified: pkg/Rcpp/inst/unitTests/runit.Matrix.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Matrix.R 2010-07-07 12:16:57 UTC (rev 1804)
+++ pkg/Rcpp/inst/unitTests/runit.Matrix.R 2010-07-07 12:30:28 UTC (rev 1805)
@@ -93,3 +93,29 @@
checkEquals( funx(), x, msg = "matrix from two int" )
}
+test.NumericMatrix.indexing <- function(){
+ funx <- cppfunction(signature(x = "numeric" ), '
+ NumericVector m(x) ;
+ double trace = 0.0 ;
+ for( size_t i=0 ; i<4; i++){
+ trace += m(i,i) ;
+ }
+ return wrap( trace ) ;
+ ' )
+ x <- matrix( 1:16 + .5, ncol = 4 )
+ checkEquals( funx(x), sum(diag(x)), msg = "matrix indexing" )
+
+ y <- as.vector( x )
+ checkException( funx(y) , msg = "not a matrix" )
+
+ funx <- cppfunction(signature(x = "numeric" ), '
+ NumericVector m(x) ;
+ for( size_t i=0 ; i<4; i++){
+ m(i,i) = 2.0 * i ;
+ }
+ return m ;
+ ' )
+ checkEquals( diag(funx(x)), 2.0*0:3, msg = "matrix indexing lhs" )
+
+}
+
Modified: pkg/Rcpp/inst/unitTests/runit.NumericVector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.NumericVector.R 2010-07-07 12:16:57 UTC (rev 1804)
+++ pkg/Rcpp/inst/unitTests/runit.NumericVector.R 2010-07-07 12:30:28 UTC (rev 1805)
@@ -17,88 +17,104 @@
# You should have received a copy of the GNU General Public License
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+.setUp <- function() {
+ tests <- ".rcpp.NumericVector"
+ if( ! exists( tests, globalenv() )) {
+ ## definition of all the functions at once
+ f <- list(
+ "numeric_" = list(
+ signature(),
+ '
+ NumericVector x(10) ;
+ for( int i=0; i<10; i++) x[i] = i ;
+ return x ;
+ '
+ ),
+ "numeric_REALSXP" = list(
+ signature(vec = "numeric" ),
+ '
+ NumericVector x(vec) ;
+ for( int i=0; i<x.size(); i++) {
+ x[i] = x[i]*2.0 ;
+ }
+ return x ;
+ '
+ ),
+ "numeric_import" = list(
+ signature(),
+ '
+ std::vector<int> v(10) ;
+ for( int i=0; i<10; i++) v[i] = i ;
+
+ return IntegerVector::import( v.begin(), v.end() ) ;
+
+ '
+ ),
+ "numeric_importtransform" = list(
+ signature(),
+ '
+ std::vector<double> v(10) ;
+ for( int i=0; i<10; i++) v[i] = i ;
+
+ return NumericVector::import_transform( v.begin(), v.end(), square ) ;
+
+ '
+ )
+ )
+
+ if( Rcpp:::capabilities()[["initializer lists"]] ){
+ g <- list(
+ "numeric_initlist" = list(
+ signature(),
+ '
+ NumericVector x = {0.0,1.0,2.0,3.0} ;
+ for( int i=0; i<x.size(); i++) x[i] = x[i]*2 ;
+ return x ;
+ '
+ )
+ )
+ f <- c(f,g)
+ }
+
+ signatures <- lapply(f, "[[", 1L)
+ bodies <- lapply(f, "[[", 2L)
+ fun <- cxxfunction(signatures, bodies,
+ plugin = "Rcpp",
+ includes = "
+ using namespace std;
+ inline double square( double x){ return x*x; }
+ ",
+ cxxargs = ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x","")
+ )
+ getDynLib( fun ) # just forcing loading the dll now
+ assign( tests, fun, globalenv() )
+ }
+}
+
test.NumericVector <- function(){
- funx <- cppfunction(signature(), '
- NumericVector x(10) ;
- for( int i=0; i<10; i++) x[i] = i ;
- return x ;' )
+ funx <- .rcpp.NumericVector$numeric_
checkEquals( funx(), as.numeric(0:9), msg = "NumericVector(int)" )
}
test.NumericVector.REALSXP <- function(){
- funx <- cppfunction(signature(vec = "numeric" ), '
- NumericVector x(vec) ;
- for( int i=0; i<x.size(); i++) {
- x[i] = x[i]*2.0 ;
- }
- return x ;' )
+ funx <- .rcpp.NumericVector$numeric_REALSXP
checkEquals( funx(as.numeric(0:9)), 2*0:9, msg = "NumericVector( REALSXP) " )
}
-test.NumericVector.initializer.list <- function(){
- if( Rcpp:::capabilities()[["initializer lists"]] ){
- funx <- cppfunction(signature(), '
- NumericVector x = {0.0,1.0,2.0,3.0} ;
- for( int i=0; i<x.size(); i++) x[i] = x[i]*2 ;
- return x ;', cxxargs = "-std=c++0x" )
+if( Rcpp:::capabilities()[["initializer lists"]] ){
+ test.NumericVector.initializer.list <- function(){
+ funx <- .rcpp.NumericVector$numeric_initlist
checkEquals( funx(), as.numeric(2*0:3), msg = "NumericVector( initializer list) " )
}
}
-test.NumericVector.matrix.indexing <- function(){
- funx <- cppfunction(signature(x = "numeric" ), '
- NumericVector m(x) ;
- double trace = 0.0 ;
- for( size_t i=0 ; i<4; i++){
- trace += m(i,i) ;
- }
- return wrap( trace ) ;
- ' )
- x <- matrix( 1:16 + .5, ncol = 4 )
- checkEquals( funx(x), sum(diag(x)), msg = "matrix indexing" )
-
- y <- as.vector( x )
- checkException( funx(y) , msg = "not a matrix" )
-
- funx <- cppfunction(signature(x = "numeric" ), '
- NumericVector m(x) ;
- for( size_t i=0 ; i<4; i++){
- m(i,i) = 2.0 * i ;
- }
- return m ;
- ' )
- checkEquals( diag(funx(x)), 2.0*0:3, msg = "matrix indexing lhs" )
-
-}
-
test.NumericVector.import <- function(){
- fx <- cxxfunction( signature(), '
- std::vector<int> v(10) ;
- for( int i=0; i<10; i++) v[i] = i ;
-
- return IntegerVector::import( v.begin(), v.end() ) ;
-
- ', plugin = "Rcpp" )
-
- checkEquals( fx(), 0:9, msg = "IntegerVector::import" )
-
+ funx <- .rcpp.NumericVector$numeric_import
+ checkEquals( funx(), 0:9, msg = "IntegerVector::import" )
}
test.NumericVector.import.transform <- function(){
-
- inc <- '
- inline double square( double x){ return x*x; }
-
- '
- fx <- cxxfunction( signature(), '
- std::vector<double> v(10) ;
- for( int i=0; i<10; i++) v[i] = i ;
-
- return NumericVector::import_transform( v.begin(), v.end(), square ) ;
-
- ', include = inc, plugin = "Rcpp" )
-
- checkEquals( fx(), (0:9)^2, msg = "NumericVector::import_transform" )
-
+ funx <- .rcpp.NumericVector$numeric_importtransform
+ checkEquals( funx(), (0:9)^2, msg = "NumericVector::import_transform" )
}
More information about the Rcpp-commits
mailing list