[Rcpp-commits] r1347 - in pkg/RcppArmadillo: inst/unitTests src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri May 28 13:49:44 CEST 2010


Author: romain
Date: 2010-05-28 13:49:43 +0200 (Fri, 28 May 2010)
New Revision: 1347

Added:
   pkg/RcppArmadillo/inst/unitTests/runit.fastLm.R
Modified:
   pkg/RcppArmadillo/inst/unitTests/runTests.R
   pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R
   pkg/RcppArmadillo/src/RcppArmadillo.cpp
Log:
moving unit tests internal functions in the unitTests directory, using inline::cxxfunction

Modified: pkg/RcppArmadillo/inst/unitTests/runTests.R
===================================================================
--- pkg/RcppArmadillo/inst/unitTests/runTests.R	2010-05-28 10:45:29 UTC (rev 1346)
+++ pkg/RcppArmadillo/inst/unitTests/runTests.R	2010-05-28 11:49:43 UTC (rev 1347)
@@ -1,5 +1,13 @@
 pkg <- "RcppArmadillo"
 
+if( ! require( "inline", character.only = TRUE, quietly = TRUE ) ){
+	stop( "The inline package is required to run RcppArmadillo unit tests" )
+}
+
+if( compareVersion( packageDescription( "inline" )[["Version"]], "0.3.4.2" ) < 0 ){
+	stop( "RcppArmadillo unit tests need at least the version 0.3.4.2 of inline" )
+}
+
 if(require("RUnit", quietly = TRUE)) {
 
     is_local <- function(){

Modified: pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R
===================================================================
--- pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R	2010-05-28 10:45:29 UTC (rev 1346)
+++ pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R	2010-05-28 11:49:43 UTC (rev 1347)
@@ -17,12 +17,63 @@
 # You should have received a copy of the GNU General Public License
 # along with RcppArmadillo.  If not, see <http://www.gnu.org/licenses/>.
 
-.setUp <- function(){
-    suppressMessages(require(datasets))
-}
-
 test.wrap.R <- function(){
-    res <- .Call( "RcppArmadillo_wrap", PACKAGE = "RcppArmadillo" )
+	
+	fx <- cxxfunction( , '
+	
+    // using the Named(.) = . notation
+    List cols = List::create( 
+    	Named( "Col<double>" ) = arma::zeros<arma::mat>(5,1), 
+    	Named( "Col<float>" )  = arma::zeros<arma::fmat>(5,1)
+    	) ;
+    
+    // using the Named(., .)  notation
+    List rows = List::create( 
+    	Named( "Row<double>",  arma::zeros<arma::mat>(1,5)  ),
+    	Named( "Row<float>" ,  arma::zeros<arma::fmat>(1,5) )
+    	) ;
+	
+    // using the _[.] = . notation
+    List matrices = List::create( 
+    	_["Mat<int>"]          = arma::eye<arma::imat>( 3,3 ), 
+    	_["Mat<double>"]       = arma::eye<arma::mat>( 3,3 ),
+    	_["Mat<float>"]        = arma::eye<arma::fmat>( 3, 3 ), 
+    	_["Mat<unsigned int>"] = arma::eye<arma::umat>( 3, 3 )
+    	) ;
+    
+    // creating an empty list and grow it on demand
+    List fields ;
+    arma::field<int> f1( 2, 2 ) ;
+    f1( 0, 0 ) = 0 ; 
+    f1( 1, 0 ) = 1 ; 
+    f1( 0, 1 ) = 2 ; 
+    f1( 1, 1 ) = 3 ; 
+    fields["field<int>"] = f1 ;
+    
+    arma::field<std::string> f2(2,2) ;
+    f2( 0, 0 ) = "a" ; 
+    f2( 1, 0 ) = "b" ; 
+    f2( 0, 1 ) = "c" ; 
+    f2( 1, 1 ) = "d" ; 
+    fields["field<std::string>"] = f2 ;
+    
+    arma::field<arma::colvec> f3(2,2) ;
+    f3(0,0) = arma::zeros<arma::mat>(5,1) ;
+    f3(1,0) = arma::zeros<arma::mat>(4,1) ;
+    f3(0,1) = arma::zeros<arma::mat>(3,1) ;
+    f3(1,1) = arma::zeros<arma::mat>(2,1) ;
+    fields["field<colvec>"] = f3 ;
+	
+    List output = List::create( 
+    	_["matrices : Mat<T>"]  = matrices, 
+    	_["rows : Row<T>"]      = rows,
+    	_["columns : Col<T>"]   = cols, 
+    	_["fields  : field<T>"] = fields ) ;
+    
+    return output ;
+	' , plugin = "RcppArmadillo" )
+	
+    res <- fx()
 
     checkEquals( res[[1]][[1]], matrix(as.integer((diag(3))),nr=3), msg = "eye<imat>(3,3)" )
     checkEquals( res[[1]][[2]], diag(3), msg = "eye<mat>(3,3)" )
@@ -40,59 +91,103 @@
 }
 
 test.wrap.Glue <- function(){
-    res <- .Call( "RcppArmadillo_wrap_Glue", PACKAGE = "RcppArmadillo" )
+    
+	fx <- cxxfunction( , '
+	
+    arma::mat m1 = arma::eye<arma::mat>( 3, 3 ) ;
+    arma::mat m2 = arma::eye<arma::mat>( 3, 3 ) ;
+	                     
+    List res ;                                  
+    res["mat+mat"] = m1 + m2 ;
+    return res ;
+	
+	', plugin = "RcppArmadillo" )
+	
+	res <- fx()
     checkEquals( res[[1]], 2*diag(3), msg = "wrap(Glue)" )
 }
 
 test.wrap.Op <- function(){
-    res <- .Call( "RcppArmadillo_wrap_Op", PACKAGE = "RcppArmadillo" )
+	
+	fx <- cxxfunction( , '
+	
+	arma::mat m1 = arma::eye<arma::mat>( 3, 3 ) ;
+	
+    List res ;
+    res["- mat"] = - m1 ;
+    return res ;
+	
+	', plugin = "RcppArmadillo" )
+    res <- fx()
     checkEquals( res[[1]], -1*diag(3), msg = "wrap(Op)" )
 }
 
 test.as.Mat <- function(){
+	
+	fx <- cxxfunction( signature(input_ = "list" ) , '
+	    List input(input_) ;
+    	arma::imat m1 = input[0] ; /* implicit as */
+    	arma::mat  m2 = input[1] ; /* implicit as */
+    	arma::umat m3 = input[0] ; /* implicit as */
+    	arma::fmat m4 = input[1] ; /* implicit as */
+		
+    	List res = List::create( 
+    		arma::accu( m1 ),
+    		arma::accu( m2 ),
+    		arma::accu( m3 ),
+    		arma::accu( m4 ) ) ;
+    	
+    	return res ;
+    ', plugin = "RcppArmadillo" )
+	
     integer_mat <- matrix( as.integer(diag(4)), ncol = 4, nrow = 4 )
     numeric_mat <- diag(5)
-    res <- .Call( "RcppArmadillo_as_Mat",
-                 list( integer_mat, numeric_mat ),
-                 PACKAGE = "RcppArmadillo" )
+    res <- fx( list( integer_mat, numeric_mat ) )
     checkEquals( unlist( res), c(4L, 5L, 4L, 5L ), msg = "as<Mat>" )
 }
 
 test.as.Col <- function(){
-    res <- .Call( "RcppArmadillo_as_Col",
-                 list( 1:10, as.numeric(1:10) ),
-                 PACKAGE = "RcppArmadillo" )
+	fx <- cxxfunction( signature(input_ = "list" ) , '
+		
+    List input(input_) ;
+    arma::icolvec m1 = input[0] ; /* implicit as */
+    arma::colvec  m2 = input[1] ; /* implicit as */
+    arma::ucolvec m3 = input[0] ; /* implicit as */
+    arma::fcolvec m4 = input[1] ; /* implicit as */
+	
+    List res = List::create( 
+    	arma::accu( m1 ),
+    	arma::accu( m2 ),
+    	arma::accu( m3 ),
+    	arma::accu( m4 ) ) ;
+    
+    return res ;
+	
+	', plugin = "RcppArmadillo" )
+	
+    res <- fx( list( 1:10, as.numeric(1:10) ) )
     checkEquals( unlist( res ), rep(55.0, 4 ), msg = "as<Col>" )
 }
 
 test.as.Row <- function(){
-    res <- .Call( "RcppArmadillo_as_Row",
-                 list( 1:10, as.numeric(1:10) ),
-                 PACKAGE = "RcppArmadillo" )
-    checkEquals( unlist( res ), rep(55.0, 4 ), msg = "as<Row>" )
-}
+	fx <- cxxfunction( signature(input_ = "list" ) , '
 
-test.fastLm <- function() {
-    data(trees)
-    flm <- .Call("fastLm",
-                 log(trees$Volume),
-                 cbind(1, log(trees$Girth)),
-                 PACKAGE="RcppArmadillo")
-    fit <- lm(log(Volume) ~ log(Girth), data=trees)
+    List input(input_) ;
+    arma::irowvec m1 = input[0] ; /* implicit as */
+    arma::rowvec  m2 = input[1] ; /* implicit as */
+    arma::urowvec m3 = input[0] ; /* implicit as */
+    arma::frowvec m4 = input[1] ; /* implicit as */
+	
+    List res = List::create( 
+    	arma::accu( m1 ),
+    	arma::accu( m2 ),
+    	arma::accu( m3 ),
+    	arma::accu( m4 ) ) ;
+    return res ;
+	
+	', plugin = "RcppArmadillo" )
 
-    checkEquals(as.numeric(flm$coefficients), as.numeric(coef(fit)),
-                msg="fastLm.coef")
-    checkEquals(as.numeric(flm$stderr), as.numeric(coef(summary(fit))[,2]),
-                msg="fastLm.stderr")
+    res <- fx( list( 1:10, as.numeric(1:10) ) )
+    checkEquals( unlist( res ), rep(55.0, 4 ), msg = "as<Row>" )
 }
 
-test.fastLm.formula <- function() {
-    data(trees)
-    flm <- fastLm(log(Volume) ~ log(Girth), data=trees)
-    fit <- lm(log(Volume) ~ log(Girth), data=trees)
-
-    checkEquals(flm$coefficients, coef(fit), msg="fastLm.formula.coef")
-    checkEquals(as.numeric(flm$stderr), as.numeric(coef(summary(fit))[,2]),
-                msg="fastLm.formula.stderr")
-}
-

Added: pkg/RcppArmadillo/inst/unitTests/runit.fastLm.R
===================================================================
--- pkg/RcppArmadillo/inst/unitTests/runit.fastLm.R	                        (rev 0)
+++ pkg/RcppArmadillo/inst/unitTests/runit.fastLm.R	2010-05-28 11:49:43 UTC (rev 1347)
@@ -0,0 +1,47 @@
+#!/usr/bin/r -t
+#
+# Copyright (C) 2010	Dirk Eddelbuettel, Romain Francois and Douglas Bates
+#
+# This file is part of RcppArmadillo.
+#
+# RcppArmadillo is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# RcppArmadillo is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with RcppArmadillo.  If not, see <http://www.gnu.org/licenses/>.
+
+.setUp <- function(){
+    suppressMessages(require(datasets))
+}
+
+test.fastLm <- function() {
+    data(trees)
+    flm <- .Call("fastLm",
+                 log(trees$Volume),
+                 cbind(1, log(trees$Girth)),
+                 PACKAGE="RcppArmadillo")
+    fit <- lm(log(Volume) ~ log(Girth), data=trees)
+
+    checkEquals(as.numeric(flm$coefficients), as.numeric(coef(fit)),
+                msg="fastLm.coef")
+    checkEquals(as.numeric(flm$stderr), as.numeric(coef(summary(fit))[,2]),
+                msg="fastLm.stderr")
+}
+
+test.fastLm.formula <- function() {
+    data(trees)
+    flm <- fastLm(log(Volume) ~ log(Girth), data=trees)
+    fit <- lm(log(Volume) ~ log(Girth), data=trees)
+
+    checkEquals(flm$coefficients, coef(fit), msg="fastLm.formula.coef")
+    checkEquals(as.numeric(flm$stderr), as.numeric(coef(summary(fit))[,2]),
+                msg="fastLm.formula.stderr")
+}
+

Modified: pkg/RcppArmadillo/src/RcppArmadillo.cpp
===================================================================
--- pkg/RcppArmadillo/src/RcppArmadillo.cpp	2010-05-28 10:45:29 UTC (rev 1346)
+++ pkg/RcppArmadillo/src/RcppArmadillo.cpp	2010-05-28 11:49:43 UTC (rev 1347)
@@ -23,128 +23,6 @@
 
 using namespace Rcpp ;
 
-extern "C" SEXP RcppArmadillo_wrap(){
-	
-    // using the Named(.) = . notation
-    List cols = List::create( 
-    	Named( "Col<double>" ) = arma::zeros<arma::mat>(5,1), 
-    	Named( "Col<float>" )  = arma::zeros<arma::fmat>(5,1)
-    	) ;
-    
-    // using the Named(., .)  notation
-    List rows = List::create( 
-    	Named( "Row<double>",  arma::zeros<arma::mat>(1,5)  ),
-    	Named( "Row<float>" ,  arma::zeros<arma::fmat>(1,5) )
-    	) ;
-	
-    // using the _[.] = . notation
-    List matrices = List::create( 
-    	_["Mat<int>"]          = arma::eye<arma::imat>( 3,3 ), 
-    	_["Mat<double>"]       = arma::eye<arma::mat>( 3,3 ),
-    	_["Mat<float>"]        = arma::eye<arma::fmat>( 3, 3 ), 
-    	_["Mat<unsigned int>"] = arma::eye<arma::umat>( 3, 3 )
-    	) ;
-    
-    // creating an empty list and grow it on demand
-    List fields ;
-    arma::field<int> f1( 2, 2 ) ;
-    f1( 0, 0 ) = 0 ; 
-    f1( 1, 0 ) = 1 ; 
-    f1( 0, 1 ) = 2 ; 
-    f1( 1, 1 ) = 3 ; 
-    fields["field<int>"] = f1 ;
-    
-    arma::field<std::string> f2(2,2) ;
-    f2( 0, 0 ) = "a" ; 
-    f2( 1, 0 ) = "b" ; 
-    f2( 0, 1 ) = "c" ; 
-    f2( 1, 1 ) = "d" ; 
-    fields["field<std::string>"] = f2 ;
-    
-    arma::field<arma::colvec> f3(2,2) ;
-    f3(0,0) = arma::zeros<arma::mat>(5,1) ;
-    f3(1,0) = arma::zeros<arma::mat>(4,1) ;
-    f3(0,1) = arma::zeros<arma::mat>(3,1) ;
-    f3(1,1) = arma::zeros<arma::mat>(2,1) ;
-    fields["field<colvec>"] = f3 ;
-	
-    List output = List::create( 
-    	_["matrices : Mat<T>"]  = matrices, 
-    	_["rows : Row<T>"]      = rows,
-    	_["columns : Col<T>"]   = cols, 
-    	_["fields  : field<T>"] = fields ) ;
-    
-    return output ;
-	
-}
-
-extern "C" SEXP RcppArmadillo_as_Mat(SEXP input_){
-
-    List input(input_) ;
-    arma::imat m1 = input[0] ; /* implicit as */
-    arma::mat  m2 = input[1] ; /* implicit as */
-    arma::umat m3 = input[0] ; /* implicit as */
-    arma::fmat m4 = input[1] ; /* implicit as */
-	
-    List res = List::create( 
-    	arma::accu( m1 ),
-    	arma::accu( m2 ),
-    	arma::accu( m3 ),
-    	arma::accu( m4 ) ) ;
-    
-    return res ;
-}
-
-extern "C" SEXP RcppArmadillo_as_Col( SEXP input_){
-    List input(input_) ;
-    arma::icolvec m1 = input[0] ; /* implicit as */
-    arma::colvec  m2 = input[1] ; /* implicit as */
-    arma::ucolvec m3 = input[0] ; /* implicit as */
-    arma::fcolvec m4 = input[1] ; /* implicit as */
-	
-    List res = List::create( 
-    	arma::accu( m1 ),
-    	arma::accu( m2 ),
-    	arma::accu( m3 ),
-    	arma::accu( m4 ) ) ;
-    
-    return res ;
-}
-
-extern "C" SEXP RcppArmadillo_as_Row(SEXP input_){
-    List input(input_) ;
-    arma::irowvec m1 = input[0] ; /* implicit as */
-    arma::rowvec  m2 = input[1] ; /* implicit as */
-    arma::urowvec m3 = input[0] ; /* implicit as */
-    arma::frowvec m4 = input[1] ; /* implicit as */
-	
-    List res = List::create( 
-    	arma::accu( m1 ),
-    	arma::accu( m2 ),
-    	arma::accu( m3 ),
-    	arma::accu( m4 ) ) ;
-    return res ;
-}
-
-extern "C" SEXP RcppArmadillo_wrap_Glue(){
-	
-    arma::mat m1 = arma::eye<arma::mat>( 3, 3 ) ;
-    arma::mat m2 = arma::eye<arma::mat>( 3, 3 ) ;
-	                     
-    List res ;                                  
-    res["mat+mat"] = m1 + m2 ;
-    return res ;
-}
-
-extern "C" SEXP RcppArmadillo_wrap_Op(){
-
-	arma::mat m1 = arma::eye<arma::mat>( 3, 3 ) ;
-	
-    List res ;
-    res["- mat"] = - m1 ;
-    return res ;
-}
-
 extern "C" SEXP armadillo_version(SEXP single_){
     struct arma::arma_version av;
     bool single = Rcpp::as<bool>( single_) ;



More information about the Rcpp-commits mailing list