[Rcpp-commits] r1314 - in pkg/RcppGSL: inst inst/include inst/unitTests src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue May 25 12:52:19 CEST 2010
Author: romain
Date: 2010-05-25 12:52:19 +0200 (Tue, 25 May 2010)
New Revision: 1314
Modified:
pkg/RcppGSL/inst/ChangeLog
pkg/RcppGSL/inst/include/RcppGSLForward.h
pkg/RcppGSL/inst/include/RcppGSL_matrix_view.h
pkg/RcppGSL/inst/include/RcppGSL_vector_view.h
pkg/RcppGSL/inst/unitTests/runit.gsl.R
pkg/RcppGSL/src/RcppGSL.cpp
Log:
RcppGSL::vector_view and RcppGSL::matrix_view
Modified: pkg/RcppGSL/inst/ChangeLog
===================================================================
--- pkg/RcppGSL/inst/ChangeLog 2010-05-25 09:14:58 UTC (rev 1313)
+++ pkg/RcppGSL/inst/ChangeLog 2010-05-25 10:52:19 UTC (rev 1314)
@@ -11,6 +11,8 @@
* src/Makevars.win: use Brian Ripley's suggestions to anticipate R 2.12.0
+ * inst/include/*.h: RcppGSL::vector_view and RcppGSL::matrix_view
+
2010-05-13 Dirk Eddelbuettel <edd at debian.org>
* R/fastLm.R: fastLm is now generic and behaves similar to lm():
Modified: pkg/RcppGSL/inst/include/RcppGSLForward.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSLForward.h 2010-05-25 09:14:58 UTC (rev 1313)
+++ pkg/RcppGSL/inst/include/RcppGSLForward.h 2010-05-25 10:52:19 UTC (rev 1314)
@@ -96,9 +96,18 @@
namespace RcppGSL{
template <typename T> class vector ;
template <typename T> class matrix ;
+ template <typename T> struct vector_view_type ;
+ template <typename T> struct matrix_view_type ;
+
#undef _RCPPGSL_SPEC
#define _RCPPGSL_SPEC(__T__,__SUFFIX__,__CAST__) \
+template <> struct vector_view_type<__T__> { \
+ typedef gsl_vector##__SUFFIX__##_view type ; \
+} ; \
+template <> struct matrix_view_type<__T__> { \
+ typedef gsl_matrix##__SUFFIX__##_view type ; \
+} ; \
template <> class vector<__T__> { \
public: \
typedef __T__ type ; \
@@ -215,6 +224,51 @@
#undef _RCPPGSL_SPEC
+template <typename T> class vector_view {
+public:
+ typedef vector<T> VEC ;
+ typedef typename vector<T>::type type ;
+ typedef typename vector<T>::iterator iterator ;
+
+ typedef typename vector<T>::gsltype gsltype ;
+ typedef typename vector_view_type<T>::type view_type ;
+ typedef typename vector<T>::Proxy Proxy ;
+
+ vector_view( view_type view_ ) : view(view_), vec(&view_.vector) {}
+ inline Proxy operator[]( int i){
+ return vec[i] ;
+ }
+ inline iterator begin(){ return vec.begin() ; }
+ inline iterator end(){ return vec.end() ; }
+ inline size_t size(){ return vec.size(); }
+
+ view_type view ;
+private:
+ VEC vec ;
+} ;
+
+template <typename T> class matrix_view {
+public:
+ typedef matrix<T> MAT ;
+ typedef typename matrix<T>::type type ;
+ typedef typename matrix<T>::gsltype gsltype ;
+ typedef typename matrix_view_type<T>::type view_type ;
+ typedef typename matrix<T>::Proxy Proxy ;
+
+ matrix_view( view_type view_ ) : view(view_), mat(&view_.matrix) {}
+
+ inline Proxy operator()(int row, int col){
+ return mat(row,col);
+ }
+ inline size_t nrow(){ return mat.nrow() ; }
+ inline size_t ncol(){ return mat.ncol() ; }
+ inline size_t size(){ return mat.size() ; }
+
+ view_type view ;
+private:
+ MAT mat ;
+} ;
+
}
@@ -247,7 +301,10 @@
template <typename T> SEXP wrap( const ::RcppGSL::vector<T>& ) ;
template <typename T> SEXP wrap( const ::RcppGSL::matrix<T>& ) ;
-
+
+ template <typename T> SEXP wrap( const ::RcppGSL::vector_view<T>& ) ;
+ template <typename T> SEXP wrap( const ::RcppGSL::matrix_view<T>& ) ;
+
}
#endif
Modified: pkg/RcppGSL/inst/include/RcppGSL_matrix_view.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL_matrix_view.h 2010-05-25 09:14:58 UTC (rev 1313)
+++ pkg/RcppGSL/inst/include/RcppGSL_matrix_view.h 2010-05-25 10:52:19 UTC (rev 1314)
@@ -51,6 +51,10 @@
RCPPGSL_VIEW(_ulong)
#undef RCPPGSL_VIEW
+template <typename T> SEXP wrap( const ::RcppGSL::matrix_view<T>& x){
+ return wrap( x.view.matrix ) ;
+}
+
}
#endif
Modified: pkg/RcppGSL/inst/include/RcppGSL_vector_view.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL_vector_view.h 2010-05-25 09:14:58 UTC (rev 1313)
+++ pkg/RcppGSL/inst/include/RcppGSL_vector_view.h 2010-05-25 10:52:19 UTC (rev 1314)
@@ -51,6 +51,10 @@
RCPPGSL_VIEW(_ulong)
#undef RCPPGSL_VIEW
+template <typename T> SEXP wrap( const ::RcppGSL::vector_view<T>& x){
+ return wrap( x.view.vector ) ;
+}
+
}
#endif
Modified: pkg/RcppGSL/inst/unitTests/runit.gsl.R
===================================================================
--- pkg/RcppGSL/inst/unitTests/runit.gsl.R 2010-05-25 09:14:58 UTC (rev 1313)
+++ pkg/RcppGSL/inst/unitTests/runit.gsl.R 2010-05-25 10:52:19 UTC (rev 1314)
@@ -98,11 +98,20 @@
checkEquals( res,
list( even = 2.0 * 0:4, odd = 2.0 * 0:4 + 1.0 ),
msg = "wrap( gsl.vector.view )" )
+
+ res <- .Call( "test_gsl_vector_view_wrapper", PACKAGE = "RcppGSL" )
+ checkEquals( res,
+ list( even = 2.0 * 0:4, odd = 2.0 * 0:4 + 1.0 ),
+ msg = "wrap( gsl.vector.view.wrapper )" )
}
test.gsl.matrix.view <- function(){
res <- .Call( "test_gsl_matrix_view", PACKAGE = "RcppGSL" )
checkEquals( res$full[3:4, 3:4], res$view, msg = "wrap(gsl.matrix.view)" )
+
+ res <- .Call( "test_gsl_matrix_view_wrapper", PACKAGE = "RcppGSL" )
+ checkEquals( res$full[3:4, 3:4], res$view, msg = "wrap(gsl.matrix.view.wrapper)" )
+
}
test.gsl.vector.input.SEXP <- function(){
@@ -139,3 +148,14 @@
checkEquals( res, m+1 )
}
+test.gsl.RcppGSL.vector.view.iterating <- function(){
+ x <- seq(1.5, 10.5)
+ res <- .Call( "test_gsl_vector_view_iterating", x, PACKAGE = "RcppGSL" )
+ checkEquals( res, sum( x[ seq(1, length(x), by = 2 ) ] ) )
+}
+
+test.gsl.RcppGSL.matrix.view.indexing <- function(){
+ res <- .Call( "test_gsl_matrix_view_indexing", PACKAGE = "RcppGSL" )
+ checkEquals( res, 110.0 )
+}
+
Modified: pkg/RcppGSL/src/RcppGSL.cpp
===================================================================
--- pkg/RcppGSL/src/RcppGSL.cpp 2010-05-25 09:14:58 UTC (rev 1313)
+++ pkg/RcppGSL/src/RcppGSL.cpp 2010-05-25 10:52:19 UTC (rev 1314)
@@ -233,7 +233,7 @@
double res = 0.0 ;
for( int i=0; i<nr; i++){
res += gsl_matrix_get( mat, i, 0 ) ;
- }
+ }
mat.free() ;
return res ;
}
@@ -248,23 +248,96 @@
return x ;
}
-RCPP_FUNCTION_1(RcppGSL::vector<double>, test_gsl_vector_indexing, RcppGSL::vector<double> vec ){
+RCPP_FUNCTION_1(Rcpp::NumericVector, test_gsl_vector_indexing, RcppGSL::vector<double> vec ){
for( size_t i=0; i< vec.size(); i++){
vec[i] = vec[i] + 1.0 ;
}
- return vec ;
+ NumericVector res = Rcpp::wrap( vec ) ;
+ vec.free() ;
+ return res ;
}
RCPP_FUNCTION_1(double, test_gsl_vector_iterating, RcppGSL::vector<double> vec ){
- return std::accumulate( vec.begin(), vec.end(), 0.0 );
+ double res= std::accumulate( vec.begin(), vec.end(), 0.0 );
+ vec.free() ;
+ return res ;
}
-RCPP_FUNCTION_1(RcppGSL::matrix<double>, test_gsl_matrix_indexing, RcppGSL::matrix<double> mat ){
+RCPP_FUNCTION_1(Rcpp::NumericMatrix, test_gsl_matrix_indexing, RcppGSL::matrix<double> mat ){
for( size_t i=0; i< mat.nrow(); i++){
for( size_t j=0; j< mat.ncol(); j++){
mat(i,j) = mat(i,j) + 1.0 ;
}
}
- return mat ;
+ Rcpp::NumericMatrix res = Rcpp::wrap(mat) ;
+ mat.free() ;
+ return res ;
}
+RCPP_FUNCTION_0(Rcpp::List, test_gsl_vector_view_wrapper ){
+ int n = 10 ;
+ RcppGSL::vector<double> vec( 10 ) ;
+ for( int i=0 ; i<n; i++){
+ vec[i] = i ;
+ }
+ RcppGSL::vector_view<double> v_even = gsl_vector_subvector_with_stride(vec, 0, 2, n/2);
+ RcppGSL::vector_view<double> v_odd = gsl_vector_subvector_with_stride(vec, 1, 2, n/2);
+
+ List res = List::create(
+ _["even"] = v_even,
+ _["odd" ] = v_odd
+ ) ;
+ vec.free() ;
+
+ return res ;
+}
+
+RCPP_FUNCTION_0( Rcpp::List, test_gsl_matrix_view_wrapper ){
+ int nrow = 4 ;
+ int ncol = 6 ;
+ RcppGSL::matrix<double> m(nrow, ncol);
+ int k =0 ;
+ for( int i=0 ; i<nrow; i++){
+ for( int j=0; j<ncol; j++, k++){
+ m(i, j) = k ;
+ }
+ }
+ RcppGSL::matrix_view<double> x = gsl_matrix_submatrix(m, 2, 2, 2, 2 ) ;
+
+ List res = List::create(
+ _["full"] = m,
+ _["view"] = x
+ ) ;
+ m.free() ;
+
+ return res ;
+}
+
+RCPP_FUNCTION_1(double, test_gsl_vector_view_iterating, RcppGSL::vector<double> vec ){
+ int n = vec.size() ;
+ RcppGSL::vector_view<double> v_even = gsl_vector_subvector_with_stride(vec, 0, 2, n/2);
+ double res = std::accumulate( v_even.begin(), v_even.end(), 0.0 );
+ return res ;
+}
+
+RCPP_FUNCTION_0( double,test_gsl_matrix_view_indexing ){
+ int nr = 10 ;
+ int nc = 10 ;
+ RcppGSL::matrix<double> mat( nr, nc ) ;
+ int k = 0;
+ for( size_t i=0; i< mat.nrow(); i++){
+ for( size_t j=0; j< mat.ncol(); j++, k++){
+ mat(i,j) = k ;
+ }
+ }
+ RcppGSL::matrix_view<double> x = gsl_matrix_submatrix(mat, 2, 2, 2, 2 ) ;
+ double res = 0.0 ;
+ for( size_t i=0; i<x.nrow(); i++){
+ for( size_t j=0; j<x.ncol(); j++){
+ res += x(i,j) ;
+ }
+ }
+ mat.free() ;
+ return res ;
+}
+
More information about the Rcpp-commits
mailing list