[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