[Rcpp-commits] r1008 - 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 12:03:42 CEST 2010
Author: romain
Date: 2010-04-06 12:03:42 +0200 (Tue, 06 Apr 2010)
New Revision: 1008
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 gsl_vector_complex
Modified: pkg/RcppGSL/inst/include/RcppGSL.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL.h 2010-04-06 07:57:00 UTC (rev 1007)
+++ pkg/RcppGSL/inst/include/RcppGSL.h 2010-04-06 10:03:42 UTC (rev 1008)
@@ -25,6 +25,21 @@
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 <> SEXP wrap( const gsl_vector& x){
return wrap( x.data, x.data + x.size ) ;
}
@@ -41,7 +56,18 @@
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 ) ;
+}
+
}
#endif
Modified: pkg/RcppGSL/inst/include/RcppGSLForward.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSLForward.h 2010-04-06 07:57:00 UTC (rev 1007)
+++ pkg/RcppGSL/inst/include/RcppGSLForward.h 2010-04-06 10:03:42 UTC (rev 1008)
@@ -25,10 +25,26 @@
/* forward declarations */
namespace Rcpp{
+
+ namespace traits{
+ /* support for gsl_complex */
+ template<> struct r_sexptype_traits<gsl_complex>{ enum{ rtype = CPLXSXP } ; } ;
+ template<> struct wrap_type_traits<gsl_complex> { typedef wrap_type_primitive_tag wrap_category; } ;
+ template<> struct r_type_traits<gsl_complex>{ typedef r_type_primitive_tag r_category ; } ;
+ template<> struct r_type_traits< std::pair<const std::string,gsl_complex> >{ typedef r_type_primitive_tag r_category ; } ;
+ }
+
+ namespace internal{
+ template<> gsl_complex caster<Rcomplex,gsl_complex>( Rcomplex from) ;
+ template<> Rcomplex caster<gsl_complex,Rcomplex>( gsl_complex from) ;
+ }
+
template <> SEXP wrap( const gsl_vector& ) ;
template <> SEXP wrap( const gsl_vector_float& ) ;
template <> SEXP wrap( const gsl_vector_int& ) ;
template <> SEXP wrap( const gsl_vector_long& ) ;
+ template <> SEXP wrap( const gsl_vector_char& ) ;
+ template <> SEXP wrap( const gsl_vector_complex& ) ;
}
#endif
Modified: pkg/RcppGSL/inst/unitTests/runit.gsl.R
===================================================================
--- pkg/RcppGSL/inst/unitTests/runit.gsl.R 2010-04-06 07:57:00 UTC (rev 1007)
+++ pkg/RcppGSL/inst/unitTests/runit.gsl.R 2010-04-06 10:03:42 UTC (rev 1008)
@@ -24,7 +24,9 @@
"gsl_vector" = numeric(10),
"gsl_vector_float" = numeric(10),
"gsl_vector_int" = integer(10),
- "gsl_vector_long" = numeric(10)
+ "gsl_vector_long" = numeric(10),
+ "gsl_vector_char" = raw(10),
+ "gsl_vector_complex" = complex(10)
),
msg = "wrap( gsl_vector )" )
}
Modified: pkg/RcppGSL/src/RcppGSL.cpp
===================================================================
--- pkg/RcppGSL/src/RcppGSL.cpp 2010-04-06 07:57:00 UTC (rev 1007)
+++ pkg/RcppGSL/src/RcppGSL.cpp 2010-04-06 10:03:42 UTC (rev 1008)
@@ -7,13 +7,17 @@
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) ;
/* 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_long"] = *x_long,
+ _["gsl_vector_char"] = *x_char,
+ _["gsl_vector_complex"] = *x_complex
) ;
/* cleanup gsl data */
@@ -21,6 +25,8 @@
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 );
return res ;
}
More information about the Rcpp-commits
mailing list