[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