[Rcpp-commits] r1818 - pkg/Rcpp/inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jul 7 16:28:00 CEST 2010
Author: romain
Date: 2010-07-07 16:27:59 +0200 (Wed, 07 Jul 2010)
New Revision: 1818
Modified:
pkg/Rcpp/inst/unitTests/runit.Matrix.R
pkg/Rcpp/inst/unitTests/runit.Vector.R
Log:
faster runit.Matricx
Modified: pkg/Rcpp/inst/unitTests/runit.Matrix.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Matrix.R 2010-07-07 14:15:02 UTC (rev 1817)
+++ pkg/Rcpp/inst/unitTests/runit.Matrix.R 2010-07-07 14:27:59 UTC (rev 1818)
@@ -17,15 +17,95 @@
# 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.Matrix"
+ if( ! exists( tests, globalenv() )) {
+ ## definition of all the functions at once
+ f <- list(
+ "matrix_numeric" = list(
+ signature(x = "matrix" ), '
+ NumericMatrix m(x) ;
+ double trace = 0.0 ;
+ for( size_t i=0 ; i<4; i++){
+ trace += m(i,i) ;
+ }
+ return wrap( trace ) ;
+ '
+ ),
+ "matrix_character" = list(
+ signature(x = "matrix" ), '
+ CharacterMatrix m(x) ;
+ std::string trace ;
+ for( size_t i=0 ; i<4; i++){
+ trace += m(i,i) ;
+ }
+ return wrap( trace ) ;
+ '
+ ),
+ "matrix_generic" = list(
+ signature(x = "matrix" ), '
+ GenericMatrix m(x) ;
+ List output( m.ncol() ) ;
+ for( size_t i=0 ; i<4; i++){
+ output[i] = m(i,i) ;
+ }
+ return output ;
+ '
+ ),
+ "matrix_integer_diag" = list(
+ signature(),
+ 'return IntegerMatrix::diag( 5, 1 ) ; '
+ ),
+ "matrix_character_diag" = list(
+ signature(),
+ 'return CharacterMatrix::diag( 5, "foo" ) ;'
+ ),
+ "matrix_numeric_ctor1" = list(
+ signature(),
+ '
+ NumericMatrix m(3);
+ return m;
+ '
+ ),
+ "matrix_numeric_ctor2" = list(
+ signature(), '
+ NumericMatrix m(3,3);
+ return m;
+ '
+ ),
+ "integer_matrix_indexing"=list(
+ signature(x = "integer" ),
+ 'IntegerVector m(x) ;
+ int trace = 0.0 ;
+ for( size_t i=0 ; i<4; i++){
+ trace += m(i,i) ;
+ }
+ return wrap( trace ) ;'
+ ),
+ "integer_matrix_indexing_lhs"=list(
+ signature(x = "integer" ),
+ 'IntegerVector m(x) ;
+ for( size_t i=0 ; i<4; i++){
+ m(i,i) = 2 * i ;
+ }
+ return m ; '
+ )
+
+ )
+
+ signatures <- lapply(f, "[[", 1L)
+ bodies <- lapply(f, "[[", 2L)
+ fun <- cxxfunction(signatures, bodies,
+ plugin = "Rcpp",
+ cxxargs = ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x",""))
+ getDynLib( fun ) # just forcing loading the dll now
+ assign( tests, fun, globalenv() )
+ }
+}
+
test.NumericMatrix <- function(){
- funx <- cppfunction(signature(x = "matrix" ), '
- NumericMatrix m(x) ;
- double trace = 0.0 ;
- for( size_t i=0 ; i<4; i++){
- trace += m(i,i) ;
- }
- return wrap( trace ) ;
- ' )
+ funx <- .rcpp.Matrix$matrix_numeric
x <- matrix( 1:16 + .5, ncol = 4 )
checkEquals( funx(x), sum(diag(x)), msg = "matrix indexing" )
@@ -35,27 +115,13 @@
}
test.CharacterMatrix <- function(){
- funx <- cppfunction(signature(x = "matrix" ), '
- CharacterMatrix m(x) ;
- std::string trace ;
- for( size_t i=0 ; i<4; i++){
- trace += m(i,i) ;
- }
- return wrap( trace ) ;
- ' )
+ funx <- .rcpp.Matrix$matrix_character
x <- matrix( letters[1:16], ncol = 4 )
checkEquals( funx(x), paste( diag(x), collapse = "" ) )
}
test.GenericMatrix <- function( ){
- funx <- cppfunction(signature(x = "matrix" ), '
- GenericMatrix m(x) ;
- List output( m.ncol() ) ;
- for( size_t i=0 ; i<4; i++){
- output[i] = m(i,i) ;
- }
- return output ;
- ' )
+ funx <- .rcpp.Matrix$matrix_generic
g <- function(y){
sapply( y, function(x) seq(from=x, to = 16) )
}
@@ -64,58 +130,38 @@
}
test.IntegerMatrix.diag <- function(){
- fx <- cppfunction( signature(), 'return IntegerMatrix::diag( 5, 1 ) ; ' )
+ funx <- .rcpp.Matrix$matrix_integer_diag
expected <- matrix( 0L, nrow = 5, ncol = 5 )
diag( expected ) <- 1L
- checkEquals( fx(), expected, msg = "IntegerMatrix::diag" )
+ checkEquals( funx(), expected, msg = "IntegerMatrix::diag" )
}
test.CharacterMatrix.diag <- function(){
- fx <- cppfunction( signature(), 'return CharacterMatrix::diag( 5, "foo" ) ;' )
+ funx <- .rcpp.Matrix$matrix_character_diag
expected <- matrix( "", nrow = 5, ncol = 5 )
diag( expected ) <- "foo"
- checkEquals( fx(), expected, msg = "CharacterMatrix::diag" )
+ checkEquals( funx(), expected, msg = "CharacterMatrix::diag" )
}
test.NumericMatrix.Ctors <- function(){
- funx <- cppfunction(signature(), '
- NumericMatrix m(3);
- return m;
- ' )
+ funx <- .rcpp.Matrix$matrix_numeric_ctor1
x <- matrix(0, 3, 3)
checkEquals( funx(), x, msg = "matrix from single int" )
- funx <- cppfunction(signature(), '
- NumericMatrix m(3,3);
- return m;
- ' )
+ funx <- .rcpp.Matrix$matrix_numeric_ctor2
x <- matrix(0, 3, 3)
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" )
-
+test.IntegerVector.matrix.indexing <- function(){
+ fun <- .rcpp.Matrix$integer_matrix_indexing
+ x <- matrix( 1:16, ncol = 4 )
+ checkEquals( fun(x), sum(diag(x)), msg = "matrix indexing" )
+
+ fun <- .rcpp.Matrix$integer_matrix_indexing_lhs
+ checkEquals( diag(fun(x)), 2*0:3, msg = "matrix indexing lhs" )
+
+ y <- as.vector( x )
+ checkException( fun(y) , msg = "not a matrix" )
}
Modified: pkg/Rcpp/inst/unitTests/runit.Vector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Vector.R 2010-07-07 14:15:02 UTC (rev 1817)
+++ pkg/Rcpp/inst/unitTests/runit.Vector.R 2010-07-07 14:27:59 UTC (rev 1818)
@@ -127,23 +127,6 @@
}
return x ;')
- ,"integer_matrix_indexing"=list(
- signature(x = "integer" ),
- 'IntegerVector m(x) ;
- int trace = 0.0 ;
- for( size_t i=0 ; i<4; i++){
- trace += m(i,i) ;
- }
- return wrap( trace ) ;')
-
- ,"integer_matrix_indexing_lhs"=list(
- signature(x = "integer" ),
- 'IntegerVector m(x) ;
- for( size_t i=0 ; i<4; i++){
- m(i,i) = 2 * i ;
- }
- return m ; ')
-
,"integer_dimension_ctor_1"=list(
signature(),
'return IntegerVector( Dimension( 5 ) ) ;')
@@ -748,18 +731,6 @@
}
}
-test.IntegerVector.matrix.indexing <- function(){
- fun <- .rcpp.Vector$integer_matrix_indexing
- x <- matrix( 1:16, ncol = 4 )
- checkEquals( fun(x), sum(diag(x)), msg = "matrix indexing" )
-
- fun <- .rcpp.Vector$integer_matrix_indexing_lhs
- checkEquals( diag(fun(x)), 2*0:3, msg = "matrix indexing lhs" )
-
- y <- as.vector( x )
- checkException( fun(y) , msg = "not a matrix" )
-}
-
test.IntegerVector.Dimension.constructor <- function(){
fun <- .rcpp.Vector$integer_dimension_ctor_1
checkEquals(fun(),
More information about the Rcpp-commits
mailing list