[Rcpp-commits] r3124 - pkg/RcppEigen/inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jul 9 18:10:00 CEST 2011
Author: dmbates
Date: 2011-07-09 18:10:00 +0200 (Sat, 09 Jul 2011)
New Revision: 3124
Added:
pkg/RcppEigen/inst/unitTests/runit.RcppEigen.R
Log:
Added tests of wrap and as. Need to create an as method for mapped arrays.
Added: pkg/RcppEigen/inst/unitTests/runit.RcppEigen.R
===================================================================
--- pkg/RcppEigen/inst/unitTests/runit.RcppEigen.R (rev 0)
+++ pkg/RcppEigen/inst/unitTests/runit.RcppEigen.R 2011-07-09 16:10:00 UTC (rev 3124)
@@ -0,0 +1,417 @@
+#!/usr/bin/r -t
+#
+# Copyright (C) 2011 Douglas Bates, Dirk Eddelbuettel and Romain Francois
+#
+# This file is part of RcppEigen
+#
+# RcppEigen 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.
+#
+# RcppEigen 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 RcppEigen. If not, see <http://www.gnu.org/licenses/>.
+
+.setUp <- function(){
+ suppressMessages(require(inline))
+}
+
+test.wrap.R <- function(){
+
+ fx <- cxxfunction( , '
+
+ // The eval() method is necessary because the static methods Zero()
+ // and Identity() return expression objects, so that more general
+ // expressions involving them can be evaluated more effectively. We
+ // have not yet written a wrap method for expression objects.
+ List vecs = List::create(
+ _["Vec<complex>"] = Eigen::VectorXcd::Zero(5).eval(),
+ _["Vec<double>"] = Eigen::VectorXd::Zero(5).eval(),
+ _["Vec<float>"] = Eigen::VectorXf::Zero(5).eval(),
+ _["Vec<int>"] = Eigen::VectorXi::Zero(5).eval()
+ );
+
+ // A VectorX<T> behaves as a matrix with one column but is converted to
+ // a vector object in R, not a matrix of one column. The distinction is
+ // that VectorX<T> objects are defined at compile time to have one column,
+ // whereas a MatrixX<T> has a dynamic number of columns that is set to 1
+ // during execution of the code. A MatrixX<T> object can be resized to have
+ // a different number of columns. A VectorX<T> object cannot.
+ List cols = List::create(
+ _["Col<complex>"] = Eigen::MatrixXcd::Zero(5, 1).eval(),
+ _["Col<double>"] = Eigen::MatrixXd::Zero(5, 1).eval(),
+ _["Col<float>"] = Eigen::MatrixXf::Zero(5, 1).eval(),
+ _["Col<int>"] = Eigen::MatrixXi::Zero(5, 1).eval()
+ );
+
+ List rows = List::create(
+ _["Row<complex>"] = Eigen::RowVectorXcd::Zero(5).eval(),
+ _["Row<double>"] = Eigen::RowVectorXd::Zero(5).eval(),
+ _["Row<float>"] = Eigen::RowVectorXf::Zero(5).eval(),
+ _["Row<int>"] = Eigen::RowVectorXi::Zero(5).eval()
+ );
+
+ List matrices = List::create(
+ _["Mat<complex>"] = Eigen::MatrixXcd::Identity(3, 3).eval(),
+ _["Mat<double>"] = Eigen::MatrixXd::Identity(3, 3).eval(),
+ _["Mat<float>"] = Eigen::MatrixXf::Identity(3, 3).eval(),
+ _["Mat<int>"] = Eigen::MatrixXi::Identity(3, 3).eval()
+ );
+
+ // ArrayXX<t> objects have the same structure as matrices but allow
+ // componentwise arithmetic. A * B is matrix multiplication for
+ // matrices and componentwise multiplication for arrays.
+ List arrays2 = List::create(
+ _["Arr2<complex>"] = Eigen::ArrayXXcd::Zero(3, 3).eval(),
+ _["Arr2<double>"] = Eigen::ArrayXXd::Zero(3, 3).eval(),
+ _["Arr2<float>"] = Eigen::ArrayXXf::Zero(3, 3).eval(),
+ _["Arr2<int>"] = Eigen::ArrayXXi::Zero(3, 3).eval()
+ );
+
+ // ArrayX<t> objects have the same structure as VectorX<T> objects
+ // but allow componentwise arithmetic, including functions like exp, log,
+ // sqrt, ...
+ List arrays1 = List::create(
+ _["Arr1<complex>"] = Eigen::ArrayXcd::Zero(5).eval(),
+ _["Arr1<double>"] = Eigen::ArrayXd::Zero(5).eval(),
+ _["Arr1<float>"] = Eigen::ArrayXf::Zero(5).eval(),
+ _["Arr1<int>"] = Eigen::ArrayXi::Zero(5).eval()
+ );
+
+ List operations = List::create(
+ _["Op_seq"] = Eigen::ArrayXd::LinSpaced(6, 1, 10).eval(), // arguments are length.out, start, end
+ _["Op_log"] = Eigen::ArrayXd::LinSpaced(6, 1, 10).log().eval(),
+ _["Op_exp"] = Eigen::ArrayXd::LinSpaced(6, 1, 10).exp().eval(),
+ _["Op_sqrt"] = Eigen::ArrayXd::LinSpaced(6, 1, 10).sqrt().eval(),
+ _["Op_cos"] = Eigen::ArrayXd::LinSpaced(6, 1, 10).cos().eval()
+ );
+
+ List output = List::create(
+ _["vectors : VectorX<T>"] = vecs,
+ _["matrices : MatrixX<T>"] = matrices,
+ _["rows : RowVectorX<T>"] = rows,
+ _["columns : MatrixX<T>"] = cols,
+ _["arrays2d : ArrayXX<T>"] = arrays2,
+ _["arrays1d : ArrayX<T>"] = arrays1,
+ _["operations : ArrayXd"] = operations
+ );
+
+ return output ;
+ ' , plugin = "RcppEigen" )
+
+ res <- fx()
+
+ checkEquals( res[[1]][[1]], complex(5), msg = "VectorXcd::Zero(5)")
+ checkEquals( res[[1]][[2]], double(5), msg = "VectorXd::Zero(5)")
+ checkEquals( res[[1]][[3]], double(5), msg = "VectorXf::Zero(5)")
+ checkEquals( res[[1]][[4]], integer(5), msg = "VectorXi::Zero(5)")
+
+ checkEquals( res[[2]][[1]], (1+0i) * diag(nr=3L), msg = "MatrixXcd::Identity(3,3)")
+ checkEquals( res[[2]][[2]], diag(nr=3L), msg = "MatrixXd::Identity(3,3)")
+ checkEquals( res[[2]][[3]], diag(nr=3L), msg = "MatrixXf::Identity(3,3)")
+ checkEquals( res[[2]][[4]], matrix(as.integer((diag(nr=3L))),nr=3L), msg = "MatrixXi::Identity(3,3)")
+
+ checkEquals( res[[3]][[1]], matrix(complex(5), nr=1L), msg = "RowVectorXcd::Zero(5)" )
+ checkEquals( res[[3]][[2]], matrix(numeric(5), nr=1L), msg = "RowVectorXd::Zero(5)" )
+ checkEquals( res[[3]][[3]], matrix(numeric(5), nr=1L), msg = "RowVectorXf::Zero(5)" )
+ checkEquals( res[[3]][[4]], matrix(integer(5), nr=1L), msg = "RowVectorXi::Zero(5)" )
+
+ checkEquals( res[[4]][[1]], as.matrix(complex(5)), msg = "MatrixXcd::Zero(5, 1)")
+ checkEquals( res[[4]][[2]], as.matrix(numeric(5)), msg = "MatrixXd::Zero(5, 1)")
+ checkEquals( res[[4]][[3]], as.matrix(numeric(5)), msg = "MatrixXf::Zero(5, 1)")
+ checkEquals( res[[4]][[4]], as.matrix(integer(5)), msg = "MatrixXi::Zero(5, 1)")
+
+ checkEquals( res[[5]][[1]], matrix(complex(9L), nc=3L), msg = "ArrayXXcd::Zero(3,3)")
+ checkEquals( res[[5]][[2]], matrix(numeric(9L), nc=3L), msg = "ArrayXXd::Zero(3,3)")
+ checkEquals( res[[5]][[3]], matrix(numeric(9L), nc=3L), msg = "ArrayXXf::Zero(3,3)")
+ checkEquals( res[[5]][[4]], matrix(integer(9L), nc=3L), msg = "ArrayXXi::Zero(3,3)")
+
+ checkEquals( res[[6]][[1]], complex(5), msg = "ArrayXcd::Zero(5)")
+ checkEquals( res[[6]][[2]], double(5), msg = "ArrayXd::Zero(5)")
+ checkEquals( res[[6]][[3]], double(5), msg = "ArrayXf::Zero(5)")
+ checkEquals( res[[6]][[4]], integer(5), msg = "ArrayXi::Zero(5)")
+
+ oneTen <- seq(1, 10, length.out=6L)
+
+ checkEquals( res[[7]][[1]], oneTen, msg = "Op_seq")
+ checkEquals( res[[7]][[2]], log(oneTen), msg = "Op_log")
+ checkEquals( res[[7]][[3]], exp(oneTen), msg = "Op_exp")
+ checkEquals( res[[7]][[4]], sqrt(oneTen), msg = "Op_sqrt")
+ checkEquals( res[[7]][[5]], cos(oneTen), msg = "Op_cos")
+
+}
+
+test.as.Col <- function(){
+ fx <- cxxfunction( signature(input_ = "list" ) , '
+
+ List input(input_) ;
+ Eigen::VectorXi m1 = input[0] ; /* implicit as */
+ Eigen::VectorXd m2 = input[1] ; /* implicit as */
+ Eigen::Matrix<unsigned int, Eigen::Dynamic, 1> m3 = input[0] ; /* implicit as */
+ Eigen::VectorXf m4 = input[1] ; /* implicit as */
+
+ List res = List::create(m1.sum(), m2.sum(), m3.sum(), m4.sum());
+
+ return res ;
+
+ ', plugin = "RcppEigen" )
+
+ res <- fx( list( 1:10, as.numeric(1:10) ) )
+ checkEquals( unlist( res ), rep(55.0, 4 ), msg = "as<Col>" )
+}
+
+if (FALSE) {
+
+test.as.Mat <- function(){
+
+ fx <- cxxfunction( signature(input_ = "list" ) , '
+ List input(input_) ;
+ Eigen::MatrixXi m1 = input[0] ; /* implicit as */
+ Eigen::MatrixXd m2 = input[1] ; /* implicit as */
+ Eigen::Matrix<unsigned int, Eigen::Dynamic, Eigen::Dynamic> m3 = input[0] ; /* implicit as */
+ Eigen::MatrixXf m4 = input[1] ; /* implicit as */
+
+ List res = List::create(m1.sum(), m2.sum(), m3.sum(), m4.sum());
+
+ return res ;
+ ', plugin = "RcppEigen" )
+
+ integer_mat <- matrix( as.integer(diag(4)), ncol = 4, nrow = 4 )
+ numeric_mat <- diag(5)
+ res <- fx( list( integer_mat, numeric_mat ) )
+ checkEquals( unlist( res), c(4L, 5L, 4L, 5L ), msg = "as<Mat>" )
+}
+
+test.wrap.Glue <- function(){
+
+ fx <- cxxfunction( , '
+
+ arma::mat m1 = arma::eye<arma::mat>( 3, 3 ) ;
+ arma::mat m2 = arma::eye<arma::mat>( 3, 3 ) ;
+
+ List res ;
+ res["mat+mat"] = m1 + m2 ;
+ return res ;
+
+ ', plugin = "RcppArmadillo" )
+
+ res <- fx()
+ checkEquals( res[[1]], 2*diag(3), msg = "wrap(Glue)" )
+}
+
+test.wrap.Op <- function(){
+
+ fx <- cxxfunction( , '
+
+ arma::mat m1 = arma::eye<arma::mat>( 3, 3 ) ;
+
+ List res ;
+ res["- mat"] = - m1 ;
+ return res ;
+
+ ', plugin = "RcppArmadillo" )
+ res <- fx()
+ checkEquals( res[[1]], -1*diag(3), msg = "wrap(Op)" )
+}
+
+test.as.Col <- function(){
+ fx <- cxxfunction( signature(input_ = "list" ) , '
+
+ List input(input_) ;
+ arma::icolvec m1 = input[0] ; /* implicit as */
+ arma::colvec m2 = input[1] ; /* implicit as */
+ arma::ucolvec m3 = input[0] ; /* implicit as */
+ arma::fcolvec m4 = input[1] ; /* implicit as */
+
+ List res = List::create(
+ arma::accu( m1 ),
+ arma::accu( m2 ),
+ arma::accu( m3 ),
+ arma::accu( m4 ) ) ;
+
+ return res ;
+
+ ', plugin = "RcppArmadillo" )
+
+ res <- fx( list( 1:10, as.numeric(1:10) ) )
+ checkEquals( unlist( res ), rep(55.0, 4 ), msg = "as<Col>" )
+}
+
+test.as.Row <- function(){
+ fx <- cxxfunction( signature(input_ = "list" ) , '
+
+ List input(input_) ;
+ arma::irowvec m1 = input[0] ; /* implicit as */
+ arma::rowvec m2 = input[1] ; /* implicit as */
+ arma::urowvec m3 = input[0] ; /* implicit as */
+ arma::frowvec m4 = input[1] ; /* implicit as */
+
+ List res = List::create(
+ arma::accu( m1 ),
+ arma::accu( m2 ),
+ arma::accu( m3 ),
+ arma::accu( m4 ) ) ;
+ return res ;
+
+ ', plugin = "RcppArmadillo" )
+
+ res <- fx( list( 1:10, as.numeric(1:10) ) )
+ checkEquals( unlist( res ), rep(55.0, 4 ), msg = "as<Row>" )
+}
+
+test.cxmat <- function(){
+
+ fx <- cxxfunction( signature() , '
+
+ arma::cx_mat m1 = arma::eye<arma::cx_mat> ( 3, 3 ) ;
+ arma::cx_fmat m2 = arma::eye<arma::cx_fmat>( 3, 3 ) ;
+ return List::create( _["double"] = m1, _["float"] = m2 ) ;
+
+ ', plugin = "RcppArmadillo" )
+ checkEquals( fx(),
+ list( double = (1+0i)*diag(3), float = (1+0i)*diag(3) ),
+ msg = "support for complex matrices" )
+
+}
+
+test.mtOp <- function(){
+
+ fx <- cxxfunction( signature() , '
+
+ std::complex<double> x( 1.0, 2.0 ) ;
+ arma::mat m1 = arma::eye<arma::mat> ( 3, 3 ) ;
+
+ return wrap( x * m1 ) ;
+
+ ', plugin = "RcppArmadillo" )
+ checkEquals( fx(),
+ (1+2i)*diag(3),
+ msg = "support for mtOp" )
+
+}
+
+test.mtGlue <- function(){
+
+ fx <- cxxfunction( signature() , '
+
+ arma::imat m2 = arma::eye<arma::imat> ( 3, 3 ) ;
+ arma::mat m1 = arma::eye<arma::mat> ( 3, 3 ) ;
+
+ return wrap( m1 + m2 ) ;
+
+ ', plugin = "RcppArmadillo" )
+ checkEquals( fx(),
+ 2.0 * diag(3) ,
+ msg = "support for mtOp" )
+
+}
+
+
+test.sugar <- function(){
+
+ fx <- cxxfunction( signature(x= "numeric") , '
+ NumericVector xx(x) ;
+ arma::mat m = forward( xx + xx ) ;
+ return wrap( m ) ;
+
+ ', plugin = "RcppArmadillo" )
+ checkEquals( fx(1:10),
+ matrix( 2*(1:10), nrow = 10 ) ,
+ msg = "RcppArmadillo and sugar" )
+
+}
+
+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)" )
+
+}
+
+test.armadillo.sugar.ctor <- function(){
+
+ fx <- cxxfunction( signature(x= "numeric") , '
+ NumericVector xx(x) ;
+ arma::mat m = xx + xx ;
+ arma::colvec co = xx ;
+ arma::rowvec ro = xx ;
+ return List::create(
+ _["mat"] = m + m,
+ _["rowvec"] = ro,
+ _["colvec"] = co
+ );
+ ', plugin = "RcppArmadillo" )
+ checkEquals( fx(1:10),
+ list(
+ mat = matrix( 4*(1:10), nrow = 10 ),
+ rowvec = matrix( 1:10, nrow = 1 ),
+ colvec = matrix( 1:10, ncol = 1 )
+ )
+ ,
+ msg = "Mat( sugar expression )" )
+
+}
+
+
+test.armadillo.sugar.matrix.ctor <- function(){
+
+ inc <- '
+ double norm( double x, double y){
+ return ::sqrt( x*x + y*y );
+ }
+ '
+ fx <- cxxfunction( signature(x= "numeric") , '
+ NumericVector xx(x) ;
+ NumericVector yy = NumericVector::create( 1 ) ;
+ arma::mat m = diag( xx ) ;
+ arma::colvec co = outer( xx, yy, ::norm ) ;
+ arma::rowvec ro = outer( yy, xx, ::norm ) ;
+ return List::create(
+ _["mat"] = m + m ,
+ _["rowvec"] = ro,
+ _["colvec"] = co
+ );
+ ', plugin = "RcppArmadillo", includes = inc )
+ res <- fx(1:10)
+ norm <- function(x, y) sqrt( x*x + y*y )
+ checkEquals( res,
+ list(
+ mat = diag(2*(1:10)),
+ rowvec = outer( 1, 1:10, norm ),
+ colvec = outer( 1:10, 1, norm )
+ ),
+ msg = "Mat( sugar expression )" )
+
+}
+
+test.armadillo.rtti.check <- function() {
+
+ inc <- '
+ void blah(arma::mat& X) {
+ X.set_size(5,5);
+ }
+ '
+ src <- '
+ arma::vec V;
+ blah(V); // if blah() worked, we have a problem
+ '
+ fun <- cxxfunction(signature(), body=src, inc=inc, plugin = "RcppArmadillo")
+
+ checkException(fun(), msg="RTTI check on matrix constructor exception")
+
+}
+}
More information about the Rcpp-commits
mailing list