[Rcpp-commits] r1020 - pkg/RcppGSL/inst/include

[noreply at r-forge.r-project.org]

Author: romain
Date: 2010-04-06 21:55:04 +0200 (Tue, 06 Apr 2010)
New Revision: 1020

Modified:
   pkg/RcppGSL/inst/include/RcppGSLForward.h
   pkg/RcppGSL/inst/include/RcppGSL_vector.h
Log:
smarter wrap for gsl_vector (takes the stride into account)

Modified: pkg/RcppGSL/inst/include/RcppGSLForward.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSLForward.h	2010-04-06 17:47:45 UTC (rev 1019)
+++ pkg/RcppGSL/inst/include/RcppGSLForward.h	2010-04-06 19:55:04 UTC (rev 1020)
@@ -59,32 +59,7 @@
 		template<> Rcomplex caster<gsl_complex_long_double,Rcomplex>( gsl_complex_long_double from) ;
     
     }
-	
-//    namespace RcppGsl {
-//    	template <typename T> struct contained	 ; /* not defined on purpose */
-//    	template <> struct contained<gsl_vector>{Êtypedef double type ;} ;
-//		template <> struct contained<gsl_vector_float>{Êtypedef float type ; } ; 
-//		template <> struct contained<gsl_vector_int>{ typedef int type; } ;
-//		template <> struct contained<gsl_vector_long>{ typedef long type ; } ;
-//		template <> struct contained<gsl_vector_char>{ typedef Rbyte type ; } ;
-//		template <> struct contained<gsl_vector_complex>{ typedef gsl_complex type ; } ;   
-//		template <> struct contained<gsl_vector_complex_float>{ typedef gsl_complex_float type ; };
-//		template <> struct contained<gsl_vector_complex_long_double>{ typedef gsl_complex_long_double type ; } ;
-//		template <> struct contained<gsl_vector_long_double>{ typedef long double type ; }
-//		template <> struct contained<gsl_vector_short>{Êtypedef short type ; }
-//		template <> struct contained<gsl_vector_uchar>{ typedef unsigned char type ; } ;
-//		template <> struct contained<gsl_vector_uint>{ typedef unsigned int type ; } ;
-//		template <> struct contained<gsl_vector_ushort>{ typedef unsigned short type ; } ;
-//		template <> struct contained<gsl_vector_ulong>{ typedef unsigned long type ; } ;
-//		
-//		template <typename T> struct needs_reinterpret : public ::Rcpp::traits::false_type{} ;
-//		template <> struct needs_reinterpret<gsl_vector_complex>  : public ::Rcpp::traits::true_type{} ;
-//		template <> struct needs_reinterpret<gsl_vector_complex_float>  : public ::Rcpp::traits::true_type{} ;
-//		template <> struct needs_reinterpret<gsl_vector_complex_long_double>  : public ::Rcpp::traits::true_type{} ;
-//		template <> struct needs_reinterpret<gsl_vector_char>  : public ::Rcpp::traits::true_type{} ;
-//	}
     
-    
 	template <> SEXP wrap( const gsl_vector& ) ;
 	template <> SEXP wrap( const gsl_vector_int& ) ;
 	template <> SEXP wrap( const gsl_vector_float& ) ;

Modified: pkg/RcppGSL/inst/include/RcppGSL_vector.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL_vector.h	2010-04-06 17:47:45 UTC (rev 1019)
+++ pkg/RcppGSL/inst/include/RcppGSL_vector.h	2010-04-06 19:55:04 UTC (rev 1020)
@@ -26,70 +26,57 @@
 
 namespace Rcpp{
 
-template <> SEXP wrap( const gsl_vector& x){
-	return wrap( x.data, x.data + x.size ) ;
+namespace RcppGsl{
+    
+	template <typename T> class gslvector_importer{
+	public:
+		typedef T r_import_type ; /* this is important */
+		
+	private:
+		r_import_type* data ;
+		int stride ;
+		int n ;
+		
+	public:
+		gslvector_importer( T* data_, int stride_, int n_) : data(data_), stride(stride_), n(n_){}
+		inline r_import_type get( int i) const {
+			return data[ i * stride ];
+		}
+		inline int size() const { return n ; }
+	} ;
+	
 }
 
-template <> SEXP wrap( const gsl_vector_float& x){
-	return wrap( x.data, x.data + x.size ) ;
-}
+#define RCPPGSL_WRAP(__TYPE__,__DATA__)                                                  \
+template <> SEXP wrap( const __TYPE__& x){                                               \
+	return wrap( RcppGsl::gslvector_importer<__DATA__>( x.data, x.stride, x.size ) ) ;   \
+} ;
 
-template <> SEXP wrap( const gsl_vector_int& x){
-	return wrap( x.data, x.data + x.size ) ;
-}
+#define RCPPGSL_WRAP_CAST(__TYPE__,__DATA__,__CAST__)                                   \
+template <> SEXP wrap( const __TYPE__& x){                                     \
+	return wrap( RcppGsl::gslvector_importer<__DATA__>(                                  \
+		reinterpret_cast<__CAST__>(x.data), x.stride, x.size ) ) ;             \
+} ;
 
-template <> SEXP wrap( const gsl_vector_long& x){
-	return wrap( x.data, x.data + x.size ) ;
-}
+RCPPGSL_WRAP(gsl_vector             , double)
+RCPPGSL_WRAP(gsl_vector_float       , float)
+RCPPGSL_WRAP(gsl_vector_int         , int)
+RCPPGSL_WRAP(gsl_vector_long        , long)
+RCPPGSL_WRAP(gsl_vector_long_double , long double)
+RCPPGSL_WRAP(gsl_vector_short       , short)
+RCPPGSL_WRAP(gsl_vector_uchar       , unsigned char)
+RCPPGSL_WRAP(gsl_vector_uint        , unsigned int)
+RCPPGSL_WRAP(gsl_vector_ushort      , unsigned short)
+RCPPGSL_WRAP(gsl_vector_ulong       , unsigned long)
 
-template <> SEXP wrap( const gsl_vector_char& x){
-	return wrap( 
-		reinterpret_cast<Rbyte* const>(x.data), 
-		reinterpret_cast<Rbyte* const>(x.data) + x.size ) ;	
-}
+RCPPGSL_WRAP_CAST(gsl_vector_char               ,unsigned char          , Rbyte* const)
+RCPPGSL_WRAP_CAST(gsl_vector_complex            ,gsl_complex            ,gsl_complex*)
+RCPPGSL_WRAP_CAST(gsl_vector_complex_float      ,gsl_complex_float      ,gsl_complex_float*)
+RCPPGSL_WRAP_CAST(gsl_vector_complex_long_double,gsl_complex_long_double,gsl_complex_long_double*)
 
-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 ) ;	
-}
+#undef RCPPGSL_WRAP_CAST
+#undef RCPPGSL_WRAP
 
-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