[Rcpp-commits] r4363 - in pkg/RcppGSL: . inst inst/unitTests inst/unitTests/cpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jun 22 22:23:33 CEST 2013
Author: edd
Date: 2013-06-22 22:23:33 +0200 (Sat, 22 Jun 2013)
New Revision: 4363
Added:
pkg/RcppGSL/inst/unitTests/cpp/
pkg/RcppGSL/inst/unitTests/cpp/gsl.cpp
Modified:
pkg/RcppGSL/ChangeLog
pkg/RcppGSL/inst/NEWS.Rd
pkg/RcppGSL/inst/unitTests/runit.gsl.R
Log:
C++-based unit tests for RcppGSL now use sourceCpp
Modified: pkg/RcppGSL/ChangeLog
===================================================================
--- pkg/RcppGSL/ChangeLog 2013-06-22 17:55:15 UTC (rev 4362)
+++ pkg/RcppGSL/ChangeLog 2013-06-22 20:23:33 UTC (rev 4363)
@@ -1,3 +1,9 @@
+2013-06-22 Dirk Eddelbuettel <edd at debian.org>
+
+ * inst/unitTests/runit.gsl.R: Rewritten to use sourceCpp()
+
+ * inst/unitTests/cpp/gsl.cpp: New C++ file with unit tests
+
2013-06-21 Dirk Eddelbuettel <edd at debian.org>
* vignettes/buildVignette.R: Added simple helper script to build
Modified: pkg/RcppGSL/inst/NEWS.Rd
===================================================================
--- pkg/RcppGSL/inst/NEWS.Rd 2013-06-22 17:55:15 UTC (rev 4362)
+++ pkg/RcppGSL/inst/NEWS.Rd 2013-06-22 20:23:33 UTC (rev 4363)
@@ -13,6 +13,8 @@
as R 3.0.0 supports different vignette engines, so the vignette
build process has been simplified. A convenience helper script has
also been added for command-line builds.
+ \item Unit tests now use \code{sourceCpp()} instead of
+ \code{cxxfunction()} from the \pkg{inline} package
}
}
Added: pkg/RcppGSL/inst/unitTests/cpp/gsl.cpp
===================================================================
--- pkg/RcppGSL/inst/unitTests/cpp/gsl.cpp (rev 0)
+++ pkg/RcppGSL/inst/unitTests/cpp/gsl.cpp 2013-06-22 20:23:33 UTC (rev 4363)
@@ -0,0 +1,366 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
+//
+// gsl.cpp: RcppGSL R integration of GSL via Rcpp -- unit tests
+//
+// Copyright (C) 2010 - 2013 Romain Francois and Dirk Eddelbuettel
+//
+// This file is part of RcppGSL.
+//
+// RcppGSL 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.
+//
+// RcppGSL 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 RcppGSL. If not, see <http://www.gnu.org/licenses/>.
+
+#include <Rcpp.h>
+using namespace Rcpp;
+
+// [[Rcpp::export]]
+List 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;
+}
+
+// [[Rcpp::export]]
+List 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;
+}
+
+// [[Rcpp::export]]
+List 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;
+}
+
+// [[Rcpp::export]]
+List 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;
+}
+
+// [[Rcpp::export]]
+List 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::export]]
+double test_gsl_vector_input(NumericVector vec_) {
+ 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 );
+}
+
+// [[Rcpp::export]]
+double test_gsl_matrix_input(NumericMatrix mat_) {
+ 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);
+}
+
+// [[Rcpp::export]]
+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::export]]
+NumericVector test_gsl_vector_indexing(NumericVector vec_) {
+ 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;
+}
+
+// [[Rcpp::export]]
+double test_gsl_vector_iterating(NumericVector vec_) {
+ RcppGSL::vector<double> vec = as< RcppGSL::vector<double> >(vec_);
+ double res= std::accumulate( vec.begin(), vec.end(), 0.0 );
+ vec.free();
+ return wrap( res );
+}
+
+// [[Rcpp::export]]
+List test_gsl_matrix_indexing(NumericMatrix mat_) {
+ 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;
+}
+
+// [[Rcpp::export]]
+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::export]]
+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::export]]
+double test_gsl_vector_view_iterating(NumericVector vec_) {
+ 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 );
+}
+
+// [[Rcpp::export]]
+List 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 wrap( res );
+}
+
Modified: pkg/RcppGSL/inst/unitTests/runit.gsl.R
===================================================================
--- pkg/RcppGSL/inst/unitTests/runit.gsl.R 2013-06-22 17:55:15 UTC (rev 4362)
+++ pkg/RcppGSL/inst/unitTests/runit.gsl.R 2013-06-22 20:23:33 UTC (rev 4363)
@@ -19,427 +19,52 @@
# 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() )
- }
+ if (!exists("pathRcppTests")) pathRcppTests <- getwd()
+ sourceCpp(file.path(pathRcppTests, "cpp/gsl.cpp"))
}
test.gsl.vector.wrappers <- function(){
- fx <- .rcppgsl.tests$test_gsl_vector_wrapper
+ fx <- test_gsl_vector_wrapper
res <- fx()
- checkEquals( res,
- list(
- "gsl_vector" = numeric(10),
- "gsl_vector_float" = numeric(10),
- "gsl_vector_int" = integer(10),
- #"gsl_vector_long" = numeric(10),
- "gsl_vector_char" = raw(10),
- "gsl_vector_complex" = complex(10),
- "gsl_vector_complex_float" = complex(10),
- "gsl_vector_complex_long_double" = complex(10),
- "gsl_vector_long_double" = numeric(10),
- "gsl_vector_short" = integer(10),
- "gsl_vector_uchar" = raw(10),
- "gsl_vector_uint" = integer(10),
- "gsl_vector_ushort" = integer(10)
- #,"gsl_vector_ulong" = numeric(10)
- ),
- msg = "wrap( gsl_vector )" )
+ checkEquals(res,
+ list("gsl_vector" = numeric(10),
+ "gsl_vector_float" = numeric(10),
+ "gsl_vector_int" = integer(10),
+ ##"gsl_vector_long" = numeric(10),
+ "gsl_vector_char" = raw(10),
+ "gsl_vector_complex" = complex(10),
+ "gsl_vector_complex_float" = complex(10),
+ "gsl_vector_complex_long_double" = complex(10),
+ "gsl_vector_long_double" = numeric(10),
+ "gsl_vector_short" = integer(10),
+ "gsl_vector_uchar" = raw(10),
+ "gsl_vector_uint" = integer(10),
+ "gsl_vector_ushort" = integer(10)
+ ##,"gsl_vector_ulong" = numeric(10)
+ ),
+ msg = "wrap( gsl_vector )" )
}
test.gsl.vector <- function(){
- fx <- .rcppgsl.tests$test_gsl_vector
+ fx <- test_gsl_vector
res <- fx()
- checkEquals( res,
- list(
- "gsl_vector" = numeric(10),
- "gsl_vector_float" = numeric(10),
- "gsl_vector_int" = integer(10),
- #"gsl_vector_long" = numeric(10),
- "gsl_vector_char" = raw(10),
- "gsl_vector_complex" = complex(10),
- "gsl_vector_complex_float" = complex(10),
- "gsl_vector_complex_long_double" = complex(10),
- "gsl_vector_long_double" = numeric(10),
- "gsl_vector_short" = integer(10),
- "gsl_vector_uchar" = raw(10),
- "gsl_vector_uint" = integer(10),
- "gsl_vector_ushort" = integer(10)
- #,"gsl_vector_ulong" = numeric(10)
- ),
- msg = "wrap( gsl_vector )" )
+ checkEquals(res,
+ list("gsl_vector" = numeric(10),
+ "gsl_vector_float" = numeric(10),
+ "gsl_vector_int" = integer(10),
+ ##"gsl_vector_long" = numeric(10),
+ "gsl_vector_char" = raw(10),
+ "gsl_vector_complex" = complex(10),
+ "gsl_vector_complex_float" = complex(10),
+ "gsl_vector_complex_long_double" = complex(10),
+ "gsl_vector_long_double" = numeric(10),
+ "gsl_vector_short" = integer(10),
+ "gsl_vector_uchar" = raw(10),
+ "gsl_vector_uint" = integer(10),
+ "gsl_vector_ushort" = integer(10)
+ ##,"gsl_vector_ulong" = numeric(10)
+ ),
+ msg = "wrap( gsl_vector )" )
}
test.gsl.matrix <- function(){
@@ -451,104 +76,102 @@
dim( x ) <- c(5,2)
x
}
- fx <- .rcppgsl.tests$test_gsl_matrix
- res <- fx()
- checkEquals( res,
- list(
- "gsl_matrix" = helper( numeric ),
- "gsl_matrix_float" = helper( numeric ),
- "gsl_matrix_int" = helper( integer ),
- #"gsl_matrix_long" = helper( numeric ),
- "gsl_matrix_char" = helper( raw ),
- "gsl_matrix_complex" = helper( complex ),
- "gsl_matrix_complex_float" = helper( complex ),
- "gsl_matrix_complex_long_double" = helper( complex ),
- "gsl_matrix_long_double" = helper( numeric ),
- "gsl_matrix_short" = helper( integer ),
- "gsl_matrix_uchar" = helper( raw ),
- "gsl_matrix_uint" = helper( integer ),
- "gsl_matrix_ushort" = helper( integer )
- #,"gsl_matrix_ulong" = helper( numeric )
- ),
- msg = "wrap( gsl_matrix )" )
+ fx <- test_gsl_matrix
+ res <- fx()
+ checkEquals(res,
+ list("gsl_matrix" = helper( numeric ),
+ "gsl_matrix_float" = helper( numeric ),
+ "gsl_matrix_int" = helper( integer ),
+ ##"gsl_matrix_long" = helper( numeric ),
+ "gsl_matrix_char" = helper( raw ),
+ "gsl_matrix_complex" = helper( complex ),
+ "gsl_matrix_complex_float" = helper( complex ),
+ "gsl_matrix_complex_long_double" = helper( complex ),
+ "gsl_matrix_long_double" = helper( numeric ),
+ "gsl_matrix_short" = helper( integer ),
+ "gsl_matrix_uchar" = helper( raw ),
+ "gsl_matrix_uint" = helper( integer ),
+ "gsl_matrix_ushort" = helper( integer )
+ ##,"gsl_matrix_ulong" = helper( numeric )
+ ),
+ msg = "wrap( gsl_matrix )" )
}
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rcpp -r 4363
More information about the Rcpp-commits
mailing list