diff --git a/.Rbuildignore b/.Rbuildignore index ad28b754..5fba9f30 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -8,3 +8,4 @@ debian ^\.Rproj\.user$ .*\.tar\.gz$ ^patches +^.editorconfig$ diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 00000000..c971b748 --- /dev/null +++ b/.editorconfig @@ -0,0 +1,21 @@ +# EditorConfig is awesome: http://EditorConfig.org + +# top-most EditorConfig file +root = true + +# Unix-style newlines with a newline ending every file +[*] +end_of_line = lf +insert_final_newline = true +trim_trailing_whitespace = true + +# Matches multiple files with brace expansion notation +# 4 space indentation +[*.{c,cpp,h,hpp,R,r}] +indent_style = space +indent_size = 4 + +# Tab indentation (no size specified) +[Makefile] +indent_style = tab + diff --git a/.travis.yml b/.travis.yml index 6d9f2977..a647825c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -11,7 +11,7 @@ before_install: - ./run.sh bootstrap install: - - ./run.sh install_aptget r-cran-rcpp r-cran-matrix r-cran-inline r-cran-runit r-cran-pkgkitten r-cran-microbenchmark + - ./run.sh install_aptget r-cran-rcpp r-cran-matrix r-cran-inline r-cran-tinytest r-cran-pkgkitten r-cran-microbenchmark script: - ./run.sh run_tests diff --git a/ChangeLog b/ChangeLog index e2df0d02..56199aa6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,49 @@ +2019-11-01 Dirk Eddelbuettel + + * R/unit.test.R (compile_unit_tests): Removed as no longer needed + +2019-10-31 Dirk Eddelbuettel + + * inst/tinytest/test_transform.R: Switch from RUnit to tinytest + * inst/tinytest/test_wrap.R: Idem + + * inst/tinytest/cpp/transform.cpp: Added using Rcpp Attributes + * inst/tinytest/cpp/wrap.cpp: Idem + + * inst/tinytest/cpp/sparse.cpp: More idiomatic Eigen code + * inst/tinytest/test_sparse.R: Idem + + * .editorconfig: Added + +2019-10-30 Dirk Eddelbuettel + + * DESCRIPTION (Suggests): Switch from RUnit to tinytest + * .travis.yml (install): Ditto + + * tests/tinytest.R: Converted to tinytest + + * test_sparse.R: Converted to tinytest + * cpp/sparse.cpp: Added using Rcpp Attributes + +2019-10-29 Dirk Eddelbuettel + + * test_fastLm.R: Converted to tinytest + * test_RcppEigen.R: Idem + * test_solution.R: Idem + + * cpp/rcppeigen.cpp: Added using Rcpp Attributes + * cpp/solution.cpp: Idem + +2019-10-28 Dirk Eddelbuettel + + * tests/tinytest.R: Renamed from tests/doRUnit.R + * inst/tinytest/test_fastLm.R: Renamed from inst/unitTests/runit* + * inst/tinytest/test_RcppEigen.R: Idem + * inst/tinytest/test_solution.R: Idem + * inst/tinytest/test_sparse.R: Idem + * inst/tinytest/test_transform.R: Idem + * inst/tinytest/test_wrap.R: Idem + 2019-10-13 Dirk Eddelbuettel * README.md: Added CRAN + BioConductor badges for reverse depends, diff --git a/DESCRIPTION b/DESCRIPTION index 1a1a0ae6..2d66ba2b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,6 +25,6 @@ Depends: R (>= 2.15.1) LazyLoad: yes LinkingTo: Rcpp Imports: Matrix (>= 1.1-0), Rcpp (>= 0.11.0), stats, utils -Suggests: inline, RUnit, pkgKitten, microbenchmark +Suggests: inline, tinytest, pkgKitten, microbenchmark URL: http://dirk.eddelbuettel.com/code/rcpp.eigen.html BugReports: https://github.com/RcppCore/RcppEigen/issues diff --git a/R/unit.test.R b/R/unit.test.R deleted file mode 100644 index 9d14f3a1..00000000 --- a/R/unit.test.R +++ /dev/null @@ -1,27 +0,0 @@ -# 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 . - -compile_unit_tests <- function( definitions, includes = "", cxxargs = "" ){ - signatures <- lapply(definitions, "[[", 1L) - bodies <- lapply(definitions, "[[", 2L) - cxxfunction <- get( "cxxfunction", asNamespace("inline" ) ) - fun <- cxxfunction( signatures, bodies, plugin = "RcppEigen", - includes = sprintf( "using namespace std;\n%s", paste( includes, collapse = "\n") ), - cxxargs = cxxargs - ) - fun -} diff --git a/inst/tinytest/cpp/rcppeigen.cpp b/inst/tinytest/cpp/rcppeigen.cpp new file mode 100644 index 00000000..d178df0c --- /dev/null +++ b/inst/tinytest/cpp/rcppeigen.cpp @@ -0,0 +1,157 @@ + +#include + +// [[Rcpp::depends(RcppEigen)]] + +// [[Rcpp::export]] +Rcpp::List fx() { + Rcpp::List vecs = Rcpp::List::create( + Rcpp::_["Vec"] = Eigen::VectorXcd::Zero(5), + Rcpp::_["Vec"] = Eigen::VectorXd::Zero(5), + Rcpp::_["Vec"] = Eigen::VectorXf::Zero(5), + Rcpp::_["Vec"] = Eigen::VectorXi::Zero(5) + ); + + // A VectorX 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 objects are defined at compile time to have one column, + // whereas a MatrixX has a dynamic number of columns that is set to 1 + // during execution of the code. A MatrixX object can be resized to have + // a different number of columns. A VectorX object cannot. + Rcpp::List cols = Rcpp::List::create( + Rcpp::_["Col"] = Eigen::MatrixXcd::Zero(5, 1), + Rcpp::_["Col"] = Eigen::MatrixXd::Zero(5, 1), + Rcpp::_["Col"] = Eigen::MatrixXf::Zero(5, 1), + Rcpp::_["Col"] = Eigen::MatrixXi::Zero(5, 1) + ); + + Rcpp::List rows = Rcpp::List::create( + Rcpp::_["Row"] = Eigen::RowVectorXcd::Zero(5), + Rcpp::_["Row"] = Eigen::RowVectorXd::Zero(5), + Rcpp::_["Row"] = Eigen::RowVectorXf::Zero(5), + Rcpp::_["Row"] = Eigen::RowVectorXi::Zero(5) + ); + + Rcpp::List matrices = Rcpp::List::create( + Rcpp::_["Mat"] = Eigen::MatrixXcd::Identity(3, 3), + Rcpp::_["Mat"] = Eigen::MatrixXd::Identity(3, 3), + Rcpp::_["Mat"] = Eigen::MatrixXf::Identity(3, 3), + Rcpp::_["Mat"] = Eigen::MatrixXi::Identity(3, 3) + ); + + // ArrayXX objects have the same structure as matrices but allow + // componentwise arithmetic. A * B is matrix multiplication for + // matrices and componentwise multiplication for arrays. + Rcpp::List arrays2 = Rcpp::List::create( + Rcpp::_["Arr2"] = Eigen::ArrayXXcd::Zero(3, 3), + Rcpp::_["Arr2"] = Eigen::ArrayXXd::Zero(3, 3), + Rcpp::_["Arr2"] = Eigen::ArrayXXf::Zero(3, 3), + Rcpp::_["Arr2"] = Eigen::ArrayXXi::Zero(3, 3) + ); + + // ArrayX objects have the same structure as VectorX objects + // but allow componentwise arithmetic, including functions like exp, log, + // sqrt, ... + Rcpp::List arrays1 = Rcpp::List::create( + Rcpp::_["Arr1"] = Eigen::ArrayXcd::Zero(5), + Rcpp::_["Arr1"] = Eigen::ArrayXd::Zero(5), + Rcpp::_["Arr1"] = Eigen::ArrayXf::Zero(5), + Rcpp::_["Arr1"] = Eigen::ArrayXi::Zero(5) + ); + + Rcpp::List operations = Rcpp::List::create( + Rcpp::_["Op_seq"] = Eigen::ArrayXd::LinSpaced(6, 1, 10), // arguments are length.out, start, end + Rcpp::_["Op_log"] = Eigen::ArrayXd::LinSpaced(6, 1, 10).log(), + Rcpp::_["Op_exp"] = Eigen::ArrayXd::LinSpaced(6, 1, 10).exp(), + Rcpp::_["Op_sqrt"] = Eigen::ArrayXd::LinSpaced(6, 1, 10).sqrt(), + Rcpp::_["Op_cos"] = Eigen::ArrayXd::LinSpaced(6, 1, 10).cos() + ); + + Rcpp::List output = Rcpp::List::create( + Rcpp::_["vectors : VectorX"] = vecs, + Rcpp::_["matrices : MatrixX"] = matrices, + Rcpp::_["rows : RowVectorX"] = rows, + Rcpp::_["columns : MatrixX"] = cols, + Rcpp::_["arrays2d : ArrayXX"] = arrays2, + Rcpp::_["arrays1d : ArrayX"] = arrays1, + Rcpp::_["operations : ArrayXd"] = operations + ); + + return output ; +} + +// [[Rcpp::export]] +Rcpp::List fx2(Rcpp::List input) { + Eigen::VectorXi m1 = input[0] ; /* implicit as */ + Eigen::VectorXd m2 = input[1] ; /* implicit as */ + Eigen::Matrix m3 = input[0] ; /* implicit as */ + Eigen::VectorXf m4 = input[1] ; /* implicit as */ + + Rcpp::List res = Rcpp::List::create(m1.sum(), m2.sum(), m3.sum(), m4.sum()); + + return res ; +} + + +// [[Rcpp::export]] +Rcpp::List fx3(Rcpp::List input) { + + const Eigen::Map m1 = input[0] ; // maps share storage and do not allow conversion + const Eigen::Map m2 = input[1] ; + + Rcpp::List res = Rcpp::List::create(m1.sum(), m2.sum()); + + return res ; +} + +// [[Rcpp::export]] +Rcpp::List fx4(Rcpp::List input) { + + const Eigen::Map m1 = input[0] ; // maps share storage, do not allow conversion + const Eigen::Map m2 = input[1] ; + + Rcpp::List res = Rcpp::List::create(m1.sum(), m2.sum()); + + return res ; +} + + +// [[Rcpp::export]] +Rcpp::List fx5(Rcpp::List input) { + const Eigen::Map m1 = input[0]; // maps share storage, do not allow conversion + const Eigen::Map m2 = input[1] ; + // FIXME: Write a version of as specifically for complex matrices. + // const Eigen::Map m3 = input[2] ; + + Rcpp::List res = Rcpp::List::create(m1.sum(), m2.sum());//, m3.sum()); + + return res ; +} + + +// [[Rcpp::export]] +Rcpp::List fx6(Rcpp::List input) { + const Eigen::MappedSparseMatrix m1 = input[0]; // maps share storage and do not allow conversion + + Rcpp::List res = Rcpp::List::create(Rcpp::_["nnz"] = double(m1.nonZeros()), + Rcpp::_["nr"] = double(m1.rows()), + Rcpp::_["nc"] = double(m1.cols()), + Rcpp::_["inSz"] = double(m1.innerSize()), + Rcpp::_["outSz"] = double(m1.outerSize()), + Rcpp::_["sum"] = m1.sum()); + + return res ; +} + + +// [[Rcpp::export]] +Rcpp::List fx7(Rcpp::List input) { + const Eigen::SparseMatrix m1 = input[0]; + Rcpp::List res = Rcpp::List::create(Rcpp::_["nnz"] = double(m1.nonZeros()), + Rcpp::_["nr"] = double(m1.rows()), + Rcpp::_["nc"] = double(m1.cols()), + Rcpp::_["inSz"] = double(m1.innerSize()), + Rcpp::_["outSz"] = double(m1.outerSize()), + Rcpp::_["sum"] = m1.sum()); + return res ; +} diff --git a/inst/tinytest/cpp/solution.cpp b/inst/tinytest/cpp/solution.cpp new file mode 100644 index 00000000..9c018a27 --- /dev/null +++ b/inst/tinytest/cpp/solution.cpp @@ -0,0 +1,37 @@ + +#include + +// [[Rcpp::depends(RcppEigen)]] + +typedef Eigen::ArrayXd Ar1; +typedef Eigen::Map MAr1; +typedef Eigen::ArrayXXd Ar2; +typedef Eigen::Map MAr2; +typedef Eigen::MatrixXd Mat; +typedef Eigen::Map MMat; +typedef Eigen::VectorXd Vec; +typedef Eigen::Map MVec; +typedef Eigen::PartialPivLU PPLU; +typedef Eigen::ColPivHouseholderQR CPQR; + + +// [[Rcpp::export]] +Rcpp::List dense_PPLU(MMat A, MVec b) { + PPLU lu(A); + Mat Ainv(lu.inverse()); + Vec x(lu.solve(b)); + + return Rcpp::List::create(Rcpp::Named("A", A), + Rcpp::Named("Ainv", Ainv), + Rcpp::Named("b", b), + Rcpp::Named("x", x)); +} + +// [[Rcpp::export]] +Rcpp::List dense_CPQR(MMat A, MVec b) { + CPQR qr(A); + Mat Ainv(qr.inverse()); + Vec x(qr.solve(b)); + return Rcpp::List::create(Rcpp::Named("Ainv", Ainv), + Rcpp::Named("x", x)); +} diff --git a/inst/tinytest/cpp/sparse.cpp b/inst/tinytest/cpp/sparse.cpp new file mode 100644 index 00000000..77ef8866 --- /dev/null +++ b/inst/tinytest/cpp/sparse.cpp @@ -0,0 +1,102 @@ + +#include + +// [[Rcpp::depends(RcppEigen)]] + +// [[Rcpp::export]] +Eigen::SparseMatrix wrapSparseDouble() { + Eigen::SparseMatrix mm(9,3); + mm.reserve(9); + for (int j = 0; j < 3; ++j) { + mm.startVec(j); + for (int i = 3 * j; i < 3 * (j + 1); ++i) + mm.insertBack(i, j) = 1.; + } + mm.finalize(); + return mm; +} + +// [[Rcpp::export]] +Eigen::SparseMatrix wrapSparseDoubleColumnMajor() { + Eigen::SparseMatrix mm(9,3); + mm.reserve(9); + for (int j = 0; j < 3; ++j) { + mm.startVec(j); + for (int i = 3 * j; i < 3 * (j + 1); ++i) + mm.insertBack(i, j) = 1.; + } + mm.finalize(); + return mm; +} + +// [[Rcpp::export]] +Eigen::SparseMatrix wrapSparseDoubleRowMajor() { + Eigen::SparseMatrix mm(9,3); + mm.reserve(9); + for (int irow = 0; irow < 9; ++irow) { + mm.startVec(irow); + mm.insertBack(irow, irow / 3) = static_cast( 9 - irow ); + } + mm.finalize(); + return mm; +} + +// [[Rcpp::export]] +Eigen::SparseMatrix asSparseDoubleColumnMajor(Eigen::SparseMatrix mm) { + return mm; +} + +// [[Rcpp::export]] +double asMappedSparseDoubleColMajor(Eigen::Map > mm) { + double s = mm.sum(); // access instantiated sparse matrix + return s; +} + +// [[Rcpp::export]] +double asMappedSparseDeprecatedDoubleColMajor(Eigen::MappedSparseMatrix mm) { + // Deprecated + double s = mm.sum(); // access instantiated sparse matrix + return s; +} + +// [[Rcpp::export]] +double asSparseDoubleRowMajor(Eigen::SparseMatrix mm) { + double s = mm.sum(); // access instantiated sparse matrix + return s; +} + +// [[Rcpp::export]] +double asMappedSparseDoubleRowMajor(Eigen::Map > mm) { + double s = mm.sum(); // access instantiated sparse matrix + return s; +} + +// [[Rcpp::export]] +double asMappedSparseDeprecatedDoubleRowMajor(Eigen::MappedSparseMatrix mm) { + double s = mm.sum(); // access instantiated sparse matrix + return s; +} + +// [[Rcpp::export]] +Rcpp::List sparseCholesky(Rcpp::List input) { + using Eigen::VectorXd; + using Eigen::MatrixXd; + using Eigen::Lower; + using Eigen::Map; + using Eigen::SparseMatrix; + using Eigen::SimplicialLDLT; + using Eigen::Success; + + const Map > m1 = input[0]; + const Map v1 = input[1]; + SparseMatrix m2(m1.cols(), m1.cols()); + m2.selfadjointView().rankUpdate(m1.adjoint()); + + SimplicialLDLT > ff(m2); + VectorXd res = ff.solve(m1.adjoint() * v1); + + return Rcpp::List::create(Rcpp::Named("res") = res, + Rcpp::Named("rows") = double(ff.rows()), + Rcpp::Named("cols") = double(ff.cols())); + +} diff --git a/inst/tinytest/cpp/transform.cpp b/inst/tinytest/cpp/transform.cpp new file mode 100644 index 00000000..5cb40afd --- /dev/null +++ b/inst/tinytest/cpp/transform.cpp @@ -0,0 +1,31 @@ + +#include + +// [[Rcpp::depends(RcppEigen)]] + +typedef Eigen::ArrayXd Ar1; +typedef Eigen::Map MAr1; +typedef Eigen::ArrayXXd Ar2; +typedef Eigen::Map MAr2; +typedef Eigen::MatrixXd Mat; +typedef Eigen::Map MMat; +typedef Eigen::VectorXd Vec; +typedef Eigen::Map MVec; + +// [[Rcpp::export]] +Rcpp::List transformAr1unbounded(Rcpp::NumericVector x_) { + MAr1 x(Rcpp::as(x_)); + return Rcpp::List::create(Rcpp::Named("abs", x.abs()), + Rcpp::Named("abs2", x.abs2()), + Rcpp::Named("exp", x.exp()), + Rcpp::Named("cos", x.cos())); +} + +// [[Rcpp::export]] +Rcpp::List transformAr2unbounded(Rcpp::NumericMatrix X_) { + MAr2 X(Rcpp::as(X_)); + return Rcpp::List::create(Rcpp::Named("abs", X.abs()), + Rcpp::Named("abs2", X.abs2()), + Rcpp::Named("exp", X.exp()), + Rcpp::Named("cos", X.cos())); +} diff --git a/inst/unitTests/runit.wrap.R b/inst/tinytest/cpp/wrap.cpp similarity index 65% rename from inst/unitTests/runit.wrap.R rename to inst/tinytest/cpp/wrap.cpp index 50e284e8..d1f4ed02 100644 --- a/inst/unitTests/runit.wrap.R +++ b/inst/tinytest/cpp/wrap.cpp @@ -1,23 +1,10 @@ -# -# Copyright (C) 2012 - 2013 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 Rcpp. If not, see . - -incl <- ' -// double + +#include + +using namespace Rcpp; + +// [[Rcpp::depends(RcppEigen)]] + typedef Eigen::ArrayXd Ar1; typedef Eigen::Map MAr1; typedef Eigen::ArrayXXd Ar2; @@ -62,11 +49,9 @@ typedef Eigen::MatrixXcd cdMat; typedef Eigen::Map McdMat; typedef Eigen::VectorXcd cdVec; typedef Eigen::Map McdVec; -' -definitions <- list( - "wrap_vectors" = list(signature(), - ' +// [[Rcpp::export]] +Rcpp::List wrap_vectors() { List vecs = List::create( _["Vec"] = cdVec::Zero(5), _["Vec"] = Vec::Zero(5), @@ -146,12 +131,10 @@ definitions <- list( _["operations : ArrayXd"] = operations ); return output; - '), - +} - "as_Vec" = list(signature(input_ = "list"), - ' - List input(input_) ; +// [[Rcpp::export]] +Rcpp::List as_Vec(Rcpp::List input) { // Column vector iVec m1 = input[0] ; /* implicit as */ @@ -174,13 +157,10 @@ definitions <- list( m9.sum(), m10.sum()); return res ; +} - '), - - - "as_Array" = list(signature(input_ = "list"), - ' - List input(input_) ; +// [[Rcpp::export]] +Rcpp::List as_Array(Rcpp::List input) { // Column array iAr1 m1 = input[0] ; /* implicit as */ @@ -203,13 +183,10 @@ definitions <- list( m9.sum(), m10.sum()); return res ; +} - '), - - - "as_Mat" = list(signature(input_ = "list"), - ' - List input(input_) ; +// [[Rcpp::export]] +Rcpp::List as_Mat(Rcpp::List input) { // Copy to matrix iMat m1 = input[0] ; /* implicit as */ @@ -225,13 +202,10 @@ definitions <- list( m5.sum(), m6.sum()); return res ; +} - '), - - - "as_Array2D" = list(signature(input_ = "list"), - ' - List input(input_) ; +// [[Rcpp::export]] +Rcpp::List as_Array2D(Rcpp::List input) { // Copy to 2D array iAr2 m1 = input[0] ; /* implicit as */ @@ -247,98 +221,4 @@ definitions <- list( m5.sum(), m6.sum()); return res ; - - ') - ) - -.setUp <- function() { - suppressMessages(require(inline)) - suppressMessages(require(RcppEigen)) - cxxargs <- ifelse(Rcpp:::capabilities()[["initializer lists"]], - "-std=c++0x","") - tests <- ".rcppeigen.wrap" - if( ! exists( tests, globalenv() )) { - fun <- RcppEigen:::compile_unit_tests(definitions, - includes=incl, - cxxargs = cxxargs) - names(fun) <- names(definitions) - assign(tests, fun, globalenv()) - } -} - - -test.wrapVectors <- function() { - res <- .rcppeigen.wrap$wrap_vectors() - - checkEquals(res[[1]][[1]], complex(5)) - checkEquals(res[[1]][[2]], double(5)) - checkEquals(res[[1]][[3]], double(5)) - checkEquals(res[[1]][[4]], integer(5)) - checkEquals(res[[1]][[5]], integer(5)) - - checkEquals(res[[2]][[1]], (1+0i) * diag(nr=3L)) - checkEquals(res[[2]][[2]], diag(nr=3L)) - checkEquals(res[[2]][[3]], diag(nr=3L)) - checkEquals(res[[2]][[4]], matrix(as.integer((diag(nr=3L))),nr=3L)) - checkEquals(res[[2]][[5]], matrix(as.integer((diag(nr=3L))),nr=3L)) - - checkEquals(res[[3]][[1]], matrix(complex(5), nr=1L)) - checkEquals(res[[3]][[2]], matrix(numeric(5), nr=1L)) - checkEquals(res[[3]][[3]], matrix(numeric(5), nr=1L)) - checkEquals(res[[3]][[4]], matrix(integer(5), nr=1L)) - checkEquals(res[[3]][[5]], matrix(integer(5), nr=1L)) - - checkEquals(res[[4]][[1]], as.matrix(complex(5))) - checkEquals(res[[4]][[2]], as.matrix(numeric(5))) - checkEquals(res[[4]][[3]], as.matrix(numeric(5))) - checkEquals(res[[4]][[4]], as.matrix(integer(5))) - checkEquals(res[[4]][[5]], as.matrix(integer(5))) - - checkEquals(res[[5]][[1]], matrix(complex(9L), nc=3L)) - checkEquals(res[[5]][[2]], matrix(numeric(9L), nc=3L)) - checkEquals(res[[5]][[3]], matrix(numeric(9L), nc=3L)) - checkEquals(res[[5]][[4]], matrix(integer(9L), nc=3L)) - checkEquals(res[[5]][[5]], matrix(integer(9L), nc=3L)) - - checkEquals(res[[6]][[1]], complex(5)) - checkEquals(res[[6]][[2]], double(5)) - checkEquals(res[[6]][[3]], double(5)) - checkEquals(res[[6]][[4]], integer(5)) - checkEquals(res[[6]][[5]], integer(5)) - - oneTen <- seq(1, 10, length.out=6L) - - checkEquals(res[[7]][[1]], oneTen) - checkEquals(res[[7]][[2]], log(oneTen)) - checkEquals(res[[7]][[3]], exp(oneTen)) - checkEquals(res[[7]][[4]], sqrt(oneTen)) - checkEquals(res[[7]][[5]], cos(oneTen)) -} - -test.asVec <- function() { - res <- .rcppeigen.wrap$as_Vec(list(1:10, as.numeric(1:10))) - - checkEquals(unlist(res), rep.int(55, 10L)) -} - -test.asArray <- function() { - res <- .rcppeigen.wrap$as_Array(list(1:10, as.numeric(1:10))) - - checkEquals(unlist(res), rep.int(55, 10L)) -} - -test.asMat <- function() { - integer_mat <- matrix(as.integer(diag(nrow = 5L))) - numeric_mat <- diag(nrow = 5L) - res <- .rcppeigen.wrap$as_Mat(list(integer_mat, numeric_mat)) - - checkEquals(unlist(res), rep.int(5, 6L)) -} - -test.asArray2D <- function() { - integer_mat <- matrix(as.integer(diag(nrow = 5L))) - numeric_mat <- diag(nrow = 5L) - res <- .rcppeigen.wrap$as_Array2D(list(integer_mat, numeric_mat)) - - checkEquals(unlist(res), rep.int(5, 6L)) } diff --git a/inst/tinytest/test_RcppEigen.R b/inst/tinytest/test_RcppEigen.R new file mode 100644 index 00000000..82b52ac7 --- /dev/null +++ b/inst/tinytest/test_RcppEigen.R @@ -0,0 +1,109 @@ +#!/usr/bin/r -t +# +# Copyright (C) 2011 - 2019 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 . + +#test.wrap.R <- function(){ + +#fx <- cxxfunction( , ' +# ' , plugin = "RcppEigen" ) +Rcpp::sourceCpp("cpp/rcppeigen.cpp") + +res <- fx() + +expect_equal( res[["vectors : VectorX"]][["Vec"]], complex(5), info = "VectorXcd::Zero(5)") +expect_equal( res[["vectors : VectorX"]][["Vec"]], double(5), info = "VectorXd::Zero(5)") +expect_equal( res[["vectors : VectorX"]][["Vec"]], double(5), info = "VectorXf::Zero(5)") +expect_equal( res[["vectors : VectorX"]][["Vec"]], integer(5), info = "VectorXi::Zero(5)") + +expect_equal( res[["matrices : MatrixX"]][["Mat"]], (1+0i) * diag(nr=3L), info = "MatrixXcd::Identity(3,3)") +expect_equal( res[["matrices : MatrixX"]][["Mat"]], diag(nr=3L), info = "MatrixXd::Identity(3,3)") +expect_equal( res[["matrices : MatrixX"]][["Mat"]], diag(nr=3L), info = "MatrixXf::Identity(3,3)") +expect_equal( res[["matrices : MatrixX"]][["Mat"]], matrix(as.integer((diag(nr=3L))),nr=3L), info = "MatrixXi::Identity(3,3)") + +expect_equal( res[["rows : RowVectorX"]][["Row"]], matrix(complex(5), nr=1L), info = "RowVectorXcd::Zero(5)") +expect_equal( res[["rows : RowVectorX"]][["Row"]], matrix(numeric(5), nr=1L), info = "RowVectorXd::Zero(5)") +expect_equal( res[["rows : RowVectorX"]][["Row"]], matrix(numeric(5), nr=1L), info = "RowVectorXf::Zero(5)") +expect_equal( res[["rows : RowVectorX"]][["Row"]], matrix(integer(5), nr=1L), info = "RowVectorXi::Zero(5)") + +expect_equal( res[["columns : MatrixX"]][["Col"]], as.matrix(complex(5)), info = "MatrixXcd::Zero(5, 1)") +expect_equal( res[["columns : MatrixX"]][["Col"]], as.matrix(numeric(5)), info = "MatrixXd::Zero(5, 1)") +expect_equal( res[["columns : MatrixX"]][["Col"]], as.matrix(numeric(5)), info = "MatrixXf::Zero(5, 1)") +expect_equal( res[["columns : MatrixX"]][["Col"]], as.matrix(integer(5)), info = "MatrixXi::Zero(5, 1)") + +expect_equal( res[["arrays2d : ArrayXX"]][["Arr2"]], matrix(complex(9L), nc=3L), info = "ArrayXXcd::Zero(3,3)") +expect_equal( res[["arrays2d : ArrayXX"]][["Arr2"]], matrix(numeric(9L), nc=3L), info = "ArrayXXd::Zero(3,3)") +expect_equal( res[["arrays2d : ArrayXX"]][["Arr2"]], matrix(numeric(9L), nc=3L), info = "ArrayXXf::Zero(3,3)") +expect_equal( res[["arrays2d : ArrayXX"]][["Arr2"]], matrix(integer(9L), nc=3L), info = "ArrayXXi::Zero(3,3)") + +expect_equal( res[["arrays1d : ArrayX"]][["Arr1"]], complex(5), info = "ArrayXcd::Zero(5)") +expect_equal( res[["arrays1d : ArrayX"]][["Arr1"]], double(5), info = "ArrayXd::Zero(5)") +expect_equal( res[["arrays1d : ArrayX"]][["Arr1"]], double(5), info = "ArrayXf::Zero(5)") +expect_equal( res[["arrays1d : ArrayX"]][["Arr1"]], integer(5), info = "ArrayXi::Zero(5)") + +oneTen <- seq(1, 10, length.out=6L) + +expect_equal( res[["operations : ArrayXd"]][["Op_seq"]], oneTen, info = "Op_seq") +expect_equal( res[["operations : ArrayXd"]][["Op_log"]], log(oneTen), info = "Op_log") +expect_equal( res[["operations : ArrayXd"]][["Op_exp"]], exp(oneTen), info = "Op_exp") +expect_equal( res[["operations : ArrayXd"]][["Op_sqrt"]], sqrt(oneTen), info = "Op_sqrt") +expect_equal( res[["operations : ArrayXd"]][["Op_cos"]], cos(oneTen), info = "Op_cos") + + +#test.as.Vec <- function(){ +res <- fx2( list( 1:10, as.numeric(1:10) ) ) +expect_equal( unlist( res ), rep(55.0, 4 ), info = "as" ) + + + +#test.as.MVec <- function(){ +res <- fx3( list( 1:10, as.numeric(1:10) ) ) +expect_equal( unlist( res ), rep(55.0, 2 ), info = "as" ) + +#test.as.MRowVec <- function(){ +res <- fx4( list( 1:10, as.numeric(1:10) ) ) +expect_equal( unlist( res ), rep(55.0, 2 ), info = "as" ) + + + +integer_mat <- matrix(as.integer(diag(nr=4L)), nc=4L) +numeric_mat <- diag(nr=5L) +complex_mat <- (1+0i) * diag(nr=5L) +res <- fx5(list(integer_mat, numeric_mat, complex_mat)) +expect_equal(unlist(res), c(4L, 5)#, 5+0i) + , info = "as" ) + + +#test.as.MSpMat <- function() { +suppressMessages(require("Matrix")) +data("KNex", package = "Matrix") + +KNX <- KNex[[1]] +res <- fx6(KNex) +expect_equal(unname(unlist(res)), + as.numeric(c(nnzero(KNX), nrow(KNX), ncol(KNX), nrow(KNX), ncol(KNX), sum(KNX@x))), + info = "as") + + +#test.as.SpMat <- function() { +suppressMessages(require("Matrix")) +data("KNex", package = "Matrix") +KNX <- KNex[[1]] +res <- fx7(KNex) +expect_equal(unname(unlist(res)), + as.numeric(c(nnzero(KNX), nrow(KNX), ncol(KNX), nrow(KNX), ncol(KNX), sum(KNX@x))), + info = "as") diff --git a/inst/tinytest/test_fastLm.R b/inst/tinytest/test_fastLm.R new file mode 100644 index 00000000..f3371ba7 --- /dev/null +++ b/inst/tinytest/test_fastLm.R @@ -0,0 +1,56 @@ +#!/usr/bin/r -t +# +# Copyright (C) 2011 - 2019 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 . + +library(RcppEigen) + +#test.fastLm <- function() { +data(trees, package="datasets") +flm0 <- fastLmPure(cbind(1, log(trees$Girth)), log(trees$Volume), 0L) +flm1 <- fastLmPure(cbind(1, log(trees$Girth)), log(trees$Volume), 1L) +flm2 <- fastLmPure(cbind(1, log(trees$Girth)), log(trees$Volume), 2L) +flm3 <- fastLmPure(cbind(1, log(trees$Girth)), log(trees$Volume), 3L) +flm4 <- fastLmPure(cbind(1, log(trees$Girth)), log(trees$Volume), 4L) +flm5 <- fastLmPure(cbind(1, log(trees$Girth)), log(trees$Volume), 5L) + +fit <- lm(log(Volume) ~ log(Girth), data=trees) +fitCoef <- unname(coef(fit)) +fitStdErr <- unname(coef(summary(fit))[, "Std. Error", drop = TRUE]) + +expect_equal(flm0$coefficients , fitCoef, info="fastLm0.coef") +expect_equal(flm0$se , fitStdErr, info="fastLm0.stderr") +expect_equal(flm1$coefficients , fitCoef, info="fastLm1.coef") +expect_equal(flm1$se , fitStdErr, info="fastLm1.stderr") +expect_equal(flm2$coefficients , fitCoef, info="fastLm2.coef") +expect_equal(flm2$se , fitStdErr, info="fastLm2.stderr") +expect_equal(flm3$coefficients , fitCoef, info="fastLm3.coef") +expect_equal(flm3$se , fitStdErr, info="fastLm3.stderr") +expect_equal(flm4$coefficients , fitCoef, info="fastLm0.coef") +expect_equal(flm4$se , fitStdErr, info="fastLm0.stderr") +expect_equal(flm5$coefficients , fitCoef, info="fastLm0.coef") +expect_equal(flm5$se , fitStdErr, info="fastLm0.stderr") + + +#test.fastLm.formula <- function() { +data(trees, package="datasets") +flm <- fastLm(log(Volume) ~ log(Girth), data=trees) +fit <- lm(log(Volume) ~ log(Girth), data=trees) + +expect_equal(flm$coefficients, coef(fit), info="fastLm.formula.coef") +expect_equal(as.numeric(flm$se), as.numeric(coef(summary(fit))[,2]), + info="fastLm.formula.stderr") diff --git a/inst/tinytest/test_solution.R b/inst/tinytest/test_solution.R new file mode 100644 index 00000000..0baba25e --- /dev/null +++ b/inst/tinytest/test_solution.R @@ -0,0 +1,48 @@ +# +# Copyright (C) 2012 - 2019 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 Rcpp. If not, see . + +Rcpp::sourceCpp("cpp/solution.cpp") + +#test.smallDense <- function() { +A <- matrix(c(1,2,3,4), nrow=2L) +B <- matrix(c(5,6,7,8), nrow=2L) +b <- c(1,1) + +## solutions to dense systems +res <- dense_PPLU(A, b) +expect_equal(res$Ainv, solve(A)) +expect_equal(res$x, solve(A, b)) + +res <- dense_CPQR(A, b) +expect_equal(res$Ainv, solve(A)) +expect_equal(res$x, solve(A, b)) + + +#test.largeDense <- function() { +set.seed(1234321) +N <- 100L +AA <- matrix(rnorm(N * N), nrow=N) +bb <- rnorm(N) + +res <- dense_PPLU(AA, bb) +expect_equal(res$Ainv, solve(AA)) +expect_equal(res$x, solve(AA, bb)) + +res <- dense_CPQR(AA, bb) +expect_equal(res$Ainv, solve(AA)) +expect_equal(res$x, solve(AA, bb)) diff --git a/inst/tinytest/test_sparse.R b/inst/tinytest/test_sparse.R new file mode 100644 index 00000000..8eeb81f0 --- /dev/null +++ b/inst/tinytest/test_sparse.R @@ -0,0 +1,136 @@ +#!/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 . + +Rcpp::sourceCpp("cpp/sparse.cpp") + +library(Matrix) + +#test.wrapSparse.double.R <- function(){ +res <- wrapSparseDouble() +rr <- Matrix::t(as(gl(3,3), "sparseMatrix")) +colnames(rr) <- NULL +expect_equal(res, rr, info = "wrap >") + + +#test.wrapSparse.double.ColMajor.R <- function(){ +res <- wrapSparseDoubleColumnMajor() +rr <- Matrix::t(as(gl(3,3), "sparseMatrix")) +colnames(rr) <- NULL +expect_equal(res, rr, info = "wrap >") + +## test.wrapSparse.int.ColMajor.R <- function(){ ## classes not yet exported from Matrix + +## fx <- cxxfunction( , ' + +## Eigen::SparseMatrix mm(9,3); +## mm.reserve(9); +## for (int j = 0; j < 3; ++j) { +## mm.startVec(j); +## for (int i = 3 * j; i < 3 * (j + 1); ++i) +## mm.insertBack(i, j) = 1; +## } +## mm.finalize(); +## return wrap(mm); +## ' , plugin = "RcppEigen" ) + +## #res <- fx() +## #rr <- Matrix::t(as(gl(3,3), "sparseMatrix")) +## #colnames(rr) <- NULL +## #expect_equal( res, rr, info = "wrap >") +## checkException( fx(), info = "wrap >" ) +## } + +#test.wrapSparse.double.RowMajor.R <- function(){ +res <- wrapSparseDoubleRowMajor() +rr <- new( "dgRMatrix", j=rep(0L:2L, each=3), p=0L:9L, x=as.numeric(9:1), Dim=c(9L,3L) ) +colnames(rr) <- NULL +expect_equal( res, rr, info = "wrap >") + + +## test.wrapSparse.int.RowMajor.R <- function(){ + +## fx <- cxxfunction( , ' + +## Eigen::SparseMatrix mm(9,3); +## mm.reserve(9); +## for (int irow = 0; irow < 9; ++irow) { +## mm.startVec(irow); +## mm.insertBack(irow, irow / 3) = 9 - irow; +## } +## mm.finalize(); +## return wrap(mm); +## ' , plugin = "RcppEigen" ) + +## #res <- fx() +## #rr <- new( "igRMatrix", j=rep(0L:2L, each=3), p=0L:9L, x=9L:1L, Dim=c(9L,3L) ) +## #colnames(rr) <- NULL +## #expect_equal( res, rr, info = "wrap >") +## checkException( fx(), info = "wrap >" ) +## } + +#test.asSparse.double.ColMajor.R <- function(){ +rr <- Matrix::t(as(gl(3,3), "sparseMatrix")) +colnames(rr) <- NULL +res <- asSparseDoubleColumnMajor( rr ) +expect_equal( res, rr, info = "as >") + + +#test.asMappedSparse.double.ColMajor.R <- function(){ +rr <- Matrix::t(as(gl(3,3), "sparseMatrix")) +colnames(rr) <- NULL +res <- asMappedSparseDoubleColMajor( rr ) +expect_equal( res, sum(rr), info = "as > >") + + +#test.asMappedSparse.deprecated.double.ColMajor.R <- function(){ +fx <- asMappedSparseDeprecatedDoubleColMajor +rr <- Matrix::t(as(gl(3,3), "sparseMatrix")) +colnames(rr) <- NULL +res <- fx( rr ) +expect_equal( res, sum(rr), info = "as >") + + +#test.asSparse.double.RowMajor.R <- function(){ +rr <- new( "dgRMatrix", j=rep(0L:2L, each=3), p=0L:9L, x=as.numeric(9:1), Dim=c(9L,3L) ) +colnames(rr) <- NULL +res <- asSparseDoubleRowMajor( rr ) +expect_equal( res, sum(rr), info = "as >") + + +#test.asMappedSparse.double.RowMajor.R <- function(){ +rr <- new( "dgRMatrix", j=rep(0L:2L, each=3), p=0L:9L, x=as.numeric(9:1), Dim=c(9L,3L) ) +colnames(rr) <- NULL +res <- asMappedSparseDoubleRowMajor( rr ) +expect_equal( res, sum(rr), info = "as > >") + + +#test.asMappedSparse.deprecated.double.RowMajor.R <- function(){ +rr <- new( "dgRMatrix", j=rep(0L:2L, each=3), p=0L:9L, x=as.numeric(9:1), Dim=c(9L,3L) ) +colnames(rr) <- NULL +res <- asMappedSparseDeprecatedDoubleRowMajor( rr ) +expect_equal( res, sum(rr), info = "as >") + + +# test.sparseCholesky.R <- function() { +suppressMessages(require("Matrix", character.only=TRUE)) +data("KNex", package = "Matrix") +rr <- sparseCholesky(KNex) +expect_equal(rr[[1]], + as.vector(solve(crossprod(KNex[[1]]), crossprod(KNex[[1]], KNex[[2]])), mode="numeric"), + info = "Cholmod solution") diff --git a/inst/tinytest/test_transform.R b/inst/tinytest/test_transform.R new file mode 100644 index 00000000..ec24ec28 --- /dev/null +++ b/inst/tinytest/test_transform.R @@ -0,0 +1,40 @@ +# +# Copyright (C) 2012 - 2019 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 Rcpp. If not, see . + +Rcpp::sourceCpp("cpp/transform.cpp") + +#test.transformationAr1 <- function() { +set.seed(1234321) +x <- rnorm(10L) + +res <- transformAr1unbounded(x) +expect_equal(res$abs, abs(x)) +expect_equal(res$abs2, x * x) +expect_equal(res$exp, exp(x)) +expect_equal(res$cos, cos(x)) + + +#test.transformationAr2 <- function() { +set.seed(1234321) +X <- matrix(rnorm(100L), nrow = 10, ncol = 10) + +res <- transformAr2unbounded(X) +expect_equal(res$abs, abs(X)) +expect_equal(res$abs2, X * X) +expect_equal(res$exp, exp(X)) +expect_equal(res$cos, cos(X)) diff --git a/inst/tinytest/test_wrap.R b/inst/tinytest/test_wrap.R new file mode 100644 index 00000000..01519d06 --- /dev/null +++ b/inst/tinytest/test_wrap.R @@ -0,0 +1,87 @@ +# +# Copyright (C) 2012 - 2013 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 Rcpp. If not, see . + +Rcpp::sourceCpp("cpp/wrap.cpp") + +#test.wrapVectors <- function() { +res <- wrap_vectors() + +expect_equal(res[[1]][[1]], complex(5)) +expect_equal(res[[1]][[2]], double(5)) +expect_equal(res[[1]][[3]], double(5)) +expect_equal(res[[1]][[4]], integer(5)) +expect_equal(res[[1]][[5]], integer(5)) + +expect_equal(res[[2]][[1]], (1+0i) * diag(nr=3L)) +expect_equal(res[[2]][[2]], diag(nr=3L)) +expect_equal(res[[2]][[3]], diag(nr=3L)) +expect_equal(res[[2]][[4]], matrix(as.integer((diag(nr=3L))),nr=3L)) +expect_equal(res[[2]][[5]], matrix(as.integer((diag(nr=3L))),nr=3L)) + +expect_equal(res[[3]][[1]], matrix(complex(5), nr=1L)) +expect_equal(res[[3]][[2]], matrix(numeric(5), nr=1L)) +expect_equal(res[[3]][[3]], matrix(numeric(5), nr=1L)) +expect_equal(res[[3]][[4]], matrix(integer(5), nr=1L)) +expect_equal(res[[3]][[5]], matrix(integer(5), nr=1L)) + +expect_equal(res[[4]][[1]], as.matrix(complex(5))) +expect_equal(res[[4]][[2]], as.matrix(numeric(5))) +expect_equal(res[[4]][[3]], as.matrix(numeric(5))) +expect_equal(res[[4]][[4]], as.matrix(integer(5))) +expect_equal(res[[4]][[5]], as.matrix(integer(5))) + +expect_equal(res[[5]][[1]], matrix(complex(9L), nc=3L)) +expect_equal(res[[5]][[2]], matrix(numeric(9L), nc=3L)) +expect_equal(res[[5]][[3]], matrix(numeric(9L), nc=3L)) +expect_equal(res[[5]][[4]], matrix(integer(9L), nc=3L)) +expect_equal(res[[5]][[5]], matrix(integer(9L), nc=3L)) + +expect_equal(res[[6]][[1]], complex(5)) +expect_equal(res[[6]][[2]], double(5)) +expect_equal(res[[6]][[3]], double(5)) +expect_equal(res[[6]][[4]], integer(5)) +expect_equal(res[[6]][[5]], integer(5)) + +oneTen <- seq(1, 10, length.out=6L) + +expect_equal(res[[7]][[1]], oneTen) +expect_equal(res[[7]][[2]], log(oneTen)) +expect_equal(res[[7]][[3]], exp(oneTen)) +expect_equal(res[[7]][[4]], sqrt(oneTen)) +expect_equal(res[[7]][[5]], cos(oneTen)) + + +#test.asVec <- function() { +res <- as_Vec(list(1:10, as.numeric(1:10))) +expect_equal(unlist(res), rep.int(55, 10L)) + +#test.asArray <- function() { +res <- as_Array(list(1:10, as.numeric(1:10))) +expect_equal(unlist(res), rep.int(55, 10L)) + +#test.asMat <- function() { +integer_mat <- matrix(as.integer(diag(nrow = 5L))) +numeric_mat <- diag(nrow = 5L) +res <- as_Mat(list(integer_mat, numeric_mat)) +expect_equal(unlist(res), rep.int(5, 6L)) + +#test.asArray2D <- function() { +integer_mat <- matrix(as.integer(diag(nrow = 5L))) +numeric_mat <- diag(nrow = 5L) +res <- as_Array2D(list(integer_mat, numeric_mat)) +expect_equal(unlist(res), rep.int(5, 6L)) diff --git a/inst/unitTests/runTests.R b/inst/unitTests/runTests.R deleted file mode 100644 index 7d41a041..00000000 --- a/inst/unitTests/runTests.R +++ /dev/null @@ -1,100 +0,0 @@ - -pkg <- "RcppEigen" - -if ( ! require( "inline", character.only = TRUE, quietly = TRUE ) ){ - stop( "The inline package is required to run RcppEigen unit tests" ) -} - -if ( compareVersion( packageDescription( "inline" )[["Version"]], "0.3.5" ) < 0 ){ - stop( "RcppEigen unit tests need at least the version 0.3.5 of inline" ) -} - -if (require("RUnit", quietly = TRUE)) { - - is_local <- function(){ - if ( exists( "argv", globalenv() ) && "--local" %in% argv ) return(TRUE) - if ( "--local" %in% commandArgs(TRUE) ) return(TRUE) - FALSE - } - if ( is_local() ) path <- getwd() - - library(package=pkg, character.only = TRUE) - if (!(exists("path") && file.exists(path))) - path <- system.file("unitTests", package = pkg) - - ## --- Testing --- - - ## Define tests - testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), dirs = path) - - if (interactive()) { - cat("Now have RUnit Test Suite 'testSuite' for package '", pkg, "' :\n", sep='') - str(testSuite) - cat('', "Consider doing", - "\t tests <- runTestSuite(testSuite)", "\nand later", - "\t printTextProtocol(tests)", '', sep="\n") - } else { ## run from shell / Rscript / R CMD Batch / ... - ## Run - tests <- runTestSuite(testSuite) - - output <- NULL - - process_args <- function(argv){ - if ( !is.null(argv) && length(argv) > 0 ){ - rx <- "^--output=(.*)$" - g <- grep( rx, argv, value = TRUE ) - if ( length(g) ){ - sub( rx, "\\1", g[1L] ) - } - } - } - - # R CMD check uses this - if ( exists( "RcppEigen.unit.test.output.dir", globalenv() ) ){ - output <- RcppEigen.unit.test.output.dir - } else { - - ## give a chance to the user to customize where he/she wants - ## the unit tests results to be stored with the --output= command - ## line argument - if ( exists( "argv", globalenv() ) ){ - ## littler - output <- process_args(argv) - } else { - ## Rscript - output <- process_args(commandArgs(TRUE)) - } - } - - if( is.null(output) ) { # if it did not work, use parent dir - output <- ".." # as BDR does not want /tmp to be used - } - - ## Print results - output.txt <- file.path( output, sprintf("%s-unitTests.txt", pkg)) - output.html <- file.path( output, sprintf("%s-unitTests.html", pkg)) - - printTextProtocol(tests, fileName=output.txt) - message( sprintf( "saving txt unit test report to '%s'", output.txt ) ) - - ## Print HTML version to a file - ## printHTMLProtocol has problems on Mac OS X - if (Sys.info()["sysname"] != "Darwin"){ - message( sprintf( "saving html unit test report to '%s'", output.html ) ) - printHTMLProtocol(tests, fileName=output.html) - } - - ## stop() if there are any failures i.e. FALSE to unit test. - ## This will cause R CMD check to return error and stop - err <- getErrors(tests) - if ( (err$nFail + err$nErr) > 0) { - stop( sprintf( "unit test problems: %d failures, %d errors", err$nFail, err$nErr) ) - } else { - success <- err$nTestFunc - err$nFail - err$nErr - err$nDeactivated - cat( sprintf( "%d / %d\n", success, err$nTestFunc ) ) - } - } -} else { - cat("R package 'RUnit' cannot be loaded -- no unit tests run\n", "for package", pkg,"\n") -} - diff --git a/inst/unitTests/runit.RcppEigen.R b/inst/unitTests/runit.RcppEigen.R deleted file mode 100644 index d044ca43..00000000 --- a/inst/unitTests/runit.RcppEigen.R +++ /dev/null @@ -1,269 +0,0 @@ -#!/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 . - -.setUp <- function(){ - suppressMessages(require(inline)) -} - -test.wrap.R <- function(){ - - fx <- cxxfunction( , ' - - List vecs = List::create( - _["Vec"] = Eigen::VectorXcd::Zero(5), - _["Vec"] = Eigen::VectorXd::Zero(5), - _["Vec"] = Eigen::VectorXf::Zero(5), - _["Vec"] = Eigen::VectorXi::Zero(5) - ); - - // A VectorX 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 objects are defined at compile time to have one column, - // whereas a MatrixX has a dynamic number of columns that is set to 1 - // during execution of the code. A MatrixX object can be resized to have - // a different number of columns. A VectorX object cannot. - List cols = List::create( - _["Col"] = Eigen::MatrixXcd::Zero(5, 1), - _["Col"] = Eigen::MatrixXd::Zero(5, 1), - _["Col"] = Eigen::MatrixXf::Zero(5, 1), - _["Col"] = Eigen::MatrixXi::Zero(5, 1) - ); - - List rows = List::create( - _["Row"] = Eigen::RowVectorXcd::Zero(5), - _["Row"] = Eigen::RowVectorXd::Zero(5), - _["Row"] = Eigen::RowVectorXf::Zero(5), - _["Row"] = Eigen::RowVectorXi::Zero(5) - ); - - List matrices = List::create( - _["Mat"] = Eigen::MatrixXcd::Identity(3, 3), - _["Mat"] = Eigen::MatrixXd::Identity(3, 3), - _["Mat"] = Eigen::MatrixXf::Identity(3, 3), - _["Mat"] = Eigen::MatrixXi::Identity(3, 3) - ); - - // ArrayXX 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"] = Eigen::ArrayXXcd::Zero(3, 3), - _["Arr2"] = Eigen::ArrayXXd::Zero(3, 3), - _["Arr2"] = Eigen::ArrayXXf::Zero(3, 3), - _["Arr2"] = Eigen::ArrayXXi::Zero(3, 3) - ); - - // ArrayX objects have the same structure as VectorX objects - // but allow componentwise arithmetic, including functions like exp, log, - // sqrt, ... - List arrays1 = List::create( - _["Arr1"] = Eigen::ArrayXcd::Zero(5), - _["Arr1"] = Eigen::ArrayXd::Zero(5), - _["Arr1"] = Eigen::ArrayXf::Zero(5), - _["Arr1"] = Eigen::ArrayXi::Zero(5) - ); - - List operations = List::create( - _["Op_seq"] = Eigen::ArrayXd::LinSpaced(6, 1, 10), // arguments are length.out, start, end - _["Op_log"] = Eigen::ArrayXd::LinSpaced(6, 1, 10).log(), - _["Op_exp"] = Eigen::ArrayXd::LinSpaced(6, 1, 10).exp(), - _["Op_sqrt"] = Eigen::ArrayXd::LinSpaced(6, 1, 10).sqrt(), - _["Op_cos"] = Eigen::ArrayXd::LinSpaced(6, 1, 10).cos() - ); - - List output = List::create( - _["vectors : VectorX"] = vecs, - _["matrices : MatrixX"] = matrices, - _["rows : RowVectorX"] = rows, - _["columns : MatrixX"] = cols, - _["arrays2d : ArrayXX"] = arrays2, - _["arrays1d : ArrayX"] = arrays1, - _["operations : ArrayXd"] = operations - ); - - return output ; - ' , plugin = "RcppEigen" ) - - res <- fx() - - checkEquals( res[["vectors : VectorX"]][["Vec"]], complex(5), msg = "VectorXcd::Zero(5)") - checkEquals( res[["vectors : VectorX"]][["Vec"]], double(5), msg = "VectorXd::Zero(5)") - checkEquals( res[["vectors : VectorX"]][["Vec"]], double(5), msg = "VectorXf::Zero(5)") - checkEquals( res[["vectors : VectorX"]][["Vec"]], integer(5), msg = "VectorXi::Zero(5)") - - checkEquals( res[["matrices : MatrixX"]][["Mat"]], (1+0i) * diag(nr=3L), msg = "MatrixXcd::Identity(3,3)") - checkEquals( res[["matrices : MatrixX"]][["Mat"]], diag(nr=3L), msg = "MatrixXd::Identity(3,3)") - checkEquals( res[["matrices : MatrixX"]][["Mat"]], diag(nr=3L), msg = "MatrixXf::Identity(3,3)") - checkEquals( res[["matrices : MatrixX"]][["Mat"]], matrix(as.integer((diag(nr=3L))),nr=3L), msg = "MatrixXi::Identity(3,3)") - - checkEquals( res[["rows : RowVectorX"]][["Row"]], matrix(complex(5), nr=1L), msg = "RowVectorXcd::Zero(5)") - checkEquals( res[["rows : RowVectorX"]][["Row"]], matrix(numeric(5), nr=1L), msg = "RowVectorXd::Zero(5)") - checkEquals( res[["rows : RowVectorX"]][["Row"]], matrix(numeric(5), nr=1L), msg = "RowVectorXf::Zero(5)") - checkEquals( res[["rows : RowVectorX"]][["Row"]], matrix(integer(5), nr=1L), msg = "RowVectorXi::Zero(5)") - - checkEquals( res[["columns : MatrixX"]][["Col"]], as.matrix(complex(5)), msg = "MatrixXcd::Zero(5, 1)") - checkEquals( res[["columns : MatrixX"]][["Col"]], as.matrix(numeric(5)), msg = "MatrixXd::Zero(5, 1)") - checkEquals( res[["columns : MatrixX"]][["Col"]], as.matrix(numeric(5)), msg = "MatrixXf::Zero(5, 1)") - checkEquals( res[["columns : MatrixX"]][["Col"]], as.matrix(integer(5)), msg = "MatrixXi::Zero(5, 1)") - - checkEquals( res[["arrays2d : ArrayXX"]][["Arr2"]], matrix(complex(9L), nc=3L), msg = "ArrayXXcd::Zero(3,3)") - checkEquals( res[["arrays2d : ArrayXX"]][["Arr2"]], matrix(numeric(9L), nc=3L), msg = "ArrayXXd::Zero(3,3)") - checkEquals( res[["arrays2d : ArrayXX"]][["Arr2"]], matrix(numeric(9L), nc=3L), msg = "ArrayXXf::Zero(3,3)") - checkEquals( res[["arrays2d : ArrayXX"]][["Arr2"]], matrix(integer(9L), nc=3L), msg = "ArrayXXi::Zero(3,3)") - - checkEquals( res[["arrays1d : ArrayX"]][["Arr1"]], complex(5), msg = "ArrayXcd::Zero(5)") - checkEquals( res[["arrays1d : ArrayX"]][["Arr1"]], double(5), msg = "ArrayXd::Zero(5)") - checkEquals( res[["arrays1d : ArrayX"]][["Arr1"]], double(5), msg = "ArrayXf::Zero(5)") - checkEquals( res[["arrays1d : ArrayX"]][["Arr1"]], integer(5), msg = "ArrayXi::Zero(5)") - - oneTen <- seq(1, 10, length.out=6L) - - checkEquals( res[["operations : ArrayXd"]][["Op_seq"]], oneTen, msg = "Op_seq") - checkEquals( res[["operations : ArrayXd"]][["Op_log"]], log(oneTen), msg = "Op_log") - checkEquals( res[["operations : ArrayXd"]][["Op_exp"]], exp(oneTen), msg = "Op_exp") - checkEquals( res[["operations : ArrayXd"]][["Op_sqrt"]], sqrt(oneTen), msg = "Op_sqrt") - checkEquals( res[["operations : ArrayXd"]][["Op_cos"]], cos(oneTen), msg = "Op_cos") - -} - -test.as.Vec <- 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 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" ) -} - -test.as.MVec <- function(){ - fx <- cxxfunction( signature(input_ = "list" ) , ' - - List input(input_) ; - const Eigen::Map m1 = input[0] ; // maps share storage and do not allow conversion - const Eigen::Map m2 = input[1] ; - - List res = List::create(m1.sum(), m2.sum()); - - return res ; - - ', plugin = "RcppEigen" ) - - res <- fx( list( 1:10, as.numeric(1:10) ) ) - checkEquals( unlist( res ), rep(55.0, 2 ), msg = "as" ) -} - -test.as.MRowVec <- function(){ - fx <- cxxfunction( signature(input_ = "list" ) , ' - - List input(input_) ; - const Eigen::Map m1 = input[0] ; // maps share storage and do not allow conversion - const Eigen::Map m2 = input[1] ; - - List res = List::create(m1.sum(), m2.sum()); - - return res ; - - ', plugin = "RcppEigen" ) - - res <- fx( list( 1:10, as.numeric(1:10) ) ) - checkEquals( unlist( res ), rep(55.0, 2 ), msg = "as" ) -} - - -test.as.MMat <- function(){ - fx <- cxxfunction( signature(input_ = "list" ) , ' - - List input(input_) ; - const Eigen::Map m1 = input[0]; // maps share storage and do not allow conversion - const Eigen::Map m2 = input[1] ; -// FIXME: Write a version of as specifically for complex matrices. -// const Eigen::Map m3 = input[2] ; - - List res = List::create(m1.sum(), m2.sum());//, m3.sum()); - - return res ; - - ', plugin = "RcppEigen" ) - - integer_mat <- matrix(as.integer(diag(nr=4L)), nc=4L) - numeric_mat <- diag(nr=5L) - complex_mat <- (1+0i) * diag(nr=5L) - res <- fx(list(integer_mat, numeric_mat, complex_mat)) - checkEquals(unlist(res), c(4L, 5)#, 5+0i) - , msg = "as" ) -} - -test.as.MSpMat <- function() { - suppressMessages(require("Matrix")) - data("KNex", package = "Matrix") - fx <- cxxfunction( signature(input_ = "list"), ' - List input(input_) ; - const Eigen::MappedSparseMatrix m1 = input[0]; // maps share storage and do not allow conversion - - List res = List::create(_["nnz"] = double(m1.nonZeros()), - _["nr"] = double(m1.rows()), - _["nc"] = double(m1.cols()), - _["inSz"] = double(m1.innerSize()), - _["outSz"] = double(m1.outerSize()), - _["sum"] = m1.sum()); - - return res ; - - ', plugin = "RcppEigen" ) - - KNX <- KNex[[1]] - res <- fx(KNex) - checkEquals(unname(unlist(res)), - as.numeric(c(nnzero(KNX), nrow(KNX), ncol(KNX), nrow(KNX), ncol(KNX), sum(KNX@x))), - msg = "as") -} - -test.as.SpMat <- function() { - suppressMessages(require("Matrix")) - data("KNex", package = "Matrix") - fx <- cxxfunction( signature(input_ = "list"), ' - List input(input_) ; - const Eigen::SparseMatrix m1 = input[0]; - - List res = List::create(_["nnz"] = double(m1.nonZeros()), - _["nr"] = double(m1.rows()), - _["nc"] = double(m1.cols()), - _["inSz"] = double(m1.innerSize()), - _["outSz"] = double(m1.outerSize()), - _["sum"] = m1.sum()); - - return res ; - ', plugin = "RcppEigen" ) - - KNX <- KNex[[1]] - res <- fx(KNex) - checkEquals(unname(unlist(res)), - as.numeric(c(nnzero(KNX), nrow(KNX), ncol(KNX), nrow(KNX), ncol(KNX), sum(KNX@x))), - msg = "as") -} diff --git a/inst/unitTests/runit.fastLm.R b/inst/unitTests/runit.fastLm.R deleted file mode 100644 index de84955b..00000000 --- a/inst/unitTests/runit.fastLm.R +++ /dev/null @@ -1,78 +0,0 @@ -#!/usr/bin/r -t -# -# Copyright (C) 2011 - 2015 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 . - -.setUp <- function(){ - suppressMessages(require(datasets)) - suppressMessages(require(RcppEigen)) -} - -test.fastLm <- function() { - data(trees, package="datasets") - flm0 <- .Call("RcppEigen_fastLm_Impl", - cbind(1, log(trees$Girth)), - log(trees$Volume), 0L, - PACKAGE="RcppEigen") - flm1 <- .Call("RcppEigen_fastLm_Impl", - cbind(1, log(trees$Girth)), - log(trees$Volume), 1L, - PACKAGE="RcppEigen") - flm2 <- .Call("RcppEigen_fastLm_Impl", - cbind(1, log(trees$Girth)), - log(trees$Volume), 2L, - PACKAGE="RcppEigen") - flm3 <- .Call("RcppEigen_fastLm_Impl", - cbind(1, log(trees$Girth)), - log(trees$Volume), 3L, - PACKAGE="RcppEigen") - flm4 <- .Call("RcppEigen_fastLm_Impl", - cbind(1, log(trees$Girth)), - log(trees$Volume), 4L, - PACKAGE="RcppEigen") - flm5 <- .Call("RcppEigen_fastLm_Impl", - cbind(1, log(trees$Girth)), - log(trees$Volume), 5L, - PACKAGE="RcppEigen") - fit <- lm(log(Volume) ~ log(Girth), data=trees) - fitCoef <- unname(coef(fit)) - fitStdErr <- unname(coef(summary(fit))[, "Std. Error", drop = TRUE]) - checkEquals(flm0$coefficients, fitCoef, msg="fastLm0.coef") - checkEquals(flm0$se, fitStdErr, msg="fastLm0.stderr") - checkEquals(flm1$coefficients, fitCoef, msg="fastLm1.coef") - checkEquals(flm1$se, fitStdErr, msg="fastLm1.stderr") - checkEquals(flm2$coefficients, fitCoef, msg="fastLm2.coef") - checkEquals(flm2$se, fitStdErr, msg="fastLm2.stderr") - checkEquals(flm3$coefficients, fitCoef, msg="fastLm3.coef") - checkEquals(flm3$se, fitStdErr, msg="fastLm3.stderr") - checkEquals(flm4$coefficients, fitCoef, msg="fastLm0.coef") - checkEquals(flm4$se, fitStdErr, msg="fastLm0.stderr") - checkEquals(flm5$coefficients, fitCoef, msg="fastLm0.coef") - checkEquals(flm5$se, fitStdErr, msg="fastLm0.stderr") -} - - -test.fastLm.formula <- function() { - data(trees, package="datasets") - flm <- fastLm(log(Volume) ~ log(Girth), data=trees) - fit <- lm(log(Volume) ~ log(Girth), data=trees) - - checkEquals(flm$coefficients, coef(fit), msg="fastLm.formula.coef") - checkEquals(as.numeric(flm$se), as.numeric(coef(summary(fit))[,2]), - msg="fastLm.formula.stderr") -} - diff --git a/inst/unitTests/runit.solutions.R b/inst/unitTests/runit.solutions.R deleted file mode 100644 index f3008f1d..00000000 --- a/inst/unitTests/runit.solutions.R +++ /dev/null @@ -1,103 +0,0 @@ -# -# Copyright (C) 2012 - 2013 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 Rcpp. If not, see . - -incl <- ' -typedef Eigen::ArrayXd Ar1; -typedef Eigen::Map MAr1; -typedef Eigen::ArrayXXd Ar2; -typedef Eigen::Map MAr2; -typedef Eigen::MatrixXd Mat; -typedef Eigen::Map MMat; -typedef Eigen::VectorXd Vec; -typedef Eigen::Map MVec; -typedef Eigen::PartialPivLU PPLU; -typedef Eigen::ColPivHouseholderQR CPQR; -' - -definitions <- list( - "dense_PPLU" = list(signature(A_="matrix", b_="numeric"), - ' - MMat A(as(A_)); - MVec b(as(b_)); - PPLU lu(A); - Mat Ainv(lu.inverse()); - Vec x(lu.solve(b)); - - return List::create(Named("A", A), - Named("Ainv", Ainv), - Named("b", b), - Named("x", x)); - '), - "dense_CPQR" = list(signature(A_="matrix", b_="numeric"), - ' - MMat A(as(A_)); - MVec b(as(b_)); - CPQR qr(A); - Mat Ainv(qr.inverse()); - Vec x(qr.solve(b)); - return List::create(Named("Ainv", Ainv), - Named("x", x)); - ') - ) - - -.setUp <- function() { - suppressMessages(require(inline)) - suppressMessages(require(RcppEigen)) - cxxargs <- ifelse(Rcpp:::capabilities()[["initializer lists"]], - "-std=c++0x","") - tests <- ".rcppeigen.solve" - if( ! exists( tests, globalenv() )) { - fun <- RcppEigen:::compile_unit_tests(definitions, - includes=incl, - cxxargs = cxxargs) - names(fun) <- names(definitions) - assign( tests, fun, globalenv() ) - } -} - -test.smallDense <- function() { - A <- matrix(c(1,2,3,4), nrow=2L) - B <- matrix(c(5,6,7,8), nrow=2L) - b <- c(1,1) - - ## solutions to dense systems - res <- .rcppeigen.solve$dense_PPLU(A, b) - checkEquals(res$Ainv, solve(A)) - checkEquals(res$x, solve(A, b)) - - res <- .rcppeigen.solve$dense_CPQR(A, b) - checkEquals(res$Ainv, solve(A)) - checkEquals(res$x, solve(A, b)) -} - -test.largeDense <- function() { - set.seed(1234321) - N <- 100L - AA <- matrix(rnorm(N * N), nrow=N) - bb <- rnorm(N) - - res <- .rcppeigen.solve$dense_PPLU(AA, bb) - checkEquals(res$Ainv, solve(AA)) - checkEquals(res$x, solve(AA, bb)) - - res <- .rcppeigen.solve$dense_CPQR(AA, bb) - checkEquals(res$Ainv, solve(AA)) - checkEquals(res$x, solve(AA, bb)) -} - diff --git a/inst/unitTests/runit.sparse.R b/inst/unitTests/runit.sparse.R deleted file mode 100644 index 89461063..00000000 --- a/inst/unitTests/runit.sparse.R +++ /dev/null @@ -1,248 +0,0 @@ -#!/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 . - -.setUp <- function(){ - suppressMessages(require(inline)) -} - -test.wrapSparse.double.R <- function(){ - - fx <- cxxfunction( , ' - - Eigen::SparseMatrix mm(9,3); - mm.reserve(9); - for (int j = 0; j < 3; ++j) { - mm.startVec(j); - for (int i = 3 * j; i < 3 * (j + 1); ++i) - mm.insertBack(i, j) = 1.; - } - mm.finalize(); - return wrap(mm); -' , plugin = "RcppEigen" ) - - res <- fx() - rr <- Matrix::t(as(gl(3,3), "sparseMatrix")) - colnames(rr) <- NULL - checkEquals( res, rr, msg = "wrap >") -} - -test.wrapSparse.double.ColMajor.R <- function(){ - - fx <- cxxfunction( , ' - - Eigen::SparseMatrix mm(9,3); - mm.reserve(9); - for (int j = 0; j < 3; ++j) { - mm.startVec(j); - for (int i = 3 * j; i < 3 * (j + 1); ++i) - mm.insertBack(i, j) = 1.; - } - mm.finalize(); - return wrap(mm); -' , plugin = "RcppEigen" ) - - res <- fx() - rr <- Matrix::t(as(gl(3,3), "sparseMatrix")) - colnames(rr) <- NULL - checkEquals( res, rr, msg = "wrap >") -} - -## test.wrapSparse.int.ColMajor.R <- function(){ ## classes not yet exported from Matrix - -## fx <- cxxfunction( , ' - -## Eigen::SparseMatrix mm(9,3); -## mm.reserve(9); -## for (int j = 0; j < 3; ++j) { -## mm.startVec(j); -## for (int i = 3 * j; i < 3 * (j + 1); ++i) -## mm.insertBack(i, j) = 1; -## } -## mm.finalize(); -## return wrap(mm); -## ' , plugin = "RcppEigen" ) - -## #res <- fx() -## #rr <- Matrix::t(as(gl(3,3), "sparseMatrix")) -## #colnames(rr) <- NULL -## #checkEquals( res, rr, msg = "wrap >") -## checkException( fx(), msg = "wrap >" ) -## } - -test.wrapSparse.double.RowMajor.R <- function(){ - - fx <- cxxfunction( , ' - - Eigen::SparseMatrix mm(9,3); - mm.reserve(9); - for (int irow = 0; irow < 9; ++irow) { - mm.startVec(irow); - mm.insertBack(irow, irow / 3) = static_cast( 9 - irow ); - } - mm.finalize(); - return wrap(mm); -' , plugin = "RcppEigen" ) - - res <- fx() - rr <- new( "dgRMatrix", j=rep(0L:2L, each=3), p=0L:9L, x=as.numeric(9:1), Dim=c(9L,3L) ) - colnames(rr) <- NULL - checkEquals( res, rr, msg = "wrap >") -} - -## test.wrapSparse.int.RowMajor.R <- function(){ - -## fx <- cxxfunction( , ' - -## Eigen::SparseMatrix mm(9,3); -## mm.reserve(9); -## for (int irow = 0; irow < 9; ++irow) { -## mm.startVec(irow); -## mm.insertBack(irow, irow / 3) = 9 - irow; -## } -## mm.finalize(); -## return wrap(mm); -## ' , plugin = "RcppEigen" ) - -## #res <- fx() -## #rr <- new( "igRMatrix", j=rep(0L:2L, each=3), p=0L:9L, x=9L:1L, Dim=c(9L,3L) ) -## #colnames(rr) <- NULL -## #checkEquals( res, rr, msg = "wrap >") -## checkException( fx(), msg = "wrap >" ) -## } - -test.asSparse.double.ColMajor.R <- function(){ - - fx <- cxxfunction( sig=signature(R_mm="dgCMatrix"), ' - - Eigen::SparseMatrix mm = Rcpp::as >( R_mm ); - return wrap(mm); -' , plugin = "RcppEigen" ) - - rr <- Matrix::t(as(gl(3,3), "sparseMatrix")) - colnames(rr) <- NULL - res <- fx( R_mm = rr ) - checkEquals( res, rr, msg = "as >") -} - -test.asMappedSparse.double.ColMajor.R <- function(){ - - fx <- cxxfunction( sig=signature(R_mm="dgCMatrix"), ' - - typedef Eigen::Map > MapMat; - MapMat mm = Rcpp::as( R_mm ); - return wrap(mm); -' , plugin = "RcppEigen" ) - - rr <- Matrix::t(as(gl(3,3), "sparseMatrix")) - colnames(rr) <- NULL - res <- fx( R_mm = rr ) - checkEquals( res, rr, msg = "as > >") -} - -test.asMappedSparse.deprecated.double.ColMajor.R <- function(){ - - fx <- cxxfunction( sig=signature(R_mm="dgCMatrix"), ' - // Deprecated - typedef Eigen::MappedSparseMatrix MapMat; - MapMat mm = Rcpp::as( R_mm ); - return wrap(mm); -' , plugin = "RcppEigen" ) - - rr <- Matrix::t(as(gl(3,3), "sparseMatrix")) - colnames(rr) <- NULL - res <- fx( R_mm = rr ) - checkEquals( res, rr, msg = "as >") -} - -test.asSparse.double.RowMajor.R <- function(){ - fx <- cxxfunction( sig=signature(R_mm="dgRMatrix"), ' - - Eigen::SparseMatrix mm = Rcpp::as >( R_mm ); - return wrap(mm); -' , plugin = "RcppEigen" ) - - rr <- new( "dgRMatrix", j=rep(0L:2L, each=3), p=0L:9L, x=as.numeric(9:1), Dim=c(9L,3L) ) - colnames(rr) <- NULL - res <- fx( R_mm = rr ) - checkEquals( res, rr, msg = "as >") -} - -test.asMappedSparse.double.RowMajor.R <- function(){ - fx <- cxxfunction( sig=signature(R_mm="dgRMatrix"), ' - - typedef Eigen::Map > MapMat; - MapMat mm = Rcpp::as( R_mm ); - return wrap(mm); -' , plugin = "RcppEigen" ) - - rr <- new( "dgRMatrix", j=rep(0L:2L, each=3), p=0L:9L, x=as.numeric(9:1), Dim=c(9L,3L) ) - colnames(rr) <- NULL - res <- fx( R_mm = rr ) - checkEquals( res, rr, msg = "as > >") -} - -test.asMappedSparse.deprecated.double.RowMajor.R <- function(){ - fx <- cxxfunction( sig=signature(R_mm="dgRMatrix"), ' - // Deprecated - typedef Eigen::MappedSparseMatrix MapMat; - MapMat mm = Rcpp::as( R_mm ); - return wrap(mm); -' , plugin = "RcppEigen" ) - - rr <- new( "dgRMatrix", j=rep(0L:2L, each=3), p=0L:9L, x=as.numeric(9:1), Dim=c(9L,3L) ) - colnames(rr) <- NULL - res <- fx( R_mm = rr ) - checkEquals( res, rr, msg = "as >") -} - - -test.sparseCholesky.R <- function() { - suppressMessages(require("Matrix", character.only=TRUE)) - data("KNex", package = "Matrix") - - fx <- cxxfunction( signature(input_ = "list"), ' - using Eigen::VectorXd; - using Eigen::MatrixXd; - using Eigen::Lower; - using Eigen::Map; - using Eigen::SparseMatrix; - using Eigen::SimplicialLDLT; - using Eigen::Success; - - List input(input_); - const Map > m1 = input[0]; - const Map v1 = input[1]; - SparseMatrix m2(m1.cols(), m1.cols()); - m2.selfadjointView().rankUpdate(m1.adjoint()); - - SimplicialLDLT > ff(m2); - VectorXd res = ff.solve(m1.adjoint() * v1); - - return List::create(_["res"] = res, - _["rows"] = double(ff.rows()), - _["cols"] = double(ff.cols())); -', - plugin = "RcppEigen") - - rr <- fx(KNex) - checkEquals(rr[[1]], as.vector(solve(crossprod(KNex[[1]]), - crossprod(KNex[[1]], KNex[[2]])), - mode="numeric"), - "Cholmod solution") -} diff --git a/inst/unitTests/runit.transform.R b/inst/unitTests/runit.transform.R deleted file mode 100644 index 73223bf3..00000000 --- a/inst/unitTests/runit.transform.R +++ /dev/null @@ -1,87 +0,0 @@ -# -# Copyright (C) 2012 - 2013 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 Rcpp. If not, see . - -incl <- ' -typedef Eigen::ArrayXd Ar1; -typedef Eigen::Map MAr1; -typedef Eigen::ArrayXXd Ar2; -typedef Eigen::Map MAr2; -typedef Eigen::MatrixXd Mat; -typedef Eigen::Map MMat; -typedef Eigen::VectorXd Vec; -typedef Eigen::Map MVec; -' - -definitions <- list( - "ar1_unbounded" = list(signature(x_="numeric"), - ' - MAr1 x(as(x_)); - - return List::create(Named("abs", x.abs()), - Named("abs2", x.abs2()), - Named("exp", x.exp()), - Named("cos", x.cos())); - '), - "ar2_unbounded" = list(signature(X_="matrix"), - ' - MAr2 X(as(X_)); - - return List::create(Named("abs", X.abs()), - Named("abs2", X.abs2()), - Named("exp", X.exp()), - Named("cos", X.cos())); - ') - ) - -.setUp <- function() { - suppressMessages(require(inline)) - suppressMessages(require(RcppEigen)) - cxxargs <- ifelse(Rcpp:::capabilities()[["initializer lists"]], - "-std=c++0x","") - tests <- ".rcppeigen.trans" - if( ! exists( tests, globalenv() )) { - fun <- RcppEigen:::compile_unit_tests(definitions, - includes=incl, - cxxargs = cxxargs) - names(fun) <- names(definitions) - assign(tests, fun, globalenv()) - } -} - -test.transformationAr1 <- function() { - set.seed(1234321) - x <- rnorm(10L) - - res <- .rcppeigen.trans$ar1_unbounded(x) - checkEquals(res$abs, abs(x)) - checkEquals(res$abs2, x * x) - checkEquals(res$exp, exp(x)) - checkEquals(res$cos, cos(x)) -} - -test.transformationAr2 <- function() { - set.seed(1234321) - X <- matrix(rnorm(100L), nrow = 10, ncol = 10) - - res <- .rcppeigen.trans$ar2_unbounded(X) - checkEquals(res$abs, abs(X)) - checkEquals(res$abs2, X * X) - checkEquals(res$exp, exp(X)) - checkEquals(res$cos, cos(X)) -} - diff --git a/tests/doRUnit.R b/tests/doRUnit.R deleted file mode 100644 index 72162cd4..00000000 --- a/tests/doRUnit.R +++ /dev/null @@ -1,33 +0,0 @@ -#### doRUnit.R --- Run RUnit tests -####------------------------------------------------------------------------ - -### borrowed from package fUtilities in RMetrics -### http://r-forge.r-project.org/plugins/scmsvn/viewcvs.php/pkg/fUtilities/tests/doRUnit.R?rev=1958&root=rmetrics&view=markup - -### Originally follows Gregor Gojanc's example in CRAN package 'gdata' -### and the corresponding section in the R Wiki: -### http://wiki.r-project.org/rwiki/doku.php?id=developers:runit - -### MM: Vastly changed: This should also be "runnable" for *installed* -## package which has no ./tests/ -## ----> put the bulk of the code e.g. in ../inst/unitTests/runTests.R : - -if(require("RUnit", quietly = TRUE)) { - pkg <- "RcppEigen" - - require( pkg, character.only=TRUE) - - path <- system.file("unitTests", package = pkg) - - stopifnot(file.exists(path), file.info(path.expand(path))$isdir) - - ## without this, we get unit test failures - Sys.setenv( R_TESTS = "" ) - - RcppEigen.unit.test.output.dir <- getwd() - - source(file.path(path, "runTests.R"), echo = TRUE) - -} else { - print( "package RUnit not available, cannot run unit tests" ) -} diff --git a/tests/tinytest.R b/tests/tinytest.R new file mode 100644 index 00000000..65023dd0 --- /dev/null +++ b/tests/tinytest.R @@ -0,0 +1,15 @@ + +if (requireNamespace("tinytest", quietly=TRUE) && + utils::packageVersion("tinytest") >= "1.0.0") { + + ## Set a seed to make the test deterministic + set.seed(42) + + ## R makes us to this + Sys.setenv("R_TESTS"="") + + ## there are several more granular ways to test files in a tinytest directory, + ## see its package vignette; tests can also run once the package is installed + ## using the same command `test_package(pkgName)`, or by director or file + tinytest::test_package("RcppEigen", ncpu=getOption("Ncpus", 1)) +}