[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