[Rcpp-commits] r1019 - in pkg/RcppGSL: inst/include inst/unitTests src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Apr 6 19:47:45 CEST 2010
Author: romain
Date: 2010-04-06 19:47:45 +0200 (Tue, 06 Apr 2010)
New Revision: 1019
Added:
pkg/RcppGSL/inst/include/RcppGSL_caster.h
pkg/RcppGSL/inst/include/RcppGSL_matrix.h
pkg/RcppGSL/inst/include/RcppGSL_vector.h
Modified:
pkg/RcppGSL/inst/include/RcppGSL.h
pkg/RcppGSL/inst/include/RcppGSLForward.h
pkg/RcppGSL/inst/unitTests/runit.gsl.R
pkg/RcppGSL/src/RcppGSL.cpp
Log:
support for all gsl_matrix_* types
Modified: pkg/RcppGSL/inst/include/RcppGSL.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL.h 2010-04-06 17:24:21 UTC (rev 1018)
+++ pkg/RcppGSL/inst/include/RcppGSL.h 2010-04-06 17:47:45 UTC (rev 1019)
@@ -23,121 +23,8 @@
#include <RcppGSLForward.h>
#include <Rcpp.h>
-namespace Rcpp{
-
- namespace internal{
- template<> gsl_complex caster<Rcomplex,gsl_complex>( Rcomplex from){
- gsl_complex x ;
- GSL_REAL(x) = from.r ;
- GSL_IMAG(x) = from.i ;
- return x ;
- }
- template<> Rcomplex caster<gsl_complex,Rcomplex>( gsl_complex from){
- Rcomplex x ;
- x.r = GSL_REAL(from) ;
- x.i = GSL_IMAG(from) ;
- return x ;
- }
-
- template<> gsl_complex_float caster<Rcomplex,gsl_complex_float>( Rcomplex from){
- gsl_complex_float x ;
- GSL_REAL(x) = static_cast<float>( from.r ) ;
- GSL_IMAG(x) = static_cast<float>( from.i ) ;
- return x ;
- }
- template<> Rcomplex caster<gsl_complex_float,Rcomplex>( gsl_complex_float from){
- Rcomplex x ;
- x.r = static_cast<double>( GSL_REAL(from) ) ;
- x.i = static_cast<double>( GSL_IMAG(from) ) ;
- return x ;
- }
-
- template<> gsl_complex_long_double caster<Rcomplex,gsl_complex_long_double>( Rcomplex from){
- gsl_complex_long_double x ;
- GSL_REAL(x) = static_cast<float>( from.r ) ;
- GSL_IMAG(x) = static_cast<float>( from.i ) ;
- return x ;
- }
- template<> Rcomplex caster<gsl_complex_long_double,Rcomplex>( gsl_complex_long_double from){
- Rcomplex x ;
- x.r = static_cast<double>( GSL_REAL(from) ) ;
- x.i = static_cast<double>( GSL_IMAG(from) ) ;
- return x ;
- }
- }
+#include <RcppGSL_caster.h>
+#include <RcppGSL_vector.h>
+#include <RcppGSL_matrix.h>
-template <> SEXP wrap( const gsl_vector& x){
- return wrap( x.data, x.data + x.size ) ;
-}
-
-template <> SEXP wrap( const gsl_vector_float& x){
- return wrap( x.data, x.data + x.size ) ;
-}
-
-template <> SEXP wrap( const gsl_vector_int& x){
- return wrap( x.data, x.data + x.size ) ;
-}
-
-template <> SEXP wrap( const gsl_vector_long& x){
- return wrap( x.data, x.data + x.size ) ;
-}
-
-template <> SEXP wrap( const gsl_vector_char& x){
- return wrap(
- reinterpret_cast<Rbyte* const>(x.data),
- reinterpret_cast<Rbyte* const>(x.data) + x.size ) ;
-}
-
-template <> SEXP wrap( const gsl_vector_complex& x){
- return wrap(
- reinterpret_cast<gsl_complex*>(x.data),
- reinterpret_cast<gsl_complex*>(x.data) + x.size ) ;
-}
-
-template <> SEXP wrap( const gsl_vector_complex_float& x){
- return wrap(
- reinterpret_cast<gsl_complex_float*>(x.data),
- reinterpret_cast<gsl_complex_float*>(x.data) + x.size ) ;
-}
-
-template <> SEXP wrap( const gsl_vector_complex_long_double& x){
- return wrap(
- reinterpret_cast<gsl_complex_long_double*>(x.data),
- reinterpret_cast<gsl_complex_long_double*>(x.data) + x.size ) ;
-}
-
-template <> SEXP wrap( const gsl_vector_long_double& x){
- return wrap( x.data, x.data + x.size ) ;
-}
-
-template <> SEXP wrap( const gsl_vector_short& x){
- return wrap( x.data, x.data + x.size ) ;
-}
-
-template <> SEXP wrap( const gsl_vector_uchar& x){
- return wrap( x.data, x.data + x.size ) ;
-}
-
-template <> SEXP wrap( const gsl_vector_uint& x){
- return wrap( x.data, x.data + x.size ) ;
-}
-
-template <> SEXP wrap( const gsl_vector_ushort& x){
- return wrap( x.data, x.data + x.size ) ;
-}
-
-template <> SEXP wrap( const gsl_vector_ulong& x){
- return wrap( x.data, x.data + x.size ) ;
-}
-
-
-/* matrices */
-
-template <> SEXP wrap( const gsl_matrix& x){
- return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
-}
-
-
-}
-
#endif
Modified: pkg/RcppGSL/inst/include/RcppGSLForward.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSLForward.h 2010-04-06 17:24:21 UTC (rev 1018)
+++ pkg/RcppGSL/inst/include/RcppGSLForward.h 2010-04-06 17:47:45 UTC (rev 1019)
@@ -102,6 +102,19 @@
template <> SEXP wrap( const gsl_matrix& ) ;
+ template <> SEXP wrap( const gsl_matrix_int& ) ;
+ template <> SEXP wrap( const gsl_matrix_float& ) ;
+ template <> SEXP wrap( const gsl_matrix_long& ) ;
+ template <> SEXP wrap( const gsl_matrix_char& ) ;
+ template <> SEXP wrap( const gsl_matrix_complex& ) ;
+ template <> SEXP wrap( const gsl_matrix_complex_float& ) ;
+ template <> SEXP wrap( const gsl_matrix_complex_long_double& ) ;
+ template <> SEXP wrap( const gsl_matrix_long_double& ) ;
+ template <> SEXP wrap( const gsl_matrix_short& ) ;
+ template <> SEXP wrap( const gsl_matrix_uchar& ) ;
+ template <> SEXP wrap( const gsl_matrix_uint& ) ;
+ template <> SEXP wrap( const gsl_matrix_ushort& ) ;
+ template <> SEXP wrap( const gsl_matrix_ulong& ) ;
}
Added: pkg/RcppGSL/inst/include/RcppGSL_caster.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL_caster.h (rev 0)
+++ pkg/RcppGSL/inst/include/RcppGSL_caster.h 2010-04-06 17:47:45 UTC (rev 1019)
@@ -0,0 +1,71 @@
+// RcppGSL.h: Rcpp/GSL glue
+//
+// Copyright (C) 2010 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/>.
+
+#ifndef RCPPGSL__RCPPGSL_CASTER_H
+#define RCPPGSL__RCPPGSL_CASTER_H
+
+#include <RcppGSLForward.h>
+#include <Rcpp.h>
+
+namespace Rcpp{
+
+ namespace internal{
+ template<> gsl_complex caster<Rcomplex,gsl_complex>( Rcomplex from){
+ gsl_complex x ;
+ GSL_REAL(x) = from.r ;
+ GSL_IMAG(x) = from.i ;
+ return x ;
+ }
+ template<> Rcomplex caster<gsl_complex,Rcomplex>( gsl_complex from){
+ Rcomplex x ;
+ x.r = GSL_REAL(from) ;
+ x.i = GSL_IMAG(from) ;
+ return x ;
+ }
+
+ template<> gsl_complex_float caster<Rcomplex,gsl_complex_float>( Rcomplex from){
+ gsl_complex_float x ;
+ GSL_REAL(x) = static_cast<float>( from.r ) ;
+ GSL_IMAG(x) = static_cast<float>( from.i ) ;
+ return x ;
+ }
+ template<> Rcomplex caster<gsl_complex_float,Rcomplex>( gsl_complex_float from){
+ Rcomplex x ;
+ x.r = static_cast<double>( GSL_REAL(from) ) ;
+ x.i = static_cast<double>( GSL_IMAG(from) ) ;
+ return x ;
+ }
+
+ template<> gsl_complex_long_double caster<Rcomplex,gsl_complex_long_double>( Rcomplex from){
+ gsl_complex_long_double x ;
+ GSL_REAL(x) = static_cast<float>( from.r ) ;
+ GSL_IMAG(x) = static_cast<float>( from.i ) ;
+ return x ;
+ }
+ template<> Rcomplex caster<gsl_complex_long_double,Rcomplex>( gsl_complex_long_double from){
+ Rcomplex x ;
+ x.r = static_cast<double>( GSL_REAL(from) ) ;
+ x.i = static_cast<double>( GSL_IMAG(from) ) ;
+ return x ;
+ }
+ }
+
+}
+
+#endif
Added: pkg/RcppGSL/inst/include/RcppGSL_matrix.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL_matrix.h (rev 0)
+++ pkg/RcppGSL/inst/include/RcppGSL_matrix.h 2010-04-06 17:47:45 UTC (rev 1019)
@@ -0,0 +1,87 @@
+// RcppGSL_matrix.h: Rcpp/GSL glue
+//
+// Copyright (C) 2010 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/>.
+
+#ifndef RCPPGSL__RCPPGSL_MATRIX_H
+#define RCPPGSL__RCPPGSL_MATRIX_H
+
+#include <RcppGSLForward.h>
+#include <Rcpp.h>
+#include <RcppGSL_caster.h>
+
+namespace Rcpp{
+
+template <> SEXP wrap( const gsl_matrix& x){
+ return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
+}
+
+template <> SEXP wrap( const gsl_matrix_float& x){
+ return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
+}
+
+template <> SEXP wrap( const gsl_matrix_int& x){
+ return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
+}
+
+template <> SEXP wrap( const gsl_matrix_long& x){
+ return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
+}
+
+template <> SEXP wrap( const gsl_matrix_char& x){
+ return internal::rowmajor_wrap( reinterpret_cast<Rbyte*>(x.data), x.size1, x.size2 ) ;
+}
+
+template <> SEXP wrap( const gsl_matrix_complex& x){
+ return internal::rowmajor_wrap( reinterpret_cast<gsl_complex*>(x.data), x.size1, x.size2 ) ;
+}
+
+template <> SEXP wrap( const gsl_matrix_complex_float& x){
+ return internal::rowmajor_wrap( reinterpret_cast<gsl_complex_float*>(x.data), x.size1, x.size2 ) ;
+}
+
+template <> SEXP wrap( const gsl_matrix_complex_long_double& x){
+ return internal::rowmajor_wrap( reinterpret_cast<gsl_complex_long_double*>(x.data), x.size1, x.size2 ) ;
+}
+
+template <> SEXP wrap( const gsl_matrix_long_double& x){
+ return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
+}
+
+template <> SEXP wrap( const gsl_matrix_short& x){
+ return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
+}
+
+template <> SEXP wrap( const gsl_matrix_uchar& x){
+ return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
+}
+
+template <> SEXP wrap( const gsl_matrix_uint& x){
+ return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
+}
+
+template <> SEXP wrap( const gsl_matrix_ushort& x){
+ return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
+}
+
+template <> SEXP wrap( const gsl_matrix_ulong& x){
+ return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
+}
+
+}
+
+#endif
Added: pkg/RcppGSL/inst/include/RcppGSL_vector.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL_vector.h (rev 0)
+++ pkg/RcppGSL/inst/include/RcppGSL_vector.h 2010-04-06 17:47:45 UTC (rev 1019)
@@ -0,0 +1,95 @@
+// RcppGSL.h: Rcpp/GSL glue
+//
+// Copyright (C) 2010 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/>.
+
+#ifndef RCPPGSL__RCPPGSL_VECTOR_H
+#define RCPPGSL__RCPPGSL_VECTOR_H
+
+#include <RcppGSLForward.h>
+#include <Rcpp.h>
+#include <RcppGSL_caster.h>
+
+namespace Rcpp{
+
+template <> SEXP wrap( const gsl_vector& x){
+ return wrap( x.data, x.data + x.size ) ;
+}
+
+template <> SEXP wrap( const gsl_vector_float& x){
+ return wrap( x.data, x.data + x.size ) ;
+}
+
+template <> SEXP wrap( const gsl_vector_int& x){
+ return wrap( x.data, x.data + x.size ) ;
+}
+
+template <> SEXP wrap( const gsl_vector_long& x){
+ return wrap( x.data, x.data + x.size ) ;
+}
+
+template <> SEXP wrap( const gsl_vector_char& x){
+ return wrap(
+ reinterpret_cast<Rbyte* const>(x.data),
+ reinterpret_cast<Rbyte* const>(x.data) + x.size ) ;
+}
+
+template <> SEXP wrap( const gsl_vector_complex& x){
+ return wrap(
+ reinterpret_cast<gsl_complex*>(x.data),
+ reinterpret_cast<gsl_complex*>(x.data) + x.size ) ;
+}
+
+template <> SEXP wrap( const gsl_vector_complex_float& x){
+ return wrap(
+ reinterpret_cast<gsl_complex_float*>(x.data),
+ reinterpret_cast<gsl_complex_float*>(x.data) + x.size ) ;
+}
+
+template <> SEXP wrap( const gsl_vector_complex_long_double& x){
+ return wrap(
+ reinterpret_cast<gsl_complex_long_double*>(x.data),
+ reinterpret_cast<gsl_complex_long_double*>(x.data) + x.size ) ;
+}
+
+template <> SEXP wrap( const gsl_vector_long_double& x){
+ return wrap( x.data, x.data + x.size ) ;
+}
+
+template <> SEXP wrap( const gsl_vector_short& x){
+ return wrap( x.data, x.data + x.size ) ;
+}
+
+template <> SEXP wrap( const gsl_vector_uchar& x){
+ return wrap( x.data, x.data + x.size ) ;
+}
+
+template <> SEXP wrap( const gsl_vector_uint& x){
+ return wrap( x.data, x.data + x.size ) ;
+}
+
+template <> SEXP wrap( const gsl_vector_ushort& x){
+ return wrap( x.data, x.data + x.size ) ;
+}
+
+template <> SEXP wrap( const gsl_vector_ulong& x){
+ return wrap( x.data, x.data + x.size ) ;
+}
+
+}
+
+#endif
Modified: pkg/RcppGSL/inst/unitTests/runit.gsl.R
===================================================================
--- pkg/RcppGSL/inst/unitTests/runit.gsl.R 2010-04-06 17:24:21 UTC (rev 1018)
+++ pkg/RcppGSL/inst/unitTests/runit.gsl.R 2010-04-06 17:47:45 UTC (rev 1019)
@@ -39,3 +39,33 @@
msg = "wrap( gsl_vector )" )
}
+test.gsl.matrix <- function(){
+ helper <- function(what){
+ as.what <- get( paste( "as.", deparse(substitute(what)), sep = "" ) )
+ x <- what(10)
+ x[1] <- as.what(1)
+ x[7] <- as.what(1)
+ dim( x ) <- c(5,2)
+ x
+ }
+ res <- .Call( "test_gsl_matrix", PACKAGE = "RcppGSL" )
+ 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 )" )
+
+}
Modified: pkg/RcppGSL/src/RcppGSL.cpp
===================================================================
--- pkg/RcppGSL/src/RcppGSL.cpp 2010-04-06 17:24:21 UTC (rev 1018)
+++ pkg/RcppGSL/src/RcppGSL.cpp 2010-04-06 17:47:45 UTC (rev 1019)
@@ -56,13 +56,52 @@
}
extern "C" SEXP test_gsl_matrix(){
- gsl_matrix * x_double = gsl_matrix_alloc(5, 2); gsl_matrix_set_identity( x_double ) ;
+ 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"] = *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 ;
}
More information about the Rcpp-commits
mailing list