[Rcpp-commits] r1021 - pkg/RcppGSL/inst/include
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Apr 7 09:18:49 CEST 2010
Author: romain
Date: 2010-04-07 09:18:49 +0200 (Wed, 07 Apr 2010)
New Revision: 1021
Added:
pkg/RcppGSL/inst/include/RcppGSL_vector_view.h
Modified:
pkg/RcppGSL/inst/include/RcppGSL.h
pkg/RcppGSL/inst/include/RcppGSLForward.h
pkg/RcppGSL/inst/include/RcppGSL_matrix.h
pkg/RcppGSL/inst/include/RcppGSL_vector.h
Log:
added support for gsl_vector_*_view and corrected matrix handling (taking care of the tda)
Modified: pkg/RcppGSL/inst/include/RcppGSL.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL.h 2010-04-06 19:55:04 UTC (rev 1020)
+++ pkg/RcppGSL/inst/include/RcppGSL.h 2010-04-07 07:18:49 UTC (rev 1021)
@@ -26,5 +26,6 @@
#include <RcppGSL_caster.h>
#include <RcppGSL_vector.h>
#include <RcppGSL_matrix.h>
+#include <RcppGSL_vector_view.h>
#endif
Modified: pkg/RcppGSL/inst/include/RcppGSLForward.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSLForward.h 2010-04-06 19:55:04 UTC (rev 1020)
+++ pkg/RcppGSL/inst/include/RcppGSLForward.h 2010-04-07 07:18:49 UTC (rev 1021)
@@ -57,7 +57,6 @@
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& ) ;
@@ -75,6 +74,20 @@
template <> SEXP wrap( const gsl_vector_ushort& ) ;
template <> SEXP wrap( const gsl_vector_ulong& ) ;
+ template <> SEXP wrap( const gsl_vector_view& ) ;
+ template <> SEXP wrap( const gsl_vector_int_view& ) ;
+ template <> SEXP wrap( const gsl_vector_float_view& ) ;
+ template <> SEXP wrap( const gsl_vector_long_view& ) ;
+ template <> SEXP wrap( const gsl_vector_char_view& ) ;
+ template <> SEXP wrap( const gsl_vector_complex_view& ) ;
+ template <> SEXP wrap( const gsl_vector_complex_float_view& ) ;
+ template <> SEXP wrap( const gsl_vector_complex_long_double_view& ) ;
+ template <> SEXP wrap( const gsl_vector_long_double_view& ) ;
+ template <> SEXP wrap( const gsl_vector_short_view& ) ;
+ template <> SEXP wrap( const gsl_vector_uchar_view& ) ;
+ template <> SEXP wrap( const gsl_vector_uint_view& ) ;
+ template <> SEXP wrap( const gsl_vector_ushort_view& ) ;
+ template <> SEXP wrap( const gsl_vector_ulong_view& ) ;
template <> SEXP wrap( const gsl_matrix& ) ;
template <> SEXP wrap( const gsl_matrix_int& ) ;
Modified: pkg/RcppGSL/inst/include/RcppGSL_matrix.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL_matrix.h 2010-04-06 19:55:04 UTC (rev 1020)
+++ pkg/RcppGSL/inst/include/RcppGSL_matrix.h 2010-04-07 07:18:49 UTC (rev 1021)
@@ -24,64 +24,75 @@
#include <Rcpp.h>
#include <RcppGSL_caster.h>
-namespace Rcpp{
+namespace Rcpp{
-template <> SEXP wrap( const gsl_matrix& x){
- return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
+namespace RcppGSL {
+
+ template <typename T> class gslmatrix_importer{
+ public:
+ typedef T r_import_type ; /* this is important */
+
+ private:
+ r_import_type* ptr ;
+ int size1 ;
+ int size2 ;
+ int tda ;
+
+ public:
+ gslmatrix_importer( r_import_type* ptr_, int size1_, int size2_, int tda_ ) :
+ ptr(ptr_), size1(size1_), size2(size2_), tda(tda_){};
+ inline int size() const { return size1 * size2 ; } ;
+ r_import_type get( int i) const {
+ int col = (int)( i / size1 ) ;
+ int row = i - col * size1 ;
+ return ptr[ row * tda + col ] ;
+ }
+ } ;
}
-template <> SEXP wrap( const gsl_matrix_float& x){
- return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
+#define RCPPGSL_WRAP(__TYPE__,__DATA__) \
+template <> SEXP wrap( const __TYPE__& x){ \
+ SEXP res = PROTECT( wrap( RcppGSL::gslmatrix_importer<__DATA__>( \
+ x.data, x.size1, x.size2, x.tda ) ) ); \
+ SEXP dims = PROTECT( ::Rf_allocVector( INTSXP, 2) ) ; \
+ INTEGER(dims)[0] = x.size1 ; \
+ INTEGER(dims)[1] = x.size2 ; \
+ ::Rf_setAttrib( res, R_DimSymbol, dims ) ; \
+ UNPROTECT(2) ; \
+ return res ; \
+ }
+#define RCPPGSL_WRAP_CAST(__TYPE__,__DATA__ ) \
+template <> SEXP wrap( const __TYPE__& x){ \
+ SEXP res = PROTECT( wrap( RcppGSL::gslmatrix_importer<__DATA__>( \
+ reinterpret_cast<__DATA__*>(x.data), \
+ x.size1, x.size2, x.tda ) ) ) ; \
+ SEXP dims = PROTECT( ::Rf_allocVector( INTSXP, 2) ) ; \
+ INTEGER(dims)[0] = x.size1 ; \
+ INTEGER(dims)[1] = x.size2 ; \
+ ::Rf_setAttrib( res, R_DimSymbol, dims ) ; \
+ UNPROTECT(2) ; \
+ return res ; \
}
-template <> SEXP wrap( const gsl_matrix_int& x){
- return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
-}
+RCPPGSL_WRAP(gsl_matrix , double)
+RCPPGSL_WRAP(gsl_matrix_float , float)
+RCPPGSL_WRAP(gsl_matrix_int , int)
+RCPPGSL_WRAP(gsl_matrix_long , long)
+RCPPGSL_WRAP(gsl_matrix_long_double , long double)
+RCPPGSL_WRAP(gsl_matrix_short , short)
+RCPPGSL_WRAP(gsl_matrix_uchar , unsigned char)
+RCPPGSL_WRAP(gsl_matrix_uint , unsigned int)
+RCPPGSL_WRAP(gsl_matrix_ushort , unsigned short)
+RCPPGSL_WRAP(gsl_matrix_ulong , unsigned long)
-template <> SEXP wrap( const gsl_matrix_long& x){
- return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
-}
+RCPPGSL_WRAP_CAST(gsl_matrix_char ,Rbyte )
+RCPPGSL_WRAP_CAST(gsl_matrix_complex ,gsl_complex )
+RCPPGSL_WRAP_CAST(gsl_matrix_complex_float ,gsl_complex_float )
+RCPPGSL_WRAP_CAST(gsl_matrix_complex_long_double,gsl_complex_long_double )
-template <> SEXP wrap( const gsl_matrix_char& x){
- return internal::rowmajor_wrap( reinterpret_cast<Rbyte*>(x.data), x.size1, x.size2 ) ;
-}
+#undef RCPPGSL_WRAP
+#undef RCPPGSL_WRAP_CAST
-template <> SEXP wrap( const gsl_matrix_complex& x){
- return internal::rowmajor_wrap( reinterpret_cast<gsl_complex*>(x.data), x.size1, x.size2 ) ;
-}
-
-template <> SEXP wrap( const gsl_matrix_complex_float& x){
- return internal::rowmajor_wrap( reinterpret_cast<gsl_complex_float*>(x.data), x.size1, x.size2 ) ;
-}
-
-template <> SEXP wrap( const gsl_matrix_complex_long_double& x){
- return internal::rowmajor_wrap( reinterpret_cast<gsl_complex_long_double*>(x.data), x.size1, x.size2 ) ;
-}
-
-template <> SEXP wrap( const gsl_matrix_long_double& x){
- return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
-}
-
-template <> SEXP wrap( const gsl_matrix_short& x){
- return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
-}
-
-template <> SEXP wrap( const gsl_matrix_uchar& x){
- return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
-}
-
-template <> SEXP wrap( const gsl_matrix_uint& x){
- return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
-}
-
-template <> SEXP wrap( const gsl_matrix_ushort& x){
- return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
-}
-
-template <> SEXP wrap( const gsl_matrix_ulong& x){
- return internal::rowmajor_wrap( x.data, x.size1, x.size2 ) ;
-}
-
}
#endif
Modified: pkg/RcppGSL/inst/include/RcppGSL_vector.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL_vector.h 2010-04-06 19:55:04 UTC (rev 1020)
+++ pkg/RcppGSL/inst/include/RcppGSL_vector.h 2010-04-07 07:18:49 UTC (rev 1021)
@@ -26,7 +26,7 @@
namespace Rcpp{
-namespace RcppGsl{
+namespace RcppGSL{
template <typename T> class gslvector_importer{
public:
@@ -47,15 +47,16 @@
}
-#define RCPPGSL_WRAP(__TYPE__,__DATA__) \
-template <> SEXP wrap( const __TYPE__& x){ \
- return wrap( RcppGsl::gslvector_importer<__DATA__>( x.data, x.stride, 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 ) ) ; \
} ;
-#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 ) ) ; \
+#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 ) ) ; \
} ;
RCPPGSL_WRAP(gsl_vector , double)
Added: pkg/RcppGSL/inst/include/RcppGSL_vector_view.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL_vector_view.h (rev 0)
+++ pkg/RcppGSL/inst/include/RcppGSL_vector_view.h 2010-04-07 07:18:49 UTC (rev 1021)
@@ -0,0 +1,55 @@
+// RcppGSL.h: Rcpp/GSL glue
+//
+// Copyright (C) 2010 Romain Francois and Dirk Eddelbuettel
+//
+// This file is part of RcppGSL.
+//
+// RcppGSL is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// RcppGSL is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with RcppGSL. If not, see <http://www.gnu.org/licenses/>.
+
+#ifndef RCPPGSL__RCPPGSL_VECTOR_H
+#define RCPPGSL__RCPPGSL_VECTOR_H
+
+#include <RcppGSLForward.h>
+#include <Rcpp.h>
+#include <RcppGSL_caster.h>
+
+namespace Rcpp{
+
+#define RCPPGSL_VIEW(SUFFIX) \
+template <> SEXP wrap( const gsl_vector##SUFFIX##_view& x){ \
+ return wrap(x->vector) ; \
+} ; \
+template <> SEXP wrap( const gsl_vector##SUFFIX##_const_view& x ){ \
+ return wrap(x->vector) ; \
+}
+
+RCPPGSL_VIEW()
+RCPPGSL_VIEW(_int) ;
+RCPPGSL_VIEW(_float) ;
+RCPPGSL_VIEW(_long) ;
+RCPPGSL_VIEW(_char) ;
+RCPPGSL_VIEW(_complex) ;
+RCPPGSL_VIEW(_complex_float) ;
+RCPPGSL_VIEW(_complex_long_double) ;
+RCPPGSL_VIEW(_long_double) ;
+RCPPGSL_VIEW(_short) ;
+RCPPGSL_VIEW(_uchar) ;
+RCPPGSL_VIEW(_uint) ;
+RCPPGSL_VIEW(_ushort) ;
+RCPPGSL_VIEW(_ulong) ;
+#undef RCPPGSL_VIEW
+
+}
+
+#endif
More information about the Rcpp-commits
mailing list