[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