[Rcpp-commits] r775 - in pkg/RcppArmadillo: inst inst/include inst/unitTests src

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

Author: romain
Date: 2010-02-23 11:05:56 +0100 (Tue, 23 Feb 2010)
New Revision: 775

Modified:
   pkg/RcppArmadillo/inst/ChangeLog
   pkg/RcppArmadillo/inst/include/RcppArmadillo.h
   pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R
   pkg/RcppArmadillo/src/RcppArmadillo.cpp
Log:
support wrap(Glue) and wrap(Op) so that we can wrap arbitrary operations on matrices

Modified: pkg/RcppArmadillo/inst/ChangeLog
===================================================================
--- pkg/RcppArmadillo/inst/ChangeLog	2010-02-22 14:40:40 UTC (rev 774)
+++ pkg/RcppArmadillo/inst/ChangeLog	2010-02-23 10:05:56 UTC (rev 775)
@@ -1,3 +1,13 @@
+2010-02-23  Romain Francois <romain at r-enthusiasts.com>
+
+	* inst/include/RcppArmadillo.h: support for wrap( arma::Glue )
+	and wrap( arma::Op ) enabling wrap()'ing arbitrary expressions
+	involving arma::Mat objects, for example wrap( m1 + m2 ), or 
+	wrap( -m1 ) 
+	
+	* inst/unitTests/runit.RcppArmadillo.R: new unit test for 
+	wrap( Glue ) and wrap( Op )
+
 2010-02-20  Dirk Eddelbuettel  <edd at debian.org>
 
 	* configure.in: Add configure support to test for presence of

Modified: pkg/RcppArmadillo/inst/include/RcppArmadillo.h
===================================================================
--- pkg/RcppArmadillo/inst/include/RcppArmadillo.h	2010-02-22 14:40:40 UTC (rev 774)
+++ pkg/RcppArmadillo/inst/include/RcppArmadillo.h	2010-02-23 10:05:56 UTC (rev 775)
@@ -38,6 +38,12 @@
     template <typename T> SEXP wrap ( const arma::Cube<T>& ) ;
     #endif
 
+    template <typename T1, typename T2, typename glue_type> 
+    SEXP wrap(const arma::Glue<T1, T2, glue_type>& X ) ;
+    
+    template <typename T1, typename op_type>
+    SEXP wrap(const arma::Op<T1, op_type>& X ) ;
+    
     namespace traits {
 
 	/* support for as */
@@ -109,14 +115,26 @@
 
     } // namespace RcppArmadillo
 
-    template <typename T> SEXP wrap( const arma::field<T>& data){
+    template <typename T> 
+    SEXP wrap( const arma::field<T>& data){
 	RObject x = wrap( RcppArmadillo::FieldImporter<T>( data ) ) ;
 	x.attr("dim" ) = Dimension( data.n_rows, data.n_cols ) ;
 	return x ;
-}
+    }
+    
+    /* TODO: maybe we could use the advanced constructor to avoid creating the 
+             temporary Mat */
+    template <typename T1, typename T2, typename glue_type>
+    SEXP wrap(const arma::Glue<T1, T2, glue_type>& X ){
+    	    return wrap( arma::Mat<typename T1::elem_type>(X) ) ;
+    }
 
+    template <typename T1, typename op_type>
+    SEXP wrap(const arma::Op<T1, op_type>& X ){
+    	    return wrap( arma::Mat<typename T1::elem_type>(X) ) ;
+    }
 
-/* support for Rcpp::as */
+    /* support for Rcpp::as */
 
     namespace traits {
 	

Modified: pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R
===================================================================
--- pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R	2010-02-22 14:40:40 UTC (rev 774)
+++ pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R	2010-02-23 10:05:56 UTC (rev 775)
@@ -18,7 +18,7 @@
 # along with RcppArmadillo.  If not, see <http://www.gnu.org/licenses/>.
 
 test.wrap.R <- function(){
-	res <- .Call( "RcppArmadillo_wrap" )
+	res <- .Call( "RcppArmadillo_wrap", PACKAGE = "RcppArmadillo" )
 	
 	checkEquals( res[[1]][[1]], matrix(as.integer((diag(3))),nr=3), msg = "eye<imat>(3,3)" )
 	checkEquals( res[[1]][[2]], diag(3), msg = "eye<mat>(3,3)" )
@@ -35,6 +35,16 @@
 	checkEquals( res[[4]][[2]], matrix(letters[1:4], ncol = 2, nrow=2), msg = "field<std::string>" )
 }                           
 
+test.wrap.Glue <- function(){
+	res <- .Call( "RcppArmadillo_wrap_Glue", PACKAGE = "RcppArmadillo" )
+	checkEquals( res[[1]], 2*diag(3), msg = "wrap(Glue)" )
+}
+
+test.wrap.Op <- function(){
+	res <- .Call( "RcppArmadillo_wrap_Op", PACKAGE = "RcppArmadillo" )
+	checkEquals( res[[1]], -1*diag(3), msg = "wrap(Op)" )
+}
+
 test.as.Mat <- function(){
 	
 	integer_mat <- matrix( as.integer(diag(4)), ncol = 4, nrow = 4 )

Modified: pkg/RcppArmadillo/src/RcppArmadillo.cpp
===================================================================
--- pkg/RcppArmadillo/src/RcppArmadillo.cpp	2010-02-22 14:40:40 UTC (rev 774)
+++ pkg/RcppArmadillo/src/RcppArmadillo.cpp	2010-02-23 10:05:56 UTC (rev 775)
@@ -138,3 +138,21 @@
 	
 }
 
+extern "C" SEXP RcppArmadillo_wrap_Glue(){
+	
+	arma::mat m1 = eye<mat>( 3, 3 ) ;
+	arma::mat m2 = eye<mat>( 3, 3 ) ;
+	
+	List res ;
+	res["mat+mat"] = m1 + m2 ;
+	return res ;
+}
+
+extern "C" SEXP RcppArmadillo_wrap_Op(){
+	arma::mat m1 = eye<mat>( 3, 3 ) ;
+	
+	List res ;
+	res["mat+mat"] = - m1 ;
+	return res ;
+	
+}