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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Aug 17 12:15:41 CEST 2010


Author: romain
Date: 2010-08-17 12:15:41 +0200 (Tue, 17 Aug 2010)
New Revision: 2036

Modified:
   pkg/RcppArmadillo/inst/include/RcppArmadilloSugar.h
   pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R
Log:
handling the special case of complex vectors

Modified: pkg/RcppArmadillo/inst/include/RcppArmadilloSugar.h
===================================================================
--- pkg/RcppArmadillo/inst/include/RcppArmadilloSugar.h	2010-08-17 09:42:25 UTC (rev 2035)
+++ pkg/RcppArmadillo/inst/include/RcppArmadilloSugar.h	2010-08-17 10:15:41 UTC (rev 2036)
@@ -39,6 +39,7 @@
 		){
 			const SUGAR& m = in.m ;
 			int n = m.size() ;
+			// deal with dimensions
 			out.set_size( n, 1 ) ;
 			mat_iterator first = out.begin(), last = out.end();
 			// perhaps we should just use std::copy
@@ -46,9 +47,50 @@
 				*first++ = m[i];
 			}
 		}
-	  
 	} ;
 
+	template <bool NA, typename T>
+	class Complex_Imposter {
+		public:
+			typedef typename Rcpp::VectorBase<CPLXSXP,NA,T> SUGAR_EXP ;
+			typedef std::complex<double> elem_type ;
+		
+			Complex_Imposter( const SUGAR_EXP& vec_) : vec(vec_){}
+			inline int size() const { return vec.size() ; }
+			inline std::complex<double> operator[]( int i ) const {
+				Rcomplex x = vec[i] ;
+				return std::complex<double>( x.r, x.i ) ;
+			}
+			
+		private:
+			const SUGAR_EXP& vec ;
+	} ;
+
+	
+	
+	template <bool NA, typename T>
+	class r_complex_forward {
+		public:
+			typedef std::complex<double> T1 ;
+			typedef Complex_Imposter<NA,T> SUGAR ;
+			typedef arma::Mat<T1>::iterator mat_iterator ;
+		
+		inline static void apply(
+			arma::Mat<T1>& out, 
+			const arma::Op< Complex_Imposter<NA,T> , r_complex_forward<NA,T> >& in
+		){
+			const SUGAR& m = in.m ;
+			int n = m.size() ;
+			// deal with dimensions
+			out.set_size( n, 1 ) ;
+			mat_iterator first = out.begin(), last = out.end();
+			for( int i=0; first != last ; ++i){
+				*first++ = m[i] ;
+			}
+		}
+			
+	} ;
+	
 }
 
 
@@ -62,6 +104,19 @@
 }
 
 
+template <bool NA, typename T>
+inline arma::Op< 
+	RcppArmadillo::Complex_Imposter<NA,T> , 
+	RcppArmadillo::r_complex_forward<NA,T>
+>
+forward( const VectorBase<CPLXSXP,NA,T>& x ) {
+	return arma::Op< 
+		RcppArmadillo::Complex_Imposter<NA,T> ,
+		RcppArmadillo::r_complex_forward<NA,T> >( x ) ;
+}
+
+
+
 } // Rcpp
 
 #endif

Modified: pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R
===================================================================
--- pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R	2010-08-17 09:42:25 UTC (rev 2035)
+++ pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R	2010-08-17 10:15:41 UTC (rev 2036)
@@ -254,3 +254,20 @@
 	
 }
 
+test.sugar.cplx <- function(){
+
+	fx <- cxxfunction( signature(x= "complex") , '
+	ComplexVector xx(x) ;
+	arma::cx_mat m = forward( exp( xx ) ) ; 
+	
+    return wrap( m ) ;
+    
+	', plugin = "RcppArmadillo" )
+	x <- 1:10*(1+1i) 
+	checkEquals( fx(x), 
+		matrix( exp(x), nrow = 10 ) , 
+		msg = "RcppArmadillo and sugar (complex)" )
+	
+}
+
+



More information about the Rcpp-commits mailing list