[Rcpp-commits] r1011 - 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:26:14 CEST 2010
Author: romain
Date: 2010-04-06 12:26:14 +0200 (Tue, 06 Apr 2010)
New Revision: 1011
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:
suipport for gsl_vector_complex_long_double
Modified: pkg/RcppGSL/inst/include/RcppGSL.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL.h 2010-04-06 10:21:07 UTC (rev 1010)
+++ pkg/RcppGSL/inst/include/RcppGSL.h 2010-04-06 10:26:14 UTC (rev 1011)
@@ -52,6 +52,18 @@
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 ;
+ }
}
template <> SEXP wrap( const gsl_vector& x){
@@ -77,7 +89,7 @@
}
template <> SEXP wrap( const gsl_vector_complex& x){
- return wrap(
+ return wrap(
reinterpret_cast<gsl_complex*>(x.data),
reinterpret_cast<gsl_complex*>(x.data) + x.size ) ;
}
@@ -87,7 +99,13 @@
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 ) ;
+}
+
}
#endif
Modified: pkg/RcppGSL/inst/include/RcppGSLForward.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSLForward.h 2010-04-06 10:21:07 UTC (rev 1010)
+++ pkg/RcppGSL/inst/include/RcppGSLForward.h 2010-04-06 10:26:14 UTC (rev 1011)
@@ -39,6 +39,12 @@
template<> struct r_type_traits<gsl_complex_float>{ typedef r_type_primitive_tag r_category ; } ;
template<> struct r_type_traits< std::pair<const std::string,gsl_complex_float> >{ typedef r_type_primitive_tag r_category ; } ;
+ /* support for gsl_complex_long_double */
+ template<> struct r_sexptype_traits<gsl_complex_long_double>{ enum{ rtype = CPLXSXP } ; } ;
+ template<> struct wrap_type_traits<gsl_complex_long_double> { typedef wrap_type_primitive_tag wrap_category; } ;
+ template<> struct r_type_traits<gsl_complex_long_double>{ typedef r_type_primitive_tag r_category ; } ;
+ template<> struct r_type_traits< std::pair<const std::string,gsl_complex_long_double> >{ typedef r_type_primitive_tag r_category ; } ;
+
}
namespace internal{
@@ -48,6 +54,9 @@
template<> gsl_complex_float caster<Rcomplex,gsl_complex_float>( Rcomplex from) ;
template<> Rcomplex caster<gsl_complex_float,Rcomplex>( gsl_complex_float from) ;
+ template<> gsl_complex_long_double caster<Rcomplex,gsl_complex_long_double>( Rcomplex from) ;
+ template<> Rcomplex caster<gsl_complex_long_double,Rcomplex>( gsl_complex_long_double from) ;
+
}
template <> SEXP wrap( const gsl_vector& ) ;
@@ -57,6 +66,7 @@
template <> SEXP wrap( const gsl_vector_char& ) ;
template <> SEXP wrap( const gsl_vector_complex& ) ;
template <> SEXP wrap( const gsl_vector_complex_float& ) ;
+ template <> SEXP wrap( const gsl_vector_complex_long_double& ) ;
}
#endif
Modified: pkg/RcppGSL/inst/unitTests/runit.gsl.R
===================================================================
--- pkg/RcppGSL/inst/unitTests/runit.gsl.R 2010-04-06 10:21:07 UTC (rev 1010)
+++ pkg/RcppGSL/inst/unitTests/runit.gsl.R 2010-04-06 10:26:14 UTC (rev 1011)
@@ -27,7 +27,8 @@
"gsl_vector_long" = numeric(10),
"gsl_vector_char" = raw(10),
"gsl_vector_complex" = complex(10),
- "gsl_vector_complex_float" = complex(10)
+ "gsl_vector_complex_float" = complex(10),
+ "gsl_vector_complex_long_double" = complex(10)
),
msg = "wrap( gsl_vector )" )
}
Modified: pkg/RcppGSL/src/RcppGSL.cpp
===================================================================
--- pkg/RcppGSL/src/RcppGSL.cpp 2010-04-06 10:21:07 UTC (rev 1010)
+++ pkg/RcppGSL/src/RcppGSL.cpp 2010-04-06 10:26:14 UTC (rev 1011)
@@ -10,6 +10,7 @@
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) ;
/* create an R list containing copies of gsl data */
List res = List::create(
@@ -19,7 +20,8 @@
_["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_float"] = *x_complex_float,
+ _["gsl_vector_complex_long_double"] = *x_complex_long_double
) ;
/* cleanup gsl data */
@@ -30,6 +32,7 @@
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 );
return res ;
}
More information about the Rcpp-commits
mailing list