[Rcpp-commits] r2613 - in pkg/RcppGSL: R inst/unitTests src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Nov 30 12:29:03 CET 2010


Author: romain
Date: 2010-11-30 12:29:03 +0100 (Tue, 30 Nov 2010)
New Revision: 2613

Modified:
   pkg/RcppGSL/R/inline.R
   pkg/RcppGSL/inst/unitTests/runit.gsl.R
   pkg/RcppGSL/src/RcppGSL.cpp
Log:
moving unit tests out of src

Modified: pkg/RcppGSL/R/inline.R
===================================================================
--- pkg/RcppGSL/R/inline.R	2010-11-30 11:02:34 UTC (rev 2612)
+++ pkg/RcppGSL/R/inline.R	2010-11-30 11:29:03 UTC (rev 2613)
@@ -21,18 +21,18 @@
     LIB_GSL <- Sys.getenv("LIB_GSL")
     gsl_cflags <- sprintf( "-I%s/include", LIB_GSL )
     gsl_libs   <- sprintf( "-L%s/lib -lgsl -lgslcblas", LIB_GSL )
-    known_flags <- TRUE
+    know_flags <- TRUE
 } else {             
     gsl_cflags <- ""
     gsl_libs <- ""
-    known_flags <- FALSE    
+    know_flags <- FALSE    
 }
 
 get_gsl_flags <- function(){
     td <- tempfile()
     here <- getwd()
     dir.create( td ); on.exit( {
-        setwd( here )
+        setwd( here )         
         unlink( td, recursive = TRUE )
     } )
     

Modified: pkg/RcppGSL/inst/unitTests/runit.gsl.R
===================================================================
--- pkg/RcppGSL/inst/unitTests/runit.gsl.R	2010-11-30 11:02:34 UTC (rev 2612)
+++ pkg/RcppGSL/inst/unitTests/runit.gsl.R	2010-11-30 11:29:03 UTC (rev 2613)
@@ -18,8 +18,387 @@
 # You should have received a copy of the GNU General Public License
 # along with RcppGSL.  If not, see <http://www.gnu.org/licenses/>.
 
+.setUp <- function(){
+    require( inline )
+    tests <- ".rcppgsl.tests"
+    if( ! exists( tests, globalenv() ) ){
+        f <- list( 
+            test_gsl_vector_wrapper = list( 
+                signature(),
+                '
+    RcppGSL::vector<double> x_double( 10 );
+	RcppGSL::vector<float> x_float( 10 );
+	RcppGSL::vector<int> x_int( 10 ) ; 
+	RcppGSL::vector<long> x_long( 10 ) ; 
+	RcppGSL::vector<char> x_char( 10 ) ; 
+	RcppGSL::vector<long double> x_long_double( 10 ) ;
+	RcppGSL::vector<short> x_short( 10 ) ; 
+	RcppGSL::vector<unsigned char> x_uchar( 10 ) ;
+	RcppGSL::vector<unsigned int> x_uint( 10 ) ; 
+	RcppGSL::vector<unsigned short> x_ushort( 10 ) ;
+	RcppGSL::vector<unsigned long> x_ulong( 10 ) ;
+	RcppGSL::vector<gsl_complex> x_complex( 10 ) ; 
+	RcppGSL::vector<gsl_complex_float> x_complex_float( 10 ) ;
+	RcppGSL::vector<gsl_complex_long_double> x_complex_long_double( 10 ) ;
+	
+	List res = List::create( 
+		_["gsl_vector"] = x_double, 
+		_["gsl_vector_float"] = x_float, 
+		_["gsl_vector_int"] = x_int, 
+		_["gsl_vector_long"] = x_long, 
+		_["gsl_vector_char"] = x_char, 
+		_["gsl_vector_complex"] = x_complex,
+		_["gsl_vector_complex_float"] = x_complex_float, 
+		_["gsl_vector_complex_long_double"] = x_complex_long_double, 
+		_["gsl_vector_long_double"] = x_long_double, 
+		_["gsl_vector_short"] = x_short, 
+		_["gsl_vector_uchar"] = x_uchar, 
+		_["gsl_vector_uint"] = x_uint,                             
+		_["gsl_vector_ushort"] = x_ushort, 
+		_["gsl_vector_ulong"] = x_ulong
+		) ;
+	
+	x_double.free();
+	x_float.free();
+	x_int.free() ; 
+	x_long.free() ; 
+	x_char.free() ; 
+	x_long_double.free() ;
+	x_short.free() ; 
+	x_uchar.free() ;
+	x_uint.free() ; 
+	x_ushort.free() ;
+	x_ulong.free() ;
+	x_complex.free() ; 
+	x_complex_float.free() ;
+	x_complex_long_double.free() ;
+	
+	return res ;
+
+                '
+            ), 
+            test_gsl_vector = list( 
+                signature(), 
+                '
+	gsl_vector * x_double = gsl_vector_calloc (10);
+	gsl_vector_float * x_float = gsl_vector_float_calloc(10) ;
+	gsl_vector_int * x_int  = gsl_vector_int_calloc(10) ;
+	gsl_vector_long * x_long  = gsl_vector_long_calloc(10) ;
+	gsl_vector_char * x_char  = gsl_vector_char_calloc(10) ;
+	gsl_vector_complex * x_complex  = gsl_vector_complex_calloc(10) ;
+	gsl_vector_complex_float * x_complex_float  = gsl_vector_complex_float_calloc(10) ;
+	gsl_vector_complex_long_double * x_complex_long_double  = gsl_vector_complex_long_double_calloc(10) ;
+	gsl_vector_long_double * x_long_double  = gsl_vector_long_double_calloc(10) ;
+	gsl_vector_short * x_short  = gsl_vector_short_calloc(10) ;
+	gsl_vector_uchar * x_uchar  = gsl_vector_uchar_calloc(10) ;
+	gsl_vector_uint * x_uint  = gsl_vector_uint_calloc(10) ;
+	gsl_vector_ushort * x_ushort  = gsl_vector_ushort_calloc(10) ;
+	gsl_vector_ulong * x_ulong  = gsl_vector_ulong_calloc(10) ;
+	
+	/* create an R list containing copies of gsl data */
+	List res = List::create( 
+		_["gsl_vector"] = *x_double, 
+		_["gsl_vector_float"] = *x_float, 
+		_["gsl_vector_int"] = *x_int, 
+		_["gsl_vector_long"] = *x_long, 
+		_["gsl_vector_char"] = *x_char, 
+		_["gsl_vector_complex"] = *x_complex,
+		_["gsl_vector_complex_float"] = *x_complex_float, 
+		_["gsl_vector_complex_long_double"] = *x_complex_long_double, 
+		_["gsl_vector_long_double"] = *x_long_double, 
+		_["gsl_vector_short"] = *x_short, 
+		_["gsl_vector_uchar"] = *x_uchar, 
+		_["gsl_vector_uint"] = *x_uint, 
+		_["gsl_vector_ushort"] = *x_ushort, 
+		_["gsl_vector_ulong"] = *x_ulong
+		) ;
+	
+	/* cleanup gsl data */
+	gsl_vector_free(x_double);
+	gsl_vector_float_free( x_float);
+	gsl_vector_int_free( x_int );
+	gsl_vector_long_free( x_long );
+	gsl_vector_char_free( x_char );
+	gsl_vector_complex_free( x_complex );
+	gsl_vector_complex_float_free( x_complex_float );
+	gsl_vector_complex_long_double_free( x_complex_long_double );
+	gsl_vector_long_double_free( x_long_double );
+	gsl_vector_short_free( x_short );
+	gsl_vector_uchar_free( x_uchar );
+	gsl_vector_uint_free( x_uint );
+	gsl_vector_ushort_free( x_ushort );
+	gsl_vector_ulong_free( x_ulong );
+	
+	return res ;
+                
+                '
+            ), 
+            test_gsl_matrix = list( 
+                signature(), 
+                '
+	gsl_matrix * x_double                                   = gsl_matrix_alloc(5, 2);                      gsl_matrix_set_identity( x_double ) ;
+	gsl_matrix_float * x_float                              = gsl_matrix_float_alloc(5,2) ;                gsl_matrix_float_set_identity( x_float ) ;
+	gsl_matrix_int * x_int                                  = gsl_matrix_int_alloc(5,2) ;                  gsl_matrix_int_set_identity( x_int ) ;
+	gsl_matrix_long * x_long                                = gsl_matrix_long_alloc(5,2) ;                 gsl_matrix_long_set_identity( x_long ) ;
+	gsl_matrix_char * x_char                                = gsl_matrix_char_alloc(5,2) ;                 gsl_matrix_char_set_identity( x_char ) ;
+	gsl_matrix_complex * x_complex                          = gsl_matrix_complex_alloc(5,2) ;              gsl_matrix_complex_set_identity( x_complex ) ;
+	gsl_matrix_complex_float * x_complex_float              = gsl_matrix_complex_float_alloc(5,2) ;        gsl_matrix_complex_float_set_identity( x_complex_float ) ;
+	gsl_matrix_complex_long_double * x_complex_long_double  = gsl_matrix_complex_long_double_alloc(5,2) ;  gsl_matrix_complex_long_double_set_identity( x_complex_long_double ) ;
+	gsl_matrix_long_double * x_long_double                  = gsl_matrix_long_double_alloc(5,2) ;          gsl_matrix_long_double_set_identity( x_long_double ) ;
+	gsl_matrix_short * x_short                              = gsl_matrix_short_alloc(5,2) ;                gsl_matrix_short_set_identity( x_short ) ;
+	gsl_matrix_uchar * x_uchar                              = gsl_matrix_uchar_alloc(5,2) ;                gsl_matrix_uchar_set_identity( x_uchar ) ;
+	gsl_matrix_uint * x_uint                                = gsl_matrix_uint_alloc(5,2) ;                 gsl_matrix_uint_set_identity( x_uint) ;
+	gsl_matrix_ushort * x_ushort                            = gsl_matrix_ushort_alloc(5,2) ;               gsl_matrix_ushort_set_identity( x_ushort ) ;
+	gsl_matrix_ulong * x_ulong                              = gsl_matrix_ulong_alloc(5,2) ;                gsl_matrix_ulong_set_identity( x_ulong ) ;
+	
+	List res = List::create( 
+		_["gsl_matrix"] = *x_double , 
+		_["gsl_matrix_float"] = *x_float, 
+		_["gsl_matrix_int"] = *x_int, 
+		_["gsl_matrix_long"] = *x_long, 
+		_["gsl_matrix_char"] = *x_char, 
+		_["gsl_matrix_complex"] = *x_complex,
+		_["gsl_matrix_complex_float"] = *x_complex_float, 
+		_["gsl_matrix_complex_long_double"] = *x_complex_long_double, 
+		_["gsl_matrix_long_double"] = *x_long_double, 
+		_["gsl_matrix_short"] = *x_short, 
+		_["gsl_matrix_uchar"] = *x_uchar, 
+		_["gsl_matrix_uint"] = *x_uint, 
+		_["gsl_matrix_ushort"] = *x_ushort, 
+		_["gsl_matrix_ulong"] = *x_ulong
+		) ;
+	
+	gsl_matrix_free( x_double );
+	gsl_matrix_float_free( x_float);
+	gsl_matrix_int_free( x_int );
+	gsl_matrix_long_free( x_long );
+	gsl_matrix_char_free( x_char );
+	gsl_matrix_complex_free( x_complex );
+	gsl_matrix_complex_float_free( x_complex_float );
+	gsl_matrix_complex_long_double_free( x_complex_long_double );
+	gsl_matrix_long_double_free( x_long_double );
+	gsl_matrix_short_free( x_short );
+	gsl_matrix_uchar_free( x_uchar );
+	gsl_matrix_uint_free( x_uint );
+	gsl_matrix_ushort_free( x_ushort );
+	gsl_matrix_ulong_free( x_ulong );
+	
+	return res ;
+                
+                '
+            ), 
+            test_gsl_vector_view = list( 
+                signature(), 
+                '
+	int n = 10 ;
+	gsl_vector *v = gsl_vector_calloc (n);
+	for( int i=0 ; i<n; i++){
+		gsl_vector_set( v, i, i ) ;	
+	}
+	gsl_vector_view v_even = gsl_vector_subvector_with_stride(v, 0, 2, n/2);
+    gsl_vector_view v_odd  = gsl_vector_subvector_with_stride(v, 1, 2, n/2);
+    
+    List res = List::create( 
+    	_["even"] = v_even, 
+    	_["odd" ] = v_odd
+    	) ;
+    gsl_vector_free(v);
+	
+    return res ;
+                '
+            ), 
+            test_gsl_matrix_view = list( 
+                signature(), 
+                '
+	int nrow = 4 ;
+	int ncol = 6 ;
+	gsl_matrix *m = gsl_matrix_alloc(nrow, ncol);
+	int k =0 ;
+	for( int i=0 ; i<nrow; i++){
+		for( int j=0; j<ncol; j++, k++){
+			gsl_matrix_set( m, i, j, k ) ;
+		}
+	}
+	gsl_matrix_view x = gsl_matrix_submatrix(m, 2, 2, 2, 2 ) ;
+	
+	List res = List::create( 
+		_["full"] = *m, 
+		_["view"] = x
+		) ;
+	gsl_matrix_free(m);
+	
+	return res ;
+                
+                '
+                ), 
+                test_gsl_vector_input = list( 
+                    signature( vec_ = "numeric" ), 
+                    '
+	RcppGSL::vector<double> vec = as< RcppGSL::vector<double> >(vec_) ;
+    int n = vec->size ;
+	double res = 0.0 ;
+	for( int i=0; i<n; i++){
+		res += gsl_vector_get( vec, i ) ;
+	}
+	vec.free() ;
+	return wrap( res ) ;
+                    
+                    '
+                ), 
+                test_gsl_matrix_input = list( 
+                    signature( mat_ = "matrix" ), 
+                    '
+    RcppGSL::matrix<double> mat = as< RcppGSL::matrix<double> >( mat_) ;
+	int nr = mat->size1 ;
+	
+	double res = 0.0 ;
+	for( int i=0; i<nr; i++){
+		res += mat( i, 0 ) ;
+	}   
+	mat.free() ;
+	return wrap(res) ;
+                    '
+                ), 
+                test_gsl_vector_conv = list( 
+                    signature(), 
+                    '
+	RcppGSL::vector<int> vec(10) ;
+	for( int i=0; i<10; i++){
+		gsl_vector_int_set( vec, i, i ) ;	
+	}
+	Rcpp::IntegerVector x ; 
+	x = vec ;
+	return x ;
+                    '
+                ), 
+                test_gsl_vector_indexing = list( 
+                    signature( vec_ = "numeric" ), 
+                    '
+    RcppGSL::vector<double> vec = as< RcppGSL::vector<double> >(vec_) ;
+	for( size_t i=0; i< vec.size(); i++){
+		vec[i] = vec[i] + 1.0 ;
+	}
+	NumericVector res = Rcpp::wrap( vec ) ;
+	vec.free() ;
+	return res ;
+                    '
+                ), 
+                test_gsl_vector_iterating = list( 
+                    signature( vec_ = "numeric" ), 
+                    '
+    RcppGSL::vector<double> vec = as< RcppGSL::vector<double> >(vec_) ;
+	double res= std::accumulate( vec.begin(), vec.end(), 0.0 ); 
+	vec.free() ;
+	return wrap( res ) ;
+                    
+                    '
+                ), 
+                test_gsl_matrix_indexing = list( 
+                    signature( mat_ = "matrix" ), 
+                    '
+    RcppGSL::matrix<double> mat= as< RcppGSL::matrix<double> >( mat_ ) ;
+	for( size_t i=0; i< mat.nrow(); i++){
+		for( size_t j=0; j< mat.ncol(); j++){
+			mat(i,j) = mat(i,j) + 1.0 ;
+		}
+	}
+	Rcpp::NumericMatrix res = Rcpp::wrap(mat) ;
+	mat.free() ;
+	return res ;
+                    '
+                ), 
+                test_gsl_vector_view_wrapper = list( 
+                    signature(), 
+                    '
+	int n = 10 ;
+	RcppGSL::vector<double> vec( 10 ) ;
+	for( int i=0 ; i<n; i++){
+		vec[i] = i ; 
+	}
+	RcppGSL::vector_view<double> v_even = gsl_vector_subvector_with_stride(vec, 0, 2, n/2);
+    RcppGSL::vector_view<double> v_odd  = gsl_vector_subvector_with_stride(vec, 1, 2, n/2);
+    
+    List res = List::create( 
+    	_["even"] = v_even, 
+    	_["odd" ] = v_odd
+    	) ;
+    vec.free() ;
+    
+    return res ;
+                    
+                    ' 
+                ), 
+                test_gsl_matrix_view_wrapper = list( 
+                    signature(), 
+                    '
+	int nrow = 4 ;
+	int ncol = 6 ;
+	RcppGSL::matrix<double> m(nrow, ncol);
+	int k =0 ;
+	for( int i=0 ; i<nrow; i++){
+		for( int j=0; j<ncol; j++, k++){
+			m(i, j) = k ;
+		}
+	}
+	RcppGSL::matrix_view<double> x = gsl_matrix_submatrix(m, 2, 2, 2, 2 ) ;
+	
+	List res = List::create( 
+		_["full"] = m, 
+		_["view"] = x
+		) ;
+	m.free() ;
+	
+	return res ;
+                    
+                    '
+                ), 
+                test_gsl_vector_view_iterating = list( 
+                    signature( vec_ = "numeric" ), 
+                    '
+	RcppGSL::vector<double> vec = as< RcppGSL::vector<double> >(vec_) ;
+	int n = vec.size() ;
+	RcppGSL::vector_view<double> v_even = gsl_vector_subvector_with_stride(vec, 0, 2, n/2);
+    double res = std::accumulate( v_even.begin(), v_even.end(), 0.0 );
+    return wrap( res ) ;
+                    
+                    '
+                ), 
+                test_gsl_matrix_view_indexing = list( 
+                    signature(), 
+                    '
+	int nr = 10 ;
+	int nc = 10 ;
+	RcppGSL::matrix<double> mat( nr, nc ) ;
+	int k = 0;
+	for( size_t i=0; i< mat.nrow(); i++){
+		for( size_t j=0; j< mat.ncol(); j++, k++){
+			mat(i,j) = k ;
+		}
+	}
+	RcppGSL::matrix_view<double> x = gsl_matrix_submatrix(mat, 2, 2, 2, 2 ) ;
+	double res = 0.0 ;
+	for( size_t i=0; i<x.nrow(); i++){
+		for( size_t j=0; j<x.ncol(); j++){
+			res += x(i,j) ;
+		}
+	}
+	mat.free() ;
+	return wrap( res ) ;
+                    
+                    '
+                )
+        )
+        signatures <- lapply(f, "[[", 1L)
+        bodies <- lapply(f, "[[", 2L)
+        fun <- cxxfunction( signatures, bodies, plugin = "RcppGSL")
+        getDynLib( fun ) # just forcing loading the dll now
+        assign( tests, fun, globalenv() )
+    }
+}
+
 test.gsl.vector.wrappers <- function(){
-	res <- .Call( "test_gsl_vector_wrapper", PACKAGE = "RcppGSL" )
+	fx <- .rcppgsl.tests$test_gsl_vector_wrapper
+	res <- fx()
 	checkEquals( res, 
 		list( 
 			"gsl_vector" = numeric(10), 
@@ -41,8 +420,9 @@
 }
 
 test.gsl.vector <- function(){
-	res <- .Call( "test_gsl_vector", PACKAGE = "RcppGSL" )
-	checkEquals( res,
+    fx <- .rcppgsl.tests$test_gsl_vector
+    res <- fx()
+    checkEquals( res,
 		list(
 			"gsl_vector" = numeric(10),
 			"gsl_vector_float" = numeric(10),
@@ -71,7 +451,8 @@
 		dim( x )  <- c(5,2)
 		x
 	}
-	res <- .Call( "test_gsl_matrix", PACKAGE = "RcppGSL" )
+	 fx <- .rcppgsl.tests$test_gsl_matrix
+	 res <- fx()
 	checkEquals( res,
 		list(
 			"gsl_matrix"                     = helper( numeric ),
@@ -94,68 +475,80 @@
 }
 
 test.gsl.vector.view <- function(){
-	res <- .Call( "test_gsl_vector_view", PACKAGE = "RcppGSL" )
+    fx <- .rcppgsl.tests$test_gsl_vector_view
+    res <- fx()
 	checkEquals( res,
 		list( even = 2.0 * 0:4, odd = 2.0 * 0:4 + 1.0 ),
 		msg = "wrap( gsl.vector.view )" )
-		
-	res <- .Call( "test_gsl_vector_view_wrapper", PACKAGE = "RcppGSL" )
-	checkEquals( res,
+	
+	 fx <- .rcppgsl.tests$test_gsl_vector_view_wrapper
+	 res <- fx()
+	 checkEquals( res,
 		list( even = 2.0 * 0:4, odd = 2.0 * 0:4 + 1.0 ),
 		msg = "wrap( gsl.vector.view.wrapper )" )
 }
 
 test.gsl.matrix.view <- function(){
-	res <- .Call( "test_gsl_matrix_view", PACKAGE = "RcppGSL" )
+	 fx <- .rcppgsl.tests$test_gsl_matrix_view
+	 res <- fx()
 	checkEquals( res$full[3:4, 3:4], res$view, msg = "wrap(gsl.matrix.view)" )
 	
-	res <- .Call( "test_gsl_matrix_view_wrapper", PACKAGE = "RcppGSL" )
+	 fx <- .rcppgsl.tests$test_gsl_matrix_view_wrapper
+	 res <- fx()
 	checkEquals( res$full[3:4, 3:4], res$view, msg = "wrap(gsl.matrix.view.wrapper)" )
 	
 }
       
 test.gsl.vector.input.SEXP <- function(){
 	x <- rnorm( 10 )
-	res <- .Call( "test_gsl_vector_input", x, PACKAGE = "RcppGSL" )
+	 fx <- .rcppgsl.tests$test_gsl_vector_input
+	 res <- fx(x)
 	checkEquals( res, sum(x), msg = "RcppGSL::vector<double>(SEXP)" )
 }
 
 test.gsl.matrix.input.SEXP <- function(){
 	x <- matrix( rnorm(20), nc = 4 )
-	res <- .Call( "test_gsl_matrix_input", x, PACKAGE = "RcppGSL" )
+	 fx <- .rcppgsl.tests$test_gsl_matrix_input
+	 res <- fx( x)
 	checkEquals( res, sum(x[,1]), msg = "RcppGSL::matrix<double>(SEXP)" )
 }
 
 test.gsl.RcppGSL.vector <- function(){
-	res <- .Call( "test_gsl_vector_conv", PACKAGE = "RcppGSL" )
+	 fx <- .rcppgsl.tests$test_gsl_vector_conv
+	 res <- fx()
 	checkEquals( res, 0:9, msg = "RcppGSL::vector<int> -> IntegerVector" )
 }
 
 test.gsl.RcppGSL.vector.indexing <- function(){
-	res <- .Call( "test_gsl_vector_indexing", seq(0.5, 10.5), PACKAGE = "RcppGSL" )
+	 fx <- .rcppgsl.tests$test_gsl_vector_indexing
+	 res <- fx( seq(0.5, 10.5) )
 	checkEquals( res, seq( 1.5, 11.5 ) )
 }
 
 test.gsl.RcppGSL.vector.iterating <- function(){
 	x   <-  seq(0.5, 10.5)
-	res <- .Call( "test_gsl_vector_iterating", x , PACKAGE = "RcppGSL" )
+	 fx <- .rcppgsl.tests$test_gsl_vector_iterating
+	 res <- fx(x)
 	checkEquals( res, sum(x) )
 }
 
 test.gsl.RcppGSL.matrix.indexing <- function(){
 	m   <- matrix( 1:16+.5, nr = 4 )
-	res <- .Call( "test_gsl_matrix_indexing", m , PACKAGE = "RcppGSL" )
+	 fx <- .rcppgsl.tests$test_gsl_matrix_indexing
+	 res <- fx(m)
 	checkEquals( res, m+1 )
 }
 
 test.gsl.RcppGSL.vector.view.iterating <- function(){
 	x   <-  seq(1.5, 10.5)
-	res <- .Call( "test_gsl_vector_view_iterating", x, PACKAGE = "RcppGSL" )
+	 fx <- .rcppgsl.tests$test_gsl_vector_view_iterating
+	 res <- fx(x)
 	checkEquals( res, sum( x[ seq(1, length(x), by = 2 ) ] ) )
 }
 
 test.gsl.RcppGSL.matrix.view.indexing <- function(){
-	res <- .Call( "test_gsl_matrix_view_indexing", PACKAGE = "RcppGSL" )
+	 fx <- .rcppgsl.tests$test_gsl_matrix_view_indexing
+	 res <- fx()
 	checkEquals( res, 110.0 )
 }
 

Modified: pkg/RcppGSL/src/RcppGSL.cpp
===================================================================
--- pkg/RcppGSL/src/RcppGSL.cpp	2010-11-30 11:02:34 UTC (rev 2612)
+++ pkg/RcppGSL/src/RcppGSL.cpp	2010-11-30 11:29:03 UTC (rev 2613)
@@ -21,327 +21,6 @@
 
 #include <RcppGSL.h>
 
-using namespace Rcpp ;
-
-extern "C" SEXP test_gsl_vector_wrapper(){
-	RcppGSL::vector<double> x_double( 10 );
-	RcppGSL::vector<float> x_float( 10 );
-	RcppGSL::vector<int> x_int( 10 ) ; 
-	RcppGSL::vector<long> x_long( 10 ) ; 
-	RcppGSL::vector<char> x_char( 10 ) ; 
-	RcppGSL::vector<long double> x_long_double( 10 ) ;
-	RcppGSL::vector<short> x_short( 10 ) ; 
-	RcppGSL::vector<unsigned char> x_uchar( 10 ) ;
-	RcppGSL::vector<unsigned int> x_uint( 10 ) ; 
-	RcppGSL::vector<unsigned short> x_ushort( 10 ) ;
-	RcppGSL::vector<unsigned long> x_ulong( 10 ) ;
-	RcppGSL::vector<gsl_complex> x_complex( 10 ) ; 
-	RcppGSL::vector<gsl_complex_float> x_complex_float( 10 ) ;
-	RcppGSL::vector<gsl_complex_long_double> x_complex_long_double( 10 ) ;
-	
-	List res = List::create( 
-		_["gsl_vector"] = x_double, 
-		_["gsl_vector_float"] = x_float, 
-		_["gsl_vector_int"] = x_int, 
-		_["gsl_vector_long"] = x_long, 
-		_["gsl_vector_char"] = x_char, 
-		_["gsl_vector_complex"] = x_complex,
-		_["gsl_vector_complex_float"] = x_complex_float, 
-		_["gsl_vector_complex_long_double"] = x_complex_long_double, 
-		_["gsl_vector_long_double"] = x_long_double, 
-		_["gsl_vector_short"] = x_short, 
-		_["gsl_vector_uchar"] = x_uchar, 
-		_["gsl_vector_uint"] = x_uint,                             
-		_["gsl_vector_ushort"] = x_ushort, 
-		_["gsl_vector_ulong"] = x_ulong
-		) ;
-	
-	x_double.free();
-	x_float.free();
-	x_int.free() ; 
-	x_long.free() ; 
-	x_char.free() ; 
-	x_long_double.free() ;
-	x_short.free() ; 
-	x_uchar.free() ;
-	x_uint.free() ; 
-	x_ushort.free() ;
-	x_ulong.free() ;
-	x_complex.free() ; 
-	x_complex_float.free() ;
-	x_complex_long_double.free() ;
-	
-	return res ;
-}
-
-extern "C" SEXP test_gsl_vector(){
-	gsl_vector * x_double = gsl_vector_calloc (10);
-	gsl_vector_float * x_float = gsl_vector_float_calloc(10) ;
-	gsl_vector_int * x_int  = gsl_vector_int_calloc(10) ;
-	gsl_vector_long * x_long  = gsl_vector_long_calloc(10) ;
-	gsl_vector_char * x_char  = gsl_vector_char_calloc(10) ;
-	gsl_vector_complex * x_complex  = gsl_vector_complex_calloc(10) ;
-	gsl_vector_complex_float * x_complex_float  = gsl_vector_complex_float_calloc(10) ;
-	gsl_vector_complex_long_double * x_complex_long_double  = gsl_vector_complex_long_double_calloc(10) ;
-	gsl_vector_long_double * x_long_double  = gsl_vector_long_double_calloc(10) ;
-	gsl_vector_short * x_short  = gsl_vector_short_calloc(10) ;
-	gsl_vector_uchar * x_uchar  = gsl_vector_uchar_calloc(10) ;
-	gsl_vector_uint * x_uint  = gsl_vector_uint_calloc(10) ;
-	gsl_vector_ushort * x_ushort  = gsl_vector_ushort_calloc(10) ;
-	gsl_vector_ulong * x_ulong  = gsl_vector_ulong_calloc(10) ;
-	
-	/* create an R list containing copies of gsl data */
-	List res = List::create( 
-		_["gsl_vector"] = *x_double, 
-		_["gsl_vector_float"] = *x_float, 
-		_["gsl_vector_int"] = *x_int, 
-		_["gsl_vector_long"] = *x_long, 
-		_["gsl_vector_char"] = *x_char, 
-		_["gsl_vector_complex"] = *x_complex,
-		_["gsl_vector_complex_float"] = *x_complex_float, 
-		_["gsl_vector_complex_long_double"] = *x_complex_long_double, 
-		_["gsl_vector_long_double"] = *x_long_double, 
-		_["gsl_vector_short"] = *x_short, 
-		_["gsl_vector_uchar"] = *x_uchar, 
-		_["gsl_vector_uint"] = *x_uint, 
-		_["gsl_vector_ushort"] = *x_ushort, 
-		_["gsl_vector_ulong"] = *x_ulong
-		) ;
-	
-	/* cleanup gsl data */
-	gsl_vector_free(x_double);
-	gsl_vector_float_free( x_float);
-	gsl_vector_int_free( x_int );
-	gsl_vector_long_free( x_long );
-	gsl_vector_char_free( x_char );
-	gsl_vector_complex_free( x_complex );
-	gsl_vector_complex_float_free( x_complex_float );
-	gsl_vector_complex_long_double_free( x_complex_long_double );
-	gsl_vector_long_double_free( x_long_double );
-	gsl_vector_short_free( x_short );
-	gsl_vector_uchar_free( x_uchar );
-	gsl_vector_uint_free( x_uint );
-	gsl_vector_ushort_free( x_ushort );
-	gsl_vector_ulong_free( x_ulong );
-	
-	return res ;
-}
-
-extern "C" SEXP test_gsl_matrix(){
-	gsl_matrix * x_double                                   = gsl_matrix_alloc(5, 2);                      gsl_matrix_set_identity( x_double ) ;
-	gsl_matrix_float * x_float                              = gsl_matrix_float_alloc(5,2) ;                gsl_matrix_float_set_identity( x_float ) ;
-	gsl_matrix_int * x_int                                  = gsl_matrix_int_alloc(5,2) ;                  gsl_matrix_int_set_identity( x_int ) ;
-	gsl_matrix_long * x_long                                = gsl_matrix_long_alloc(5,2) ;                 gsl_matrix_long_set_identity( x_long ) ;
-	gsl_matrix_char * x_char                                = gsl_matrix_char_alloc(5,2) ;                 gsl_matrix_char_set_identity( x_char ) ;
-	gsl_matrix_complex * x_complex                          = gsl_matrix_complex_alloc(5,2) ;              gsl_matrix_complex_set_identity( x_complex ) ;
-	gsl_matrix_complex_float * x_complex_float              = gsl_matrix_complex_float_alloc(5,2) ;        gsl_matrix_complex_float_set_identity( x_complex_float ) ;
-	gsl_matrix_complex_long_double * x_complex_long_double  = gsl_matrix_complex_long_double_alloc(5,2) ;  gsl_matrix_complex_long_double_set_identity( x_complex_long_double ) ;
-	gsl_matrix_long_double * x_long_double                  = gsl_matrix_long_double_alloc(5,2) ;          gsl_matrix_long_double_set_identity( x_long_double ) ;
-	gsl_matrix_short * x_short                              = gsl_matrix_short_alloc(5,2) ;                gsl_matrix_short_set_identity( x_short ) ;
-	gsl_matrix_uchar * x_uchar                              = gsl_matrix_uchar_alloc(5,2) ;                gsl_matrix_uchar_set_identity( x_uchar ) ;
-	gsl_matrix_uint * x_uint                                = gsl_matrix_uint_alloc(5,2) ;                 gsl_matrix_uint_set_identity( x_uint) ;
-	gsl_matrix_ushort * x_ushort                            = gsl_matrix_ushort_alloc(5,2) ;               gsl_matrix_ushort_set_identity( x_ushort ) ;
-	gsl_matrix_ulong * x_ulong                              = gsl_matrix_ulong_alloc(5,2) ;                gsl_matrix_ulong_set_identity( x_ulong ) ;
-	
-	List res = List::create( 
-		_["gsl_matrix"] = *x_double , 
-		_["gsl_matrix_float"] = *x_float, 
-		_["gsl_matrix_int"] = *x_int, 
-		_["gsl_matrix_long"] = *x_long, 
-		_["gsl_matrix_char"] = *x_char, 
-		_["gsl_matrix_complex"] = *x_complex,
-		_["gsl_matrix_complex_float"] = *x_complex_float, 
-		_["gsl_matrix_complex_long_double"] = *x_complex_long_double, 
-		_["gsl_matrix_long_double"] = *x_long_double, 
-		_["gsl_matrix_short"] = *x_short, 
-		_["gsl_matrix_uchar"] = *x_uchar, 
-		_["gsl_matrix_uint"] = *x_uint, 
-		_["gsl_matrix_ushort"] = *x_ushort, 
-		_["gsl_matrix_ulong"] = *x_ulong
-		) ;
-	
-	gsl_matrix_free( x_double );
-	gsl_matrix_float_free( x_float);
-	gsl_matrix_int_free( x_int );
-	gsl_matrix_long_free( x_long );
-	gsl_matrix_char_free( x_char );
-	gsl_matrix_complex_free( x_complex );
-	gsl_matrix_complex_float_free( x_complex_float );
-	gsl_matrix_complex_long_double_free( x_complex_long_double );
-	gsl_matrix_long_double_free( x_long_double );
-	gsl_matrix_short_free( x_short );
-	gsl_matrix_uchar_free( x_uchar );
-	gsl_matrix_uint_free( x_uint );
-	gsl_matrix_ushort_free( x_ushort );
-	gsl_matrix_ulong_free( x_ulong );
-	
-	return res ;
-}
-
-extern "C" SEXP test_gsl_vector_view(){
-	int n = 10 ;
-	gsl_vector *v = gsl_vector_calloc (n);
-	for( int i=0 ; i<n; i++){
-		gsl_vector_set( v, i, i ) ;	
-	}
-	gsl_vector_view v_even = gsl_vector_subvector_with_stride(v, 0, 2, n/2);
-    gsl_vector_view v_odd  = gsl_vector_subvector_with_stride(v, 1, 2, n/2);
-    
-    List res = List::create( 
-    	_["even"] = v_even, 
-    	_["odd" ] = v_odd
-    	) ;
-    gsl_vector_free(v);
-	
-    return res ;
-}
-
-extern "C" SEXP test_gsl_matrix_view(){
-	int nrow = 4 ;
-	int ncol = 6 ;
-	gsl_matrix *m = gsl_matrix_alloc(nrow, ncol);
-	int k =0 ;
-	for( int i=0 ; i<nrow; i++){
-		for( int j=0; j<ncol; j++, k++){
-			gsl_matrix_set( m, i, j, k ) ;
-		}
-	}
-	gsl_matrix_view x = gsl_matrix_submatrix(m, 2, 2, 2, 2 ) ;
-	
-	List res = List::create( 
-		_["full"] = *m, 
-		_["view"] = x
-		) ;
-	gsl_matrix_free(m);
-	
-	return res ;
-}
-
-RCPP_FUNCTION_1( double, test_gsl_vector_input, RcppGSL::vector<double> vec){
-	int n = vec->size ;
-	double res = 0.0 ;
-	for( int i=0; i<n; i++){
-		res += gsl_vector_get( vec, i ) ;
-	}
-	vec.free() ;
-	return res ;
-}
-
-RCPP_FUNCTION_1( double, test_gsl_matrix_input, RcppGSL::matrix<double> mat){
-	int nr = mat->size1 ;
-	
-	double res = 0.0 ;
-	for( int i=0; i<nr; i++){
-		res += mat( i, 0 ) ;
-	}   
-	mat.free() ;
-	return res ;
-}
-
-RCPP_FUNCTION_0(Rcpp::IntegerVector, test_gsl_vector_conv){
-	RcppGSL::vector<int> vec(10) ;
-	for( int i=0; i<10; i++){
-		gsl_vector_int_set( vec, i, i ) ;	
-	}
-	Rcpp::IntegerVector x ; 
-	x = vec ;
-	return x ;
-}
-
-RCPP_FUNCTION_1(Rcpp::NumericVector, test_gsl_vector_indexing, RcppGSL::vector<double> vec ){
-	for( size_t i=0; i< vec.size(); i++){
-		vec[i] = vec[i] + 1.0 ;
-	}
-	NumericVector res = Rcpp::wrap( vec ) ;
-	vec.free() ;
-	return res ;
-}
-
-RCPP_FUNCTION_1(double, test_gsl_vector_iterating, RcppGSL::vector<double> vec ){
-	double res= std::accumulate( vec.begin(), vec.end(), 0.0 ); 
-	vec.free() ;
-	return res ;
-}
-
-RCPP_FUNCTION_1(Rcpp::NumericMatrix, test_gsl_matrix_indexing, RcppGSL::matrix<double> mat ){
-	for( size_t i=0; i< mat.nrow(); i++){
-		for( size_t j=0; j< mat.ncol(); j++){
-			mat(i,j) = mat(i,j) + 1.0 ;
-		}
-	}
-	Rcpp::NumericMatrix res = Rcpp::wrap(mat) ;
-	mat.free() ;
-	return res ;
-}
-
-RCPP_FUNCTION_0(Rcpp::List, test_gsl_vector_view_wrapper ){
-	int n = 10 ;
-	RcppGSL::vector<double> vec( 10 ) ;
-	for( int i=0 ; i<n; i++){
-		vec[i] = i ; 
-	}
-	RcppGSL::vector_view<double> v_even = gsl_vector_subvector_with_stride(vec, 0, 2, n/2);
-    RcppGSL::vector_view<double> v_odd  = gsl_vector_subvector_with_stride(vec, 1, 2, n/2);
-    
-    List res = List::create( 
-    	_["even"] = v_even, 
-    	_["odd" ] = v_odd
-    	) ;
-    vec.free() ;
-    
-    return res ;
-}
-
-RCPP_FUNCTION_0( Rcpp::List, test_gsl_matrix_view_wrapper ){
-	int nrow = 4 ;
-	int ncol = 6 ;
-	RcppGSL::matrix<double> m(nrow, ncol);
-	int k =0 ;
-	for( int i=0 ; i<nrow; i++){
-		for( int j=0; j<ncol; j++, k++){
-			m(i, j) = k ;
-		}
-	}
-	RcppGSL::matrix_view<double> x = gsl_matrix_submatrix(m, 2, 2, 2, 2 ) ;
-	
-	List res = List::create( 
-		_["full"] = m, 
-		_["view"] = x
-		) ;
-	m.free() ;
-	
-	return res ;
-}
-
-RCPP_FUNCTION_1(double, test_gsl_vector_view_iterating, RcppGSL::vector<double> vec ){
-	int n = vec.size() ;
-	RcppGSL::vector_view<double> v_even = gsl_vector_subvector_with_stride(vec, 0, 2, n/2);
-    double res = std::accumulate( v_even.begin(), v_even.end(), 0.0 );
-    return res ;
-}
-
-RCPP_FUNCTION_0( double,test_gsl_matrix_view_indexing ){
-	int nr = 10 ;
-	int nc = 10 ;
-	RcppGSL::matrix<double> mat( nr, nc ) ;
-	int k = 0;
-	for( size_t i=0; i< mat.nrow(); i++){
-		for( size_t j=0; j< mat.ncol(); j++, k++){
-			mat(i,j) = k ;
-		}
-	}
-	RcppGSL::matrix_view<double> x = gsl_matrix_submatrix(mat, 2, 2, 2, 2 ) ;
-	double res = 0.0 ;
-	for( size_t i=0; i<x.nrow(); i++){
-		for( size_t j=0; j<x.ncol(); j++){
-			res += x(i,j) ;
-		}
-	}
-	mat.free() ;
-	return res ;
-}
-
-
 // helping the vignette
 RCPP_FUNCTION_1( int, sum_gsl_vector_int, RcppGSL::vector<int> vec){
   int res = std::accumulate( vec.begin(), vec.end(), 0 ) ;



More information about the Rcpp-commits mailing list