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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Feb 22 14:46:30 CET 2010


Author: romain
Date: 2010-02-22 14:46:30 +0100 (Mon, 22 Feb 2010)
New Revision: 766

Added:
   pkg/RcppArmadillo/inst/unitTests/runTests.R
   pkg/RcppArmadillo/src/
   pkg/RcppArmadillo/src/Makevars
   pkg/RcppArmadillo/src/Makevars.in
   pkg/RcppArmadillo/src/Makevars.win
   pkg/RcppArmadillo/src/RcppArmadillo.cpp
Modified:
   pkg/RcppArmadillo/NAMESPACE
   pkg/RcppArmadillo/configure
   pkg/RcppArmadillo/configure.in
   pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R
Log:
revert decision and have RcppArmadillo.cpp in src

Modified: pkg/RcppArmadillo/NAMESPACE
===================================================================
--- pkg/RcppArmadillo/NAMESPACE	2010-02-22 10:23:45 UTC (rev 765)
+++ pkg/RcppArmadillo/NAMESPACE	2010-02-22 13:46:30 UTC (rev 766)
@@ -1 +1,2 @@
+useDynLib( RcppArmadillo)
 

Modified: pkg/RcppArmadillo/configure
===================================================================
--- pkg/RcppArmadillo/configure	2010-02-22 10:23:45 UTC (rev 765)
+++ pkg/RcppArmadillo/configure	2010-02-22 13:46:30 UTC (rev 766)
@@ -4464,7 +4464,7 @@
 
 ARMA_HAS_CUBE="$arma_version070"
 
-ac_config_files="$ac_config_files inst/include/RcppArmadilloDefines.h"
+ac_config_files="$ac_config_files src/Makevars inst/include/RcppArmadilloDefines.h"
 
 cat >confcache <<\_ACEOF
 # This file is a shell script that caches the results of configure
@@ -5074,6 +5074,7 @@
 for ac_config_target in $ac_config_targets
 do
   case $ac_config_target in
+    "src/Makevars") CONFIG_FILES="$CONFIG_FILES src/Makevars" ;;
     "inst/include/RcppArmadilloDefines.h") CONFIG_FILES="$CONFIG_FILES inst/include/RcppArmadilloDefines.h" ;;
 
   *) { { $as_echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5

Modified: pkg/RcppArmadillo/configure.in
===================================================================
--- pkg/RcppArmadillo/configure.in	2010-02-22 10:23:45 UTC (rev 765)
+++ pkg/RcppArmadillo/configure.in	2010-02-22 13:46:30 UTC (rev 766)
@@ -89,6 +89,6 @@
 AC_SUBST([PKG_CPPFLAGS],["${PKG_CPPFLAGS} $rcpp_cxxflags"])
 AC_SUBST([PKG_LIBS],["${PKG_LIBS} $rcpp_ldflags"])
 AC_SUBST([ARMA_HAS_CUBE],["$arma_version070"])
-AC_CONFIG_FILES([inst/include/RcppArmadilloDefines.h])
+AC_CONFIG_FILES([src/Makevars inst/include/RcppArmadilloDefines.h])
 AC_OUTPUT
 echo "Completed configuration and ready to build."

Added: pkg/RcppArmadillo/inst/unitTests/runTests.R
===================================================================
--- pkg/RcppArmadillo/inst/unitTests/runTests.R	                        (rev 0)
+++ pkg/RcppArmadillo/inst/unitTests/runTests.R	2010-02-22 13:46:30 UTC (rev 766)
@@ -0,0 +1,88 @@
+pkg <- "RcppArmadillo"
+
+if(require("RUnit", quietly = TRUE)) {
+
+    is_local <- function(){
+    	if( exists( "argv", globalenv() ) && "--local" %in% argv ) return(TRUE)
+    	if( "--local" %in% commandArgs(TRUE) ) return(TRUE)
+    	FALSE
+    }
+    if( is_local() ) path <- getwd()
+    
+    library(package=pkg, character.only = TRUE)
+    if(!(exists("path") && file.exists(path)))
+        path <- system.file("unitTests", package = pkg)
+
+    ## --- Testing ---
+
+    ## Define tests
+    testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), dirs = path)
+
+    if(interactive()) {
+        cat("Now have RUnit Test Suite 'testSuite' for package '", pkg,
+            "' :\n", sep='')
+        str(testSuite)
+        cat('', "Consider doing",
+            "\t  tests <- runTestSuite(testSuite)", "\nand later",
+            "\t  printTextProtocol(tests)", '', sep="\n")
+    } else { ## run from shell / Rscript / R CMD Batch / ...
+        ## Run
+        tests <- runTestSuite(testSuite)
+        
+        output <- NULL
+        
+        process_args <- function(argv){
+        	if( !is.null(argv) && length(argv) > 0 ){
+        		rx <- "^--output=(.*)$"
+        		g  <- grep( rx, argv, value = TRUE )
+        		if( length(g) ){
+        			sub( rx, "\\1", g[1L] )
+        		}
+        	}
+        }
+        
+        # give a chance to the user to customize where he/she wants 
+        # the unit tests results to be stored with the --output= command 
+        # line argument
+        if( exists( "argv",  globalenv() ) ){
+        	# littler
+        	output <- process_args(argv)
+        } else {
+        	# Rscript
+        	output <- process_args(commandArgs(TRUE))
+        }
+        
+        # if it did not work, try to use /tmp
+        if( is.null(output) ){
+        	if( file.exists( "/tmp" ) ){
+        		output <- "/tmp"
+        	} else{
+        		output <- getwd()
+        	}
+        }
+        
+        ## Print results
+        output.txt  <- file.path( output, sprintf("%s-unitTests.txt", pkg))
+        output.html <- file.path( output, sprintf("%s-unitTests.html", pkg))
+       
+        printTextProtocol(tests, fileName=output.txt)
+        message( sprintf( "saving txt unit test report to '%s'", output.txt ) )
+        
+        ## Print HTML version to a file
+        ## printHTMLProtocol has problems on Mac OS X
+        if (Sys.info()["sysname"] != "Darwin"){
+        	message( sprintf( "saving html unit test report to '%s'", output.html ) )
+        	printHTMLProtocol(tests, fileName=output.html)
+        }
+
+        ##  stop() if there are any failures i.e. FALSE to unit test.
+        ## This will cause R CMD check to return error and stop
+        if(getErrors(tests)$nFail > 0) {
+            stop("one of the unit tests failed")
+        }
+    }
+} else {
+    cat("R package 'RUnit' cannot be loaded -- no unit tests run\n",
+    "for package", pkg,"\n")
+}
+

Modified: pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R
===================================================================
--- pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R	2010-02-22 10:23:45 UTC (rev 765)
+++ pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R	2010-02-22 13:46:30 UTC (rev 766)
@@ -17,170 +17,16 @@
 # 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( inline ) )
-}
-
 test.wrap.R <- function(){
-	
-src <- '
-	using namespace Rcpp ;
-	using namespace arma ;
-	
-	List output(4); 
-	List matrices(4) ;
-	List rows(2) ;
-	List cols(2) ;
-	
-	imat x1 = eye<imat>( 3,3 ) ;
-	x1.swap_rows(0,1)  ;
-	matrices[0] = x1 ;
-	
-	mat x2 = eye<mat>( 3,3 ) ;
-	x2.swap_rows(0,1)  ;
-	matrices[1] = x2 ;
-	
-	fmat x3 = eye<fmat>( 3, 3 );
-	x3.swap_rows(0,1)  ;
-	matrices[2] = x3 ;
-	
-	umat x4 = eye<umat>( 3, 3 );
-	x4.swap_rows(0,1)  ;
-	matrices[3] = x4 ;
-	
-	colvec r1 = zeros<mat>(5,1);
-	cols[0] = r1  ;
-	
-	fcolvec r2 = zeros<fmat>(5,1);
-	cols[1] = r2  ;
-	
-	rowvec c1 = zeros<mat>(1,5);
-	rows[0] = c1  ;
-	
-	frowvec c2 = zeros<fmat>(1,5);
-	rows[1] = c2  ;
-	
-	std::vector<std::string> names(4) ;
-	names[0] = "Mat<int>" ;
-	names[1] = "Mat<double>" ;
-	names[2] = "Mat<float>" ;
-	names[3] = "Mat<unsigned int>" ;
-	matrices.names() = names ;
-	
-	names.resize(2) ;
-	names[0] = "Row<double>" ;
-	names[1] = "Row<float>" ;
-	rows.names() = names ;
-	
-	names[0] = "Col<double>" ;
-	names[1] = "Col<float>" ;
-	cols.names() = names ;
-	
-	
-	List fields ;
-	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 ;
-	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 ;
-	field<colvec> f3(2,2) ;
-	f3(0,0) = zeros<mat>(5,1) ;
-	f3(1,0) = zeros<mat>(4,1) ;
-	f3(0,1) = zeros<mat>(3,1) ;
-	f3(1,1) = zeros<mat>(2,1) ;
-	fields["field<colvec>"] = f3 ;
-	
-	output[0] = matrices;
-	output[1] = rows ;
-	output[2] = cols ;
-	output[3] = fields ;
-	
-	names[0] = "matrices : Mat<T>" ; 
-	names[1] = "rows : Row<T>" ;
-	names.push_back( "columns : Col<T>" );
-	names.push_back( "fields  : field<T>" );
-	output.names() = names ;
-	
-	return output ;'
-	
-	funx <- cfunction( signature(), src, 
-		cxxargs = RcppArmadillo:::RcppArmadilloCxxFlags(), 
-		libargs = RcppArmadillo:::RcppArmadilloLdFlags(), 
-		Rcpp = FALSE, 
-		includes = c("#include <RcppArmadillo.h>", "using namespace Rcpp; ", "using namespace arma;") )
-	
+	res <- .Call( "RcppArmadillo_wrap" )
 }
 
-
-test.as.Mat <- function(){	
-	
-src <- '	
-	using namespace Rcpp ;
-	
-	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(4) ;
-	res[0] = arma::accu( m1 ) ;
-	res[1] = arma::accu( m2 ) ;
-	res[2] = arma::accu( m3 ) ;
-	res[3] = arma::accu( m4 ) ;
-	
-	return res ;
-' 
-
+test.as.Mat <- function(){
 }
 
-
 test.as.Col <- function(){
-	
-src <- '
-	using namespace Rcpp ;
-	
-	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(4) ;
-	res[0] = arma::accu( m1 ) ;
-	res[1] = arma::accu( m2 ) ;
-	res[2] = arma::accu( m3 ) ;
-	res[3] = arma::accu( m4 ) ;
-	
-	return res ;
-	'
 }
 
 test.as.Row <- function(){
-	
-src <- '
-	using namespace Rcpp ;
-	
-	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(4) ;
-	res[0] = arma::accu( m1 ) ;
-	res[1] = arma::accu( m2 ) ;
-	res[2] = arma::accu( m3 ) ;
-	res[3] = arma::accu( m4 ) ;
-	
-	return res ;
-	'
 }
 

Added: pkg/RcppArmadillo/src/Makevars
===================================================================
--- pkg/RcppArmadillo/src/Makevars	                        (rev 0)
+++ pkg/RcppArmadillo/src/Makevars	2010-02-22 13:46:30 UTC (rev 766)
@@ -0,0 +1,8 @@
+## -*- mode: makefile; -*-
+
+## Configure tells us about locations for
+## both Rcpp (ie libRcpp.so and Rcpp.h) and 
+## Armadillo headers and library via the variables
+PKG_CPPFLAGS =		 -I/usr/local/lib/R/library/Rcpp/lib -I. -I../inst/include
+PKG_LIBS =		 -L/usr/local/lib/R/library/Rcpp/lib -lRcpp -Wl,-rpath,/usr/local/lib/R/library/Rcpp/lib
+

Added: pkg/RcppArmadillo/src/Makevars.in
===================================================================
--- pkg/RcppArmadillo/src/Makevars.in	                        (rev 0)
+++ pkg/RcppArmadillo/src/Makevars.in	2010-02-22 13:46:30 UTC (rev 766)
@@ -0,0 +1,8 @@
+## -*- mode: makefile; -*-
+
+## Configure tells us about locations for
+## both Rcpp (ie libRcpp.so and Rcpp.h) and 
+## Armadillo headers and library via the variables
+PKG_CPPFLAGS =		@PKG_CPPFLAGS@ -I. -I../inst/include
+PKG_LIBS =		@PKG_LIBS@
+

Added: pkg/RcppArmadillo/src/Makevars.win
===================================================================
--- pkg/RcppArmadillo/src/Makevars.win	                        (rev 0)
+++ pkg/RcppArmadillo/src/Makevars.win	2010-02-22 13:46:30 UTC (rev 766)
@@ -0,0 +1,8 @@
+## This assume that we can call Rscript to ask Rcpp about its locations
+## Use the R_HOME indirection to support installations of multiple R version
+PKG_LIBS = `$(R_HOME)/bin/Rscript --vanilla -e 'Rcpp:::LdFlags()'`
+PKG_CPPFLAGS = `$(R_HOME)/bin/Rscript --vanilla -e 'Rcpp:::CxxFlags()'`
+
+INCLUDE_DIR=../inst/include
+PKG_CPPFLAGS += $(INCLUDE_DIR)
+

Added: pkg/RcppArmadillo/src/RcppArmadillo.cpp
===================================================================
--- pkg/RcppArmadillo/src/RcppArmadillo.cpp	                        (rev 0)
+++ pkg/RcppArmadillo/src/RcppArmadillo.cpp	2010-02-22 13:46:30 UTC (rev 766)
@@ -0,0 +1,140 @@
+#include <RcppArmadillo.h>
+using namespace Rcpp ;
+using namespace arma ;
+	
+extern "C" SEXP RcppArmadillo_wrap(){
+	
+	List output(4); 
+	List matrices(4) ;
+	List rows(2) ;
+	List cols(2) ;
+	
+	imat x1 = eye<imat>( 3,3 ) ;
+	// x1.swap_rows(0,1)  ;
+	matrices[0] = x1 ;
+	
+	mat x2 = eye<mat>( 3,3 ) ;
+	// x2.swap_rows(0,1)  ;
+	matrices[1] = x2 ;
+	
+	fmat x3 = eye<fmat>( 3, 3 );
+	// x3.swap_rows(0,1)  ;
+	matrices[2] = x3 ;
+	
+	umat x4 = eye<umat>( 3, 3 );
+	// x4.swap_rows(0,1)  ;
+	matrices[3] = x4 ;
+	
+	colvec r1 = zeros<mat>(5,1);
+	cols[0] = r1  ;
+	
+	fcolvec r2 = zeros<fmat>(5,1);
+	cols[1] = r2  ;
+	
+	rowvec c1 = zeros<mat>(1,5);
+	rows[0] = c1  ;
+	
+	frowvec c2 = zeros<fmat>(1,5);
+	rows[1] = c2  ;
+	
+	std::vector<std::string> names(4) ;
+	names[0] = "Mat<int>" ;
+	names[1] = "Mat<double>" ;
+	names[2] = "Mat<float>" ;
+	names[3] = "Mat<unsigned int>" ;
+	matrices.names() = names ;
+	
+	names.resize(2) ;
+	names[0] = "Row<double>" ;
+	names[1] = "Row<float>" ;
+	rows.names() = names ;
+	
+	names[0] = "Col<double>" ;
+	names[1] = "Col<float>" ;
+	cols.names() = names ;
+	
+	List fields ;
+	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 ;
+	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 ;
+	field<colvec> f3(2,2) ;
+	f3(0,0) = zeros<mat>(5,1) ;
+	f3(1,0) = zeros<mat>(4,1) ;
+	f3(0,1) = zeros<mat>(3,1) ;
+	f3(1,1) = zeros<mat>(2,1) ;
+	fields["field<colvec>"] = f3 ;
+	
+	output[0] = matrices;
+	output[1] = rows ;
+	output[2] = cols ;
+	output[3] = fields ;
+	
+	names[0] = "matrices : Mat<T>" ; 
+	names[1] = "rows : Row<T>" ;
+	names.push_back( "columns : Col<T>" );
+	names.push_back( "fields  : field<T>" );
+	output.names() = names ;
+	
+	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(4) ;
+	res[0] = arma::accu( m1 ) ;
+	res[1] = arma::accu( m2 ) ;
+	res[2] = arma::accu( m3 ) ;
+	res[3] = 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(4) ;
+	res[0] = arma::accu( m1 ) ;
+	res[1] = arma::accu( m2 ) ;
+	res[2] = arma::accu( m3 ) ;
+	res[3] = 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(4) ;
+	res[0] = arma::accu( m1 ) ;
+	res[1] = arma::accu( m2 ) ;
+	res[2] = arma::accu( m3 ) ;
+	res[3] = arma::accu( m4 ) ;
+	
+	return res ;
+	
+}
+



More information about the Rcpp-commits mailing list