[Rcpp-commits] r1220 - in pkg/RcppGSL: inst inst/include inst/unitTests src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu May 13 11:07:09 CEST 2010


Author: romain
Date: 2010-05-13 11:07:09 +0200 (Thu, 13 May 2010)
New Revision: 1220

Modified:
   pkg/RcppGSL/inst/ChangeLog
   pkg/RcppGSL/inst/include/RcppGSLForward.h
   pkg/RcppGSL/inst/include/RcppGSL_matrix.h
   pkg/RcppGSL/inst/include/RcppGSL_matrix_view.h
   pkg/RcppGSL/inst/unitTests/runit.gsl.R
   pkg/RcppGSL/src/RcppGSL.cpp
Log:
added RcppGSL::matrix<T> and RcppGSL::matrix_view<T> classes

Modified: pkg/RcppGSL/inst/ChangeLog
===================================================================
--- pkg/RcppGSL/inst/ChangeLog	2010-05-13 07:53:36 UTC (rev 1219)
+++ pkg/RcppGSL/inst/ChangeLog	2010-05-13 09:07:09 UTC (rev 1220)
@@ -1,6 +1,8 @@
 2010-05-13  Romain Francois <romain at r-enthusiasts.com>
 
 	* inst/include/*.h: wrap specializations are now inline
+	
+	* inst/include/*.h: new classes RcppGSL::matrix<T> and RcppGSL::matrix_view<T>
 
 2010-05-12  Dirk Eddelbuettel  <edd at debian.org>
 

Modified: pkg/RcppGSL/inst/include/RcppGSLForward.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSLForward.h	2010-05-13 07:53:36 UTC (rev 1219)
+++ pkg/RcppGSL/inst/include/RcppGSLForward.h	2010-05-13 09:07:09 UTC (rev 1220)
@@ -96,6 +96,8 @@
 namespace RcppGSL{
 	template <typename T> class vector ;
 	template <typename T> class vector_view ;
+	template <typename T> class matrix ;
+	template <typename T> class matrix_view ;
 	
 #undef _RCPPGSL_SPEC
 #define _RCPPGSL_SPEC(__T__,__SUFFIX__,__CAST__)      	                        \
@@ -145,7 +147,51 @@
 		data = other.data ;                                                      \
 		return *this ;                                                           \
 	}                                                                            \
-} ;                                                                             \
+} ;                                                                              \
+template <> class matrix<__T__>  {           	                                   \
+public:                                      	                                   \
+	typedef __T__ type ;                     	                                   \
+	typedef __T__* pointer ;                 	                                   \
+	typedef gsl_matrix##__SUFFIX__ gsltype ; 	                                   \
+	gsltype* data ;                          	                                   \
+	const static int RTYPE = ::Rcpp::traits::r_sexptype_traits<type>::rtype ;    \
+	matrix( SEXP x) throw(::Rcpp::not_compatible) : data(0) { import(x); }       \
+	matrix( gsltype* x) : data(x) {}                                             \
+	matrix( int nrow, int ncol) :                                                \
+		data( gsl_matrix##__SUFFIX__##_alloc( nrow, ncol ) ){}                   \
+	~matrix(){ }                                                                 \
+	operator gsltype*(){ return data ; }                                         \
+	gsltype* operator->() const { return data; }                                 \
+	gsltype& operator*() const { return *data; }                                 \
+	matrix( const matrix& x) : data(x.data)  {}                                  \
+	matrix& operator=(const matrix& other) {                                     \
+		data = other.data ;                                                      \
+		return *this ;                                                           \
+	}                                                                            \
+	void free(){                                                                 \
+		gsl_matrix##__SUFFIX__##_free(data) ;                                    \
+	}                                                                            \
+private:                                                                         \
+	inline void import(SEXP x) throw(::Rcpp::not_compatible);                    \
+} ;                                                                              \
+template <> class matrix_view<__T__>  {           	                            \
+public:                                      	                                   \
+	typedef __T__ type ;                     	                                   \
+	typedef __T__* pointer ;                 	                                   \
+	typedef gsl_matrix##__SUFFIX__##_view gsltype ; 	                           \
+	gsltype* data ;                          	                                   \
+	matrix_view( gsltype* x) : data(x) {}                                        \
+	~matrix_view(){  }                                                           \
+	operator gsltype*(){ return data ; }                                         \
+	gsltype* operator->() const { return data; }                                 \
+	gsltype& operator*() const { return *data; }                                 \
+	matrix_view( const matrix_view& x) : data(x.data)  {}                        \
+	matrix_view& operator=(const matrix_view& other) {                           \
+		data = other.data ;                                                      \
+		return *this ;                                                           \
+	}                                                                            \
+} ;
+ 
 
 _RCPPGSL_SPEC(double                   ,                       , double                  )
 _RCPPGSL_SPEC(float                    , _float                , float                   )
@@ -196,6 +242,8 @@
 
 	template <typename T> SEXP wrap( const ::RcppGSL::vector<T>& ) ;
 	template <typename T> SEXP wrap( const ::RcppGSL::vector_view<T>& ) ;
+	template <typename T> SEXP wrap( const ::RcppGSL::matrix<T>& ) ;
+	template <typename T> SEXP wrap( const ::RcppGSL::matrix_view<T>& ) ;
 	 
 }
 

Modified: pkg/RcppGSL/inst/include/RcppGSL_matrix.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL_matrix.h	2010-05-13 07:53:36 UTC (rev 1219)
+++ pkg/RcppGSL/inst/include/RcppGSL_matrix.h	2010-05-13 09:07:09 UTC (rev 1220)
@@ -94,6 +94,85 @@
 #undef RCPPGSL_WRAP
 #undef RCPPGSL_WRAP_CAST
 
+}
+
+namespace RcppGSL {
+
+#undef _RCPPGSL_DEF
+#define _RCPPGSL_DEF(__T__,__SUFFIX__)                                      \
+inline void matrix<__T__>::import( SEXP x) throw(::Rcpp::not_compatible) {  \
+	Rcpp::Matrix<RTYPE> mat( x );                                           \
+	int nc = mat.ncol() ;                                                   \
+	int nr = mat.nrow() ;                                                   \
+	int i = 0, j = 0 ;                                                      \
+	data = gsl_matrix##__SUFFIX__##_alloc( nr, nc ) ;                       \
+	Rcpp::Matrix<RTYPE>::iterator it = mat.begin() ;                        \
+	for( ; j<nc; j++){                                                      \
+		for( i=0; i<nr; i++, it++){                                         \
+			gsl_matrix##__SUFFIX__##_set( data, i, j, *it ) ;               \
+		}                                                                   \
+	}                                                                       \
+}
+#undef _RCPPGSL_DEF_CAST
+#define _RCPPGSL_DEF_CAST(__T__,__SUFFIX__,__CAST__)                        \
+inline void matrix<__T__>::import( SEXP x) throw(::Rcpp::not_compatible){   \
+	Rcpp::Matrix<RTYPE> mat( x );                                           \
+	int nc = mat.ncol() ;                                                   \
+	int nr = mat.nrow() ;                                                   \
+	int i = 0, j = 0 ;                                                      \
+	data = gsl_matrix##__SUFFIX__##_alloc( nr, nc ) ;                       \
+	Rcpp::Matrix<RTYPE>::iterator it = mat.begin() ;                        \
+	typedef Rcpp::traits::storage_type<RTYPE>::type STORAGE ;               \
+	for( ; j<nc; j++){                                                      \
+		for( i=0; i<nr; i++, it++){                                         \
+			gsl_matrix##__SUFFIX__##_set( data, i, j,                       \
+				Rcpp::internal::caster<STORAGE,__CAST__>(*it) ) ;           \
+		}                                                                   \
+	}                                                                       \
+}
+
+_RCPPGSL_DEF(double                   ,        )
+_RCPPGSL_DEF(int                      , _int   )
+_RCPPGSL_DEF(unsigned char            , _uchar )
+
+_RCPPGSL_DEF_CAST(float                    , _float                , float                   )
+_RCPPGSL_DEF_CAST(long                     , _long                 , long                    )
+_RCPPGSL_DEF_CAST(long double              , _long_double          , long double             )
+_RCPPGSL_DEF_CAST(short                    , _short                , short                   )
+_RCPPGSL_DEF_CAST(unsigned int             , _uint                 , unsigned int            )
+_RCPPGSL_DEF_CAST(unsigned short           , _ushort               , unsigned short          )
+_RCPPGSL_DEF_CAST(unsigned long            , _ulong                , unsigned long           )
+_RCPPGSL_DEF_CAST(gsl_complex              , _complex              , gsl_complex             )
+_RCPPGSL_DEF_CAST(gsl_complex_float        , _complex_float        , gsl_complex_float       )
+_RCPPGSL_DEF_CAST(gsl_complex_long_double  , _complex_long_double  , gsl_complex_long_double )
+
+inline void matrix<char>::import( SEXP x) throw(::Rcpp::not_compatible){
+	Rcpp::Matrix<RAWSXP> mat( x );                                        
+	int nc = mat.ncol() ;                                                
+	int nr = mat.nrow() ;                                                
+	int i = 0, j = 0 ;                                                   
+	data = gsl_matrix_char_alloc( nr, nc ) ;                    
+	Rcpp::Matrix<RAWSXP>::iterator it = mat.begin() ;                     
+	for( ; j<nc; j++){                                                   
+		for( i=0; i<nr; i++, it++){                                      
+			gsl_matrix_char_set( data, i, j,                    
+				static_cast<char>(*it) ) ;        
+		}                                                                
+	}                                                                    
+}
+
+#undef _RCPPGSL_DEF
+#undef _RCPPGSL_DEF_CAST
+	
+}
+
+
+namespace Rcpp{
+
+template <typename T> SEXP wrap( const ::RcppGSL::matrix<T>& x){
+	return wrap( *(x.data) ) ;
+}
+
 } 
 
 #endif

Modified: pkg/RcppGSL/inst/include/RcppGSL_matrix_view.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL_matrix_view.h	2010-05-13 07:53:36 UTC (rev 1219)
+++ pkg/RcppGSL/inst/include/RcppGSL_matrix_view.h	2010-05-13 09:07:09 UTC (rev 1220)
@@ -51,6 +51,10 @@
 RCPPGSL_VIEW(_ulong)
 #undef RCPPGSL_VIEW
 
+template <typename T> SEXP wrap( const ::RcppGSL::matrix_view<T>& x){
+	return wrap( *(x.data) ) ;
+}
+
 } 
 
 #endif

Modified: pkg/RcppGSL/inst/unitTests/runit.gsl.R
===================================================================
--- pkg/RcppGSL/inst/unitTests/runit.gsl.R	2010-05-13 07:53:36 UTC (rev 1219)
+++ pkg/RcppGSL/inst/unitTests/runit.gsl.R	2010-05-13 09:07:09 UTC (rev 1220)
@@ -111,3 +111,9 @@
 	checkEquals( res, sum(x), msg = "RcppGSL::vector<double>(SEXP)" )
 }
 
+test.gsl.matrix.input.SEXP <- function(){
+	x <- matrix( rnorm(20), nc = 4 )
+	res <- .Call( "test_gsl_matrix_input", x, PACKAGE = "RcppGSL" )
+	checkEquals( res, sum(x[,1]), msg = "RcppGSL::matrix<double>(SEXP)" )
+}
+

Modified: pkg/RcppGSL/src/RcppGSL.cpp
===================================================================
--- pkg/RcppGSL/src/RcppGSL.cpp	2010-05-13 07:53:36 UTC (rev 1219)
+++ pkg/RcppGSL/src/RcppGSL.cpp	2010-05-13 09:07:09 UTC (rev 1220)
@@ -227,3 +227,14 @@
 	return res ;
 }
 
+RCPP_FUNCTION_1( double, test_gsl_matrix_input, RcppGSL::matrix<double> mat){
+	int nr = mat->size1 ;
+	
+	double res = 0.0 ;
+	for( int i=0; i<nr; i++){
+		res += gsl_matrix_get( mat, i, 0 ) ;
+	}
+	mat.free() ;
+	return res ;
+}
+



More information about the Rcpp-commits mailing list