[Rcpp-commits] r4280 - in pkg/RcppArmadillo: . inst inst/include/armadillo_bits inst/unitTests inst/unitTests/cpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Mar 12 18:59:41 CET 2013
Author: edd
Date: 2013-03-12 18:59:41 +0100 (Tue, 12 Mar 2013)
New Revision: 4280
Added:
pkg/RcppArmadillo/inst/unitTests/cpp/armadillo.cpp
Modified:
pkg/RcppArmadillo/ChangeLog
pkg/RcppArmadillo/DESCRIPTION
pkg/RcppArmadillo/inst/NEWS.Rd
pkg/RcppArmadillo/inst/include/armadillo_bits/arma_version.hpp
pkg/RcppArmadillo/inst/include/armadillo_bits/diskio_meat.hpp
pkg/RcppArmadillo/inst/include/armadillo_bits/gemv.hpp
pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R
Log:
RcppArmadillo 0.3.800.1 with Armadillo 3.800.1
Also factored out cpp/armadillo.cpp from runit.RcppArmadillo.R to accelerate unit test runs
Modified: pkg/RcppArmadillo/ChangeLog
===================================================================
--- pkg/RcppArmadillo/ChangeLog 2013-03-12 02:33:57 UTC (rev 4279)
+++ pkg/RcppArmadillo/ChangeLog 2013-03-12 17:59:41 UTC (rev 4280)
@@ -1,3 +1,13 @@
+2013-03-12 Dirk Eddelbuettel <edd at debian.org>
+
+ * DESCRIPTION: Release 0.3.800.1
+
+ * inst/include/*: Upgraded to new release 3.800.1 of Armadillo
+
+ * inst/unitTests/cpp/armadillo.cpp: Factored out of
+ runit.RcppArmadillo.R to accelerate unit test run
+ * inst/unitTests/runit.RcppArmadillo.R: Deploy refactored cpp code
+
2013-03-11 Dirk Eddelbuettel <edd at debian.org>
* inst/unitTests/cpp/sample.cpp: Regrouping C++ tests for sample()
Modified: pkg/RcppArmadillo/DESCRIPTION
===================================================================
--- pkg/RcppArmadillo/DESCRIPTION 2013-03-12 02:33:57 UTC (rev 4279)
+++ pkg/RcppArmadillo/DESCRIPTION 2013-03-12 17:59:41 UTC (rev 4280)
@@ -1,7 +1,7 @@
Package: RcppArmadillo
Type: Package
Title: Rcpp integration for Armadillo templated linear algebra library
-Version: 0.3.800.0.1
+Version: 0.3.800.1
Date: $Date$
Author: Romain Francois, Dirk Eddelbuettel and Doug Bates
Maintainer: Dirk Eddelbuettel <edd at debian.org>
@@ -21,7 +21,7 @@
(due to speed and/or integration capabilities), rather than another language.
.
The RcppArmadillo package includes the header files from the templated
- Armadillo library (currently version 3.800.0). Thus users do not need to
+ Armadillo library (currently version 3.800.1). Thus users do not need to
install Armadillo itself in order to use RcppArmadillo.
.
This Armadillo integration provides a nice illustration of the
Modified: pkg/RcppArmadillo/inst/NEWS.Rd
===================================================================
--- pkg/RcppArmadillo/inst/NEWS.Rd 2013-03-12 02:33:57 UTC (rev 4279)
+++ pkg/RcppArmadillo/inst/NEWS.Rd 2013-03-12 17:59:41 UTC (rev 4280)
@@ -2,10 +2,15 @@
\title{News for Package 'RcppArmadillo'}
\newcommand{\cpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}}
-\section{Changes in RcppArmadillo version 0.3.800.0.1 (2013-03-31)}{
+\section{Changes in RcppArmadillo version 0.3.800.1 (2013-03-12)}{
\itemize{
- \item UNRELEASED -- version and date subject to change
- \item Added new sample() function contributed by Christian Gunning
+ \item Upgraded to Armadillo release Version 3.800.1 (Miami Beach)
+ \itemize{
+ \item workaround for a bug in ATLAS 3.8 on 64 bit systems
+ \item faster matrix-vector multiply for small matrices
+ }
+ \item Added new sample() function and tests contributed by Christian Gunning
+ \item Refactored unit testing code for faster unit test performance
}
}
Modified: pkg/RcppArmadillo/inst/include/armadillo_bits/arma_version.hpp
===================================================================
--- pkg/RcppArmadillo/inst/include/armadillo_bits/arma_version.hpp 2013-03-12 02:33:57 UTC (rev 4279)
+++ pkg/RcppArmadillo/inst/include/armadillo_bits/arma_version.hpp 2013-03-12 17:59:41 UTC (rev 4280)
@@ -13,7 +13,7 @@
#define ARMA_VERSION_MAJOR 3
#define ARMA_VERSION_MINOR 800
-#define ARMA_VERSION_PATCH 0
+#define ARMA_VERSION_PATCH 1
#define ARMA_VERSION_NAME "Miami Beach"
Modified: pkg/RcppArmadillo/inst/include/armadillo_bits/diskio_meat.hpp
===================================================================
--- pkg/RcppArmadillo/inst/include/armadillo_bits/diskio_meat.hpp 2013-03-12 02:33:57 UTC (rev 4279)
+++ pkg/RcppArmadillo/inst/include/armadillo_bits/diskio_meat.hpp 2013-03-12 17:59:41 UTC (rev 4280)
@@ -897,8 +897,8 @@
if( (is_float<eT>::value == true) || (is_double<eT>::value == true) )
{
f.setf(ios::scientific);
- f.precision(10);
- cell_width = 18;
+ f.precision(12);
+ cell_width = 20;
}
for(uword row=0; row < x.n_rows; ++row)
@@ -1023,8 +1023,8 @@
if( (is_float<eT>::value == true) || (is_double<eT>::value == true) )
{
f.setf(ios::scientific);
- f.precision(10);
- cell_width = 18;
+ f.precision(12);
+ cell_width = 20;
}
for(uword row=0; row < x.n_rows; ++row)
@@ -1100,7 +1100,7 @@
if( (is_float<eT>::value == true) || (is_double<eT>::value == true) )
{
f.setf(ios::scientific);
- f.precision(10);
+ f.precision(12);
}
uword x_n_rows = x.n_rows;
@@ -2303,7 +2303,7 @@
if( (is_float<eT>::value == true) || (is_double<eT>::value == true) )
{
f.setf(ios::scientific);
- f.precision(10);
+ f.precision(12);
}
f << (*iter) << '\n';
@@ -2357,7 +2357,7 @@
if( (is_float<T>::value == true) || (is_double<T>::value == true) )
{
f.setf(ios::scientific);
- f.precision(10);
+ f.precision(12);
}
const eT val = (*iter);
@@ -3097,8 +3097,8 @@
if( (is_float<eT>::value == true) || (is_double<eT>::value == true) )
{
f.setf(ios::scientific);
- f.precision(10);
- cell_width = 18;
+ f.precision(12);
+ cell_width = 20;
}
for(uword slice=0; slice < x.n_slices; ++slice)
@@ -3226,8 +3226,8 @@
if( (is_float<eT>::value == true) || (is_double<eT>::value == true) )
{
f.setf(ios::scientific);
- f.precision(10);
- cell_width = 18;
+ f.precision(12);
+ cell_width = 20;
}
for(uword slice=0; slice < x.n_slices; ++slice)
Modified: pkg/RcppArmadillo/inst/include/armadillo_bits/gemv.hpp
===================================================================
--- pkg/RcppArmadillo/inst/include/armadillo_bits/gemv.hpp 2013-03-12 02:33:57 UTC (rev 4279)
+++ pkg/RcppArmadillo/inst/include/armadillo_bits/gemv.hpp 2013-03-12 17:59:41 UTC (rev 4280)
@@ -1,5 +1,5 @@
-// Copyright (C) 2008-2012 NICTA (www.nicta.com.au)
-// Copyright (C) 2008-2012 Conrad Sanderson
+// Copyright (C) 2008-2013 NICTA (www.nicta.com.au)
+// Copyright (C) 2008-2013 Conrad Sanderson
//
// This Source Code Form is subject to the terms of the Mozilla Public
// License, v. 2.0. If a copy of the MPL was not distributed with this
@@ -131,6 +131,74 @@
+class gemv_emul_large_helper
+ {
+ public:
+
+ template<typename eT>
+ arma_hot
+ inline
+ static
+ typename arma_not_cx<eT>::result
+ dot_row_col( const Mat<eT>& A, const eT* x, const uword row, const uword N)
+ {
+ eT acc1 = eT(0);
+ eT acc2 = eT(0);
+
+ uword i,j;
+ for(i=0, j=1; j < N; i+=2, j+=2)
+ {
+ const eT xi = x[i];
+ const eT xj = x[j];
+
+ acc1 += A.at(row,i) * xi;
+ acc2 += A.at(row,j) * xj;
+ }
+
+ if(i < N)
+ {
+ acc1 += A.at(row,i) * x[i];
+ }
+
+ return (acc1 + acc2);
+ }
+
+
+
+ template<typename eT>
+ arma_hot
+ inline
+ static
+ typename arma_cx_only<eT>::result
+ dot_row_col( const Mat<eT>& A, const eT* x, const uword row, const uword N)
+ {
+ typedef typename get_pod_type<eT>::result T;
+
+ T val_real = T(0);
+ T val_imag = T(0);
+
+ for(uword i=0; i<N; ++i)
+ {
+ const std::complex<T>& Ai = A.at(row,i);
+ const std::complex<T>& xi = x[i];
+
+ const T a = Ai.real();
+ const T b = Ai.imag();
+
+ const T c = xi.real();
+ const T d = xi.imag();
+
+ val_real += (a*c) - (b*d);
+ val_imag += (a*d) + (b*c);
+ }
+
+ return std::complex<T>(val_real, val_imag);
+ }
+
+ };
+
+
+
//! \brief
//! Partial emulation of ATLAS/BLAS gemv().
//! 'y' is assumed to have been set to the correct size (i.e. taking into account the transpose)
@@ -181,13 +249,8 @@
else
for(uword row=0; row < A_n_rows; ++row)
{
- eT acc = eT(0);
+ const eT acc = gemv_emul_large_helper::dot_row_col(A, x, row, A_n_cols);
- for(uword i=0; i < A_n_cols; ++i)
- {
- acc += A.at(row,i) * x[i];
- }
-
if( (use_alpha == false) && (use_beta == false) )
{
y[row] = acc;
@@ -337,7 +400,8 @@
{
arma_extra_debug_sigprint();
- const uword threshold = (is_complex<eT>::value == true) ? 16u : 64u;
+ //const uword threshold = (is_complex<eT>::value == true) ? 16u : 64u;
+ const uword threshold = (is_complex<eT>::value == true) ? 64u : 100u;
if(A.n_elem <= threshold)
{
@@ -347,23 +411,50 @@
{
#if defined(ARMA_USE_ATLAS)
{
- arma_extra_debug_print("atlas::cblas_gemv()");
-
- atlas::cblas_gemv<eT>
- (
- atlas::CblasColMajor,
- (do_trans_A) ? ( is_complex<eT>::value ? CblasConjTrans : atlas::CblasTrans ) : atlas::CblasNoTrans,
- A.n_rows,
- A.n_cols,
- (use_alpha) ? alpha : eT(1),
- A.mem,
- A.n_rows,
- x,
- 1,
- (use_beta) ? beta : eT(0),
- y,
- 1
- );
+ if(is_complex<eT>::value == false)
+ {
+ // use gemm() instead of gemv() to work around a speed issue in Atlas 3.8.4
+
+ arma_extra_debug_print("atlas::cblas_gemm()");
+
+ atlas::cblas_gemm<eT>
+ (
+ atlas::CblasColMajor,
+ (do_trans_A) ? ( is_complex<eT>::value ? CblasConjTrans : atlas::CblasTrans ) : atlas::CblasNoTrans,
+ atlas::CblasNoTrans,
+ (do_trans_A) ? A.n_cols : A.n_rows,
+ 1,
+ (do_trans_A) ? A.n_rows : A.n_cols,
+ (use_alpha) ? alpha : eT(1),
+ A.mem,
+ A.n_rows,
+ x,
+ (do_trans_A) ? A.n_rows : A.n_cols,
+ (use_beta) ? beta : eT(0),
+ y,
+ (do_trans_A) ? A.n_cols : A.n_rows
+ );
+ }
+ else
+ {
+ arma_extra_debug_print("atlas::cblas_gemv()");
+
+ atlas::cblas_gemv<eT>
+ (
+ atlas::CblasColMajor,
+ (do_trans_A) ? ( is_complex<eT>::value ? CblasConjTrans : atlas::CblasTrans ) : atlas::CblasNoTrans,
+ A.n_rows,
+ A.n_cols,
+ (use_alpha) ? alpha : eT(1),
+ A.mem,
+ A.n_rows,
+ x,
+ 1,
+ (use_beta) ? beta : eT(0),
+ y,
+ 1
+ );
+ }
}
#elif defined(ARMA_USE_BLAS)
{
Added: pkg/RcppArmadillo/inst/unitTests/cpp/armadillo.cpp
===================================================================
--- pkg/RcppArmadillo/inst/unitTests/cpp/armadillo.cpp (rev 0)
+++ pkg/RcppArmadillo/inst/unitTests/cpp/armadillo.cpp 2013-03-12 17:59:41 UTC (rev 4280)
@@ -0,0 +1,212 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
+//
+// armadillo.cpp: RcppArmadillo unit test code
+//
+// Copyright (C) 2010 - 2013 Dirk Eddelbuettel, Romain Francois and Douglas Bates
+//
+// This file is part of RcppArmadillo.
+//
+// RcppArmadillo 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.
+//
+// RcppArmadillo 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 RcppArmadillo. If not, see <http://www.gnu.org/licenses/>.
+
+// [[Rcpp::depends(RcppArmadillo)]]
+#include <RcppArmadillo.h>
+
+using namespace Rcpp;
+
+// [[Rcpp::export]]
+List wrap_() {
+
+ // using the Named(.) = . notation
+ List cols = List::create(Named( "Col<double>" ) = arma::zeros<arma::mat>(5,1),
+ Named( "Col<float>" ) = arma::zeros<arma::fmat>(5,1));
+
+ // using the Named(., .) notation
+ List rows = List::create(Named( "Row<double>", arma::zeros<arma::mat>(1,5) ),
+ Named( "Row<float>" , arma::zeros<arma::fmat>(1,5) ));
+
+ // using the _[.] = . notation
+ List matrices = List::create(_["Mat<int>"] = arma::eye<arma::imat>( 3,3 ),
+ _["Mat<double>"] = arma::eye<arma::mat>( 3,3 ),
+ _["Mat<float>"] = arma::eye<arma::fmat>( 3, 3 ),
+ _["Mat<unsigned int>"] = arma::eye<arma::umat>( 3, 3 ));
+
+ // creating an empty list and grow it on demand
+ List fields;
+ arma::field<int> f1( 2, 2 );
+ f1( 0, 0 ) = 0;
+ f1( 1, 0 ) = 1;
+ f1( 0, 1 ) = 2;
+ f1( 1, 1 ) = 3;
+ fields["field<int>"] = f1;
+
+ arma::field<std::string> f2(2,2);
+ f2( 0, 0 ) = "a";
+ f2( 1, 0 ) = "b";
+ f2( 0, 1 ) = "c";
+ f2( 1, 1 ) = "d";
+ fields["field<std::string>"] = f2;
+
+ arma::field<arma::colvec> f3(2,2);
+ f3(0,0) = arma::zeros<arma::mat>(5,1);
+ f3(1,0) = arma::zeros<arma::mat>(4,1);
+ f3(0,1) = arma::zeros<arma::mat>(3,1);
+ f3(1,1) = arma::zeros<arma::mat>(2,1);
+ fields["field<colvec>"] = f3;
+
+ List output = List::create(_["matrices : Mat<T>"] = matrices,
+ _["rows : Row<T>"] = rows,
+ _["columns : Col<T>"] = cols,
+ _["fields : field<T>"] = fields );
+
+ return output;
+}
+
+// [[Rcpp::export]]
+List wrapGlue_() {
+ 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;
+}
+
+// [[Rcpp::export]]
+List wrapOp_() {
+ arma::mat m1 = arma::eye<arma::mat>( 3, 3 );
+
+ List res;
+ res["- mat"] = - m1;
+ return res;
+}
+
+// [[Rcpp::export]]
+List asMat_(List input) {
+ arma::imat m1 = input[0]; /* implicit as */
+ arma::mat m2 = input[1]; /* implicit as */
+ arma::umat m3 = input[0]; /* implicit as */
+ arma::fmat m4 = input[1]; /* implicit as */
+
+ List res = List::create(arma::accu( m1 ),
+ arma::accu( m2 ),
+ arma::accu( m3 ),
+ arma::accu( m4 ) );
+
+ return res;
+}
+
+// [[Rcpp::export]]
+List asCol_(List 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;
+}
+
+// [[Rcpp::export]]
+List asRow_(List 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;
+}
+
+// [[Rcpp::export]]
+List cxMat_() {
+ 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 );
+}
+
+// [[Rcpp::export]]
+ComplexMatrix mtOp_() {
+ std::complex<double> x( 1.0, 2.0 );
+ arma::mat m1 = arma::eye<arma::mat> ( 3, 3 );
+
+ return wrap( x * m1 );
+}
+
+// [[Rcpp::export]]
+NumericMatrix mtGlue_() {
+ arma::imat m2 = arma::eye<arma::imat> ( 3, 3 );
+ arma::mat m1 = arma::eye<arma::mat> ( 3, 3 );
+
+ return wrap( m1 + m2 );
+}
+
+// [[Rcpp::export]]
+NumericMatrix sugar_(NumericVector xx) {
+ arma::mat m = xx + xx;
+ return wrap( m );
+}
+
+// [[Rcpp::export]]
+ComplexMatrix sugarCplx_(ComplexVector xx) {
+ arma::cx_mat m = exp( xx );
+ return wrap( m );
+}
+
+// [[Rcpp::export]]
+List sugarCtor_(NumericVector xx) {
+ arma::mat m = xx + xx;
+ arma::colvec co = xx;
+ arma::rowvec ro = xx;
+ return List::create(_["mat"] = m + m,
+ _["rowvec"] = ro,
+ _["colvec"] = co);
+}
+
+double norm( double x, double y){
+ return ::sqrt( x*x + y*y );
+}
+
+// [[Rcpp::export]]
+List sugarMatrixCtor_(NumericVector xx) {
+ 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);
+}
+
+// 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")
+
+// }
Modified: pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R
===================================================================
--- pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R 2013-03-12 02:33:57 UTC (rev 4279)
+++ pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R 2013-03-12 17:59:41 UTC (rev 4280)
@@ -19,64 +19,11 @@
.setUp <- function(){
suppressMessages(require(inline))
+ sourceCpp(file.path(pathRcppArmadilloTests, "cpp/armadillo.cpp"))
}
test.wrap.R <- function(){
-
- fx <- cxxfunction( , '
-
- // using the Named(.) = . notation
- List cols = List::create(
- Named( "Col<double>" ) = arma::zeros<arma::mat>(5,1),
- Named( "Col<float>" ) = arma::zeros<arma::fmat>(5,1)
- ) ;
-
- // using the Named(., .) notation
- List rows = List::create(
- Named( "Row<double>", arma::zeros<arma::mat>(1,5) ),
- Named( "Row<float>" , arma::zeros<arma::fmat>(1,5) )
- ) ;
-
- // using the _[.] = . notation
- List matrices = List::create(
- _["Mat<int>"] = arma::eye<arma::imat>( 3,3 ),
- _["Mat<double>"] = arma::eye<arma::mat>( 3,3 ),
- _["Mat<float>"] = arma::eye<arma::fmat>( 3, 3 ),
- _["Mat<unsigned int>"] = arma::eye<arma::umat>( 3, 3 )
- ) ;
-
- // creating an empty list and grow it on demand
- List fields ;
- arma::field<int> f1( 2, 2 ) ;
- f1( 0, 0 ) = 0 ;
- f1( 1, 0 ) = 1 ;
- f1( 0, 1 ) = 2 ;
- f1( 1, 1 ) = 3 ;
- fields["field<int>"] = f1 ;
-
- arma::field<std::string> f2(2,2) ;
- f2( 0, 0 ) = "a" ;
- f2( 1, 0 ) = "b" ;
- f2( 0, 1 ) = "c" ;
- f2( 1, 1 ) = "d" ;
- fields["field<std::string>"] = f2 ;
-
- arma::field<arma::colvec> f3(2,2) ;
- f3(0,0) = arma::zeros<arma::mat>(5,1) ;
- f3(1,0) = arma::zeros<arma::mat>(4,1) ;
- f3(0,1) = arma::zeros<arma::mat>(3,1) ;
- f3(1,1) = arma::zeros<arma::mat>(2,1) ;
- fields["field<colvec>"] = f3 ;
-
- List output = List::create(
- _["matrices : Mat<T>"] = matrices,
- _["rows : Row<T>"] = rows,
- _["columns : Col<T>"] = cols,
- _["fields : field<T>"] = fields ) ;
-
- return output ;
- ' , plugin = "RcppArmadillo" )
-
+ fx <- wrap_
res <- fx()
checkEquals( res[[1]][[1]], matrix(as.integer((diag(3))),nr=3), msg = "eye<imat>(3,3)" )
@@ -95,55 +42,19 @@
}
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()
+ fx <- wrapGlue_
+ 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" )
+ fx <- wrapOp_
res <- fx()
checkEquals( res[[1]], -1*diag(3), msg = "wrap(Op)" )
}
test.as.Mat <- function(){
-
- fx <- cxxfunction( signature(input_ = "list" ) , '
- List input(input_) ;
- arma::imat m1 = input[0] ; /* implicit as */
- arma::mat m2 = input[1] ; /* implicit as */
- arma::umat m3 = input[0] ; /* implicit as */
- arma::fmat 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" )
-
+ fx <- asMat_
integer_mat <- matrix( as.integer(diag(4)), ncol = 4, nrow = 4 )
numeric_mat <- diag(5)
res <- fx( list( integer_mat, numeric_mat ) )
@@ -151,180 +62,78 @@
}
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" )
-
+ fx <- asCol_
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" )
-
+ fx <- asRow_
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(),
+ fx <- cxMat_
+ 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(),
+ fx <- mtOp_
+ 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(),
+ fx <- mtGlue_
+ checkEquals(fx(),
2.0 * diag(3) ,
- msg = "support for mtOp" )
+ msg = "support for mtGlue" )
}
test.sugar <- function(){
-
- fx <- cxxfunction( signature(x= "numeric") , '
- NumericVector xx(x) ;
- arma::mat m = xx + xx ;
- return wrap( m ) ;
-
- ', plugin = "RcppArmadillo" )
- checkEquals( fx(1:10),
+ fx <- sugar_
+ 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 = exp( xx ) ;
-
- return wrap( m ) ;
-
- ', plugin = "RcppArmadillo" )
+ fx <- sugarCplx_
x <- 1:10*(1+1i)
- checkEquals( fx(x),
+ 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 ),
+ fx <- sugarCtor_
+ checkEquals(fx(1:10),
+ list(mat = matrix( 4*(1:10), nrow = 10 ),
rowvec = matrix( 1:10, nrow = 1 ),
- colvec = matrix( 1:10, ncol = 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 )
+ fx <- sugarMatrixCtor_
res <- fx(1:10)
norm <- function(x, y) sqrt( x*x + y*y )
- checkEquals( res,
- list(
- mat = diag(2*(1:10)),
+ checkEquals(res,
+ list(mat = diag(2*(1:10)),
rowvec = outer( 1, 1:10, norm ),
- colvec = outer( 1:10, 1, norm )
- ),
+ colvec = outer( 1:10, 1, norm )),
msg = "Mat( sugar expression )" )
}
More information about the Rcpp-commits
mailing list