Related
First off, I assume the problem is with me and not with Eigen's LLT module. That said, here is the code (I will explain the problem briefly) but sourcing the code in Rstudio should recreate the bug.
#include <RcppEigen.h>
using namespace Rcpp;
using Eigen::MatrixXd;
using Eigen::VectorXd;
// [[Rcpp::depends(RcppEigen)]]
template <typename T>
void fillUnitNormal(Eigen::PlainObjectBase<T>& Z){
int m = Z.rows();
int n = Z.cols();
Rcpp::NumericVector r(m*n);
r = Rcpp::rnorm(m*n, 0, 1); // using vectorization from Rcpp sugar
std::copy(std::begin(r), std::end(r), Z.data());
}
template <typename T1, typename T2, typename T3>
// #param z is object derived from class MatrixBase to overwrite with sample
// #param m MAP estimate
// #param S the hessian of the NEGATIVE log-likelihood evaluated at m
// #param pars structure of type pars
// #return int 0 success, 1 failure
int cholesky_lap(Eigen::MatrixBase<T1>& z, Eigen::MatrixBase<T2>& m,
Eigen::MatrixBase<T3>& S){
int nc=z.cols();
int nr=z.rows();
Eigen::LLT<MatrixXd> hesssqrt;
hesssqrt.compute(-S);
if (hesssqrt.info() == Eigen::NumericalIssue){
Rcpp::warning("Cholesky of Hessian failed with status status Eigen::NumericalIssue");
return 1;
}
typename T1::PlainObject samp(nr, nc);
fillUnitNormal(samp);
z = hesssqrt.matrixL().solve(samp);
z.template colwise() += m;
return 0;
}
// #param z an object derived from class MatrixBase to overwrite with samples
// #param m MAP estimate (as a vector)
// #param S the hessian of the NEGATIVE log-likelihood evaluated at m
// block forms should be given as blocks row bound together, blocks
// must be square and of the same size!
// [[Rcpp::export]]
Eigen::MatrixXd LaplaceApproximation(int n_samples, Eigen::VectorXd m,
Eigen::MatrixXd S){
int p=m.rows();
MatrixXd z = MatrixXd::Zero(p, n_samples);
int status = cholesky_lap(z, m, S);
if (status==1) Rcpp::stop("decomposition failed");
return z;
}
/*** R
library(testthat)
n_samples <- 1000000
m <- 1:3
S <- diag(1:3)
S[1,2] <- S[2,1] <- -1
S <- -S # Pretending this is the negative precision matrix
# e.g., hessian of negative log likelihood
z <- LaplaceApproximation(n_samples, m, S)
expect_equal(var(t(z)), solve(-S), tolerance=0.005)
expect_equal(rowMeans(z), m, tolerance=.01)
*/
Here is the (key) output:
> expect_equal(var(t(z)), solve(-S), tolerance=0.005)
Error: var(t(z)) not equal to solve(-S).
2/9 mismatches (average diff: 1)
[1] 0.998 - 2 == -1
[5] 2.003 - 1 == 1
In Words:
I am trying to write a function to perform a Laplace approximation. This means essentially sampling from a multivariate normal with mean m and covariance inverse(-S) where S is the Hessian of the negative log-liklihood.
My code works perfectly for an eigen decomposition I coded but for some reason, it is failing with the Cholesky. (I have tried to just give a minimal reproducible example and for space am not showing the eigen decomposition).
The best thought I have now is that some aliasing issue is happening but I can't figure out where that would be...
Thank you in advance!
It turned out to be a simple math error. Not a code error. Issue was that cholesky of matrix inverse has a transpose compared to just the inverse of the cholesky of the original matrix. Changing
z = hesssqrt.matrixL().solve(samp);
to
z = hesssqrt.matrixU().solve(samp);
Solved the problem.
In R, I could extract matrix elements based on their indices as follow
> m <- matrix(1:6, nrow = 3)
> m
[,1] [,2]
[1,] 1 4
[2,] 2 5
[3,] 3 6
> row_index <- c(1, 2)
> col_index <- c(2, 2)
> m[cbind(row_index, col_index)]
[1] 4 5
Is there a native way to do this is Armadillo / Rcpp::Armadillo? The best I could do is a custom function that uses the row and column indices to calculate the element index (see below). I'm mostly worried that custom function won't perform as well.
#include <RcppArmadillo.h>
using namespace Rcpp;
// [[Rcpp::depends(RcppArmadillo)]]
// [[Rcpp::export]]
NumericVector Rsubmatrix(arma::uvec rowInd, arma::uvec colInd, arma::mat m) {
arma::uvec ind = (colInd - 1) * m.n_rows + (rowInd - 1);
arma::vec ret = m.elem(ind);
return wrap(ret);
}
/*** R
Rsubmatrix(row_index, col_index, m)
/
From the docs:
X.submat( vector_of_row_indices, vector_of_column_indices )
but that seems to only return matrix blocks. For non-simply-connected regions, I think your solution is the best, but you don't really need a function,
m.elem((colInd - 1) * m.n_rows + (rowInd - 1));
returns the vector without any problem. For clarity you could define a function to deal with the row+col to indices conversion,
inline arma::uvec arr2ind(arma::uvec c, arma::uvec r, int nrow)
{
return c * nrow + r;
}
// m.elem(arr2ind(colInd - 1, rowInd - 1, m.n_rows));
Let's try this...
In particular, you can subset by rowInd and colInd through writing your own loop to use the .(i,j) subset operator. Otherwise, the only other option is the solution that you proposed to start the question off...
#include <RcppArmadillo.h>
using namespace Rcpp;
// [[Rcpp::depends(RcppArmadillo)]]
// Optimized OP method
// [[Rcpp::export]]
arma::vec Rsubmatrix(const arma::mat& m, const arma::uvec& rowInd, const arma::uvec& colInd) {
return m.elem((colInd - 1) * m.n_rows + (rowInd - 1));
}
// Proposed Alternative
// [[Rcpp::export]]
arma::rowvec get_elements(const arma::mat& m, const arma::uvec& rowInd, const arma::uvec& colInd){
unsigned int n = rowInd.n_elem;
arma::rowvec out(n);
for(unsigned int i = 0; i < n; i++){
out(i) = m(rowInd[i]-1,colInd[i]-1);
}
return out;
}
Where:
m <- matrix(1:6, nrow = 3)
row_index <- c(1, 2)
col_index <- c(2, 2)
m[cbind(row_index, col_index)]
Gives:
[1] 4 5
And we have:
get_elements(m, row_index, col_index)
Giving:
[,1] [,2]
[1,] 4 5
Edit
Microbenchmark:
microbenchmark(Rsubmatrix(m, row_index, col_index), get_elements(m, row_index, col_index), times = 1e4)
Gives:
Unit: microseconds
expr min lq mean median uq max neval
Rsubmatrix(m, row_index, col_index) 2.836 3.111 4.129051 3.281 3.502 5016.652 10000
get_elements(m, row_index, col_index) 2.699 2.947 3.436844 3.115 3.335 716.742 10000
The methods are both close time wise. Note that the later should be better as it avoids having two separate loops (1. to calculate & 2. to subset) and an additional temporary vector created to store the results.
Edit
Per armadillo 7.200.0 release, the sub2ind() function has received the ability to take matrix notation. This function takes a matrix subscript via a 2 x n matrix, where n denotes the number of elements to subset, and converts them into element notation.
#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
// [[Rcpp::export]]
arma::rowvec matrix_locs(arma::mat M, arma::umat locs) {
arma::uvec eids = sub2ind( size(M), locs ); // Obtain Element IDs
arma::vec v = M.elem( eids ); // Values of the Elements
return v.t(); // Transpose to mimic R
}
Calling in R:
cpp_locs <- locs - 1 # Shift indices from R to C++
(cpp_locs <- t(cpp_locs)) # Transpose matrix for 2 x n form
matrix_locs(M, cpp_locs) # Subset the matrix
I wish to implement a simple split-apply-combine routine in Rcpp where a dataset (matrix) is split up into groups, and then the groupwise column sums are returned. This is a procedure easily implemented in R, but often takes quite some time. I have managed to implement an Rcpp solution that beats the performance of R, but I wonder if I can further improve upon it. To illustrate, here some code, first for the use of R:
n <- 50000
k <- 50
set.seed(42)
X <- matrix(rnorm(n*k), nrow=n)
g=rep(1:8,length.out=n )
use.for <- function(mat, ind){
sums <- matrix(NA, nrow=length(unique(ind)), ncol=ncol(mat))
for(i in seq_along(unique(ind))){
sums[i,] <- colSums(mat[ind==i,])
}
return(sums)
}
use.apply <- function(mat, ind){
apply(mat,2, function(x) tapply(x, ind, sum))
}
use.dt <- function(mat, ind){ # based on Roland's answer
dt <- as.data.table(mat)
dt[, cvar := ind]
dt2 <- dt[,lapply(.SD, sum), by=cvar]
as.matrix(dt2[,cvar:=NULL])
}
It turns out that the for-loops is actually quite fast and is the easiest (for me) to implement with Rcpp. It works by creating a submatrix for each group and then calling colSums on the matrix. This is implemented using RcppArmadillo:
#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
using namespace Rcpp;
using namespace arma;
// [[Rcpp::export]]
arma::mat use_arma(arma::mat X, arma::colvec G){
arma::colvec gr = arma::unique(G);
int gr_n = gr.n_rows;
int ncol = X.n_cols;
arma::mat out = zeros(gr_n, ncol);
for(int g=0; g<gr_n; g++){
int g_id = gr(g);
arma::uvec subvec = find(G==g_id);
arma::mat submat = X.rows(subvec);
arma::rowvec res = sum(submat,0);
out.row(g) = res;
}
return out;
}
However, based on answers to this question, I learned that creating copies is expensive in C++ (just as in R), but that loops are not as bad as they are in R. Since the arma-solution relies on creating matrixes (submat in the code) for each group, my guess is that avoiding this will speed up the process even further. Hence, here a second implementation based on Rcpp only using a loop:
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
NumericMatrix use_Rcpp(NumericMatrix X, IntegerVector G){
IntegerVector gr = unique(G);
std::sort(gr.begin(), gr.end());
int gr_n = gr.size();
int nrow = X.nrow(), ncol = X.ncol();
NumericMatrix out(gr_n, ncol);
for(int g=0; g<gr_n; g++){
int g_id = gr(g);
for (int j = 0; j < ncol; j++) {
double total = 0;
for (int i = 0; i < nrow; i++) {
if (G(i) != g_id) continue; // not sure how else to do this
total += X(i, j);
}
out(g,j) = total;
}
}
return out;
}
Benchmarking these solutions, including the use_dt version provided by #Roland (my previous version discriminted unfairly against data.table), as well as the dplyr-solution suggested by #beginneR, yields the following:
library(rbenchmark)
benchmark(use.for(X,g), use.apply(X,g), use.dt(X,g), use.dplyr(X,g), use_arma(X,g), use_Rcpp(X,g),
+ columns = c("test", "replications", "elapsed", "relative"), order = "relative", replications = 1000)
test replications elapsed relative
# 5 use_arma(X, g) 1000 29.65 1.000
# 4 use.dplyr(X, g) 1000 42.05 1.418
# 3 use.dt(X, g) 1000 56.94 1.920
# 1 use.for(X, g) 1000 60.97 2.056
# 6 use_Rcpp(X, g) 1000 113.96 3.844
# 2 use.apply(X, g) 1000 301.14 10.156
My intution (use_Rcpp better than use_arma) did not turn out right. Having said that, I guess that the line if (G(i) != g_id) continue; in my use_Rcpp function slows down everything. I am happy to learn about alternatives to set this up.
I am happy that I have achieved the same task in half the time it takes R to do it, but maybe the several Rcpp is much faster than R-examples have messed with my expectations, and I am wondering if I can speed this up even more. Does anyone have an idea? I also welcome any programming / coding comments in general since I am relatively new to Rcpp and C++.
No, it's not the for loop that you need to beat:
library(data.table)
#it doesn't seem fair to include calls to library in benchmarks
#you need to do that only once in your session after all
use.dt2 <- function(mat, ind){
dt <- as.data.table(mat)
dt[, cvar := ind]
dt2 <- dt[,lapply(.SD, sum), by=cvar]
as.matrix(dt2[,cvar:=NULL])
}
all.equal(use.dt(X,g), use.dt2(X,g))
#TRUE
benchmark(use.for(X,g), use.apply(X,g), use.dt(X,g), use.dt2(X,g),
columns = c("test", "replications", "elapsed", "relative"),
order = "relative", replications = 50)
# test replications elapsed relative
#4 use.dt2(X, g) 50 3.12 1.000
#1 use.for(X, g) 50 4.67 1.497
#3 use.dt(X, g) 50 7.53 2.413
#2 use.apply(X, g) 50 17.46 5.596
Maybe you're looking for (the oddly named) rowsum
library(microbenchmark)
use.rowsum = rowsum
and
> all.equal(use.for(X, g), use.rowsum(X, g), check.attributes=FALSE)
[1] TRUE
> microbenchmark(use.for(X, g), use.rowsum(X, g), times=5)
Unit: milliseconds
expr min lq median uq max neval
use.for(X, g) 126.92876 127.19027 127.51403 127.64082 128.06579 5
use.rowsum(X, g) 10.56727 10.93942 11.01106 11.38697 11.38918 5
Here's my critiques with in-line comments for your Rcpp solution.
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
NumericMatrix use_Rcpp(NumericMatrix X, IntegerVector G){
// Rcpp has a sort_unique() function, which combines the
// sort and unique steps into one, and is often faster than
// performing the operations separately. Try `sort_unique(G)`
IntegerVector gr = unique(G);
std::sort(gr.begin(), gr.end());
int gr_n = gr.size();
int nrow = X.nrow(), ncol = X.ncol();
// This constructor zero-initializes memory (kind of like
// making a copy). You should use:
//
// NumericMatrix out = no_init(gr_n, ncol)
//
// to ensure the memory is allocated, but not zeroed.
//
// EDIT: We don't have no_init for matrices right now, but you can hack
// around that with:
//
// NumericMatrix out(Rf_allocMatrix(REALSXP, gr_n, ncol));
NumericMatrix out(gr_n, ncol);
for(int g=0; g<gr_n; g++){
// subsetting with operator[] is cheaper, so use gr[g] when
// you can be sure bounds checks are not necessary
int g_id = gr(g);
for (int j = 0; j < ncol; j++) {
double total = 0;
for (int i = 0; i < nrow; i++) {
// similarily here
if (G(i) != g_id) continue; // not sure how else to do this
total += X(i, j);
}
// IIUC, you are filling the matrice row-wise. This is slower as
// R matrices are stored in column-major format, and so filling
// matrices column-wise will be faster.
out(g,j) = total;
}
}
return out;
}
I am new to C++ programming (using Rcpp for seamless integration into R), and I would appreciate some advice on how to speed up some calculations.
Consider the following example:
testmat <- matrix(1:9, nrow=3)
testvec <- 1:3
testmat*testvec
# [,1] [,2] [,3]
#[1,] 1 4 7
#[2,] 4 10 16
#[3,] 9 18 27
Here, R recycled testvec so that, loosely speaking, testvec "became" a matrix of the same dimensions as testmat for the purpose of this multiplication. Then the Hadamard product is returned. I wish to implement this behavior using Rcpp, that is I want that each element of the i-th row in the matrix testmat is multiplied with the i-th element of the vector testvec. My benchmarks tell me that my implementations are extremely slow, and I would appreciate advise on how to speed this up. Here my code:
First, using Eigen:
#include <RcppEigen.h>
// [[Rcpp::depends(RcppEigen)]]
using namespace Rcpp;
using namespace Eigen;
// [[Rcpp::export]]
NumericMatrix E_matvecprod_elwise(NumericMatrix Xs, NumericVector ys){
Map<MatrixXd> X(as<Map<MatrixXd> >(Xs));
Map<VectorXd> y(as<Map<VectorXd> >(ys));
int k = X.cols();
int n = X.rows();
MatrixXd Y(n,k) ;
// here, I emulate R's recycling. I did not find an easier way of doing this. Any hint appreciated.
for(int i = 0; i < k; ++i) {
Y.col(i) = y;
}
MatrixXd out = X.cwiseProduct(Y);
return wrap(out);
}
Here my implementation using Armadillo (adjusted to follow Dirk's example, see answer below):
#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
using namespace Rcpp;
using namespace arma;
// [[Rcpp::export]]
arma::mat A_matvecprod_elwise(const arma::mat & X, const arma::vec & y){
int k = X.n_cols ;
arma::mat Y = repmat(y, 1, k) ; //
arma::mat out = X % Y;
return out;
}
Benchmarking these solutions using R, Eigen or Armadillo shows that both Eigen and Armadillo are about 2 times slower than R. Is there a way to speed these computations up or to get at least as fast as R? Are there more elegant ways of setting this up? Any advise is appreciated and welcome. (I also encourage tangential remarks about programming style in general as I am new to Rcpp / C++.)
Here some reproducable benchmarks:
# for comparison, define R function:
R_matvecprod_elwise <- function(mat, vec) mat*vec
n <- 50000
k <- 50
X <- matrix(rnorm(n*k), nrow=n)
e <- rnorm(n)
benchmark(R_matvecprod_elwise(X, e), A2_matvecprod_elwise(X, e), E_matvecprod_elwise(X,e),
columns = c("test", "replications", "elapsed", "relative"), order = "relative", replications = 1000)
This yields
test replications elapsed relative
1 R_matvecprod_elwise(X, e) 1000 10.89 1.000
2 A_matvecprod_elwise(X, e) 1000 26.87 2.467
3 E_matvecprod_elwise(X, e) 1000 27.73 2.546
As you can see, my Rcpp-solutions perform quite miserably. Any way to do it better?
If you want to speed up your calculations you will have to be a little careful about not making copies. This usually means sacrificing readability. Here is a version which makes no copies and modifies matrix X inplace.
// [[Rcpp::export]]
NumericMatrix Rcpp_matvecprod_elwise(NumericMatrix & X, NumericVector & y){
unsigned int ncol = X.ncol();
unsigned int nrow = X.nrow();
int counter = 0;
for (unsigned int j=0; j<ncol; j++) {
for (unsigned int i=0; i<nrow; i++) {
X[counter++] *= y[i];
}
}
return X;
}
Here is what I get on my machine
> library(microbenchmark)
> microbenchmark(R=R_matvecprod_elwise(X, e), Arma=A_matvecprod_elwise(X, e), Rcpp=Rcpp_matvecprod_elwise(X, e))
Unit: milliseconds
expr min lq median uq max neval
R 8.262845 9.386214 10.542599 11.53498 12.77650 100
Arma 18.852685 19.872929 22.782958 26.35522 83.93213 100
Rcpp 6.391219 6.640780 6.940111 7.32773 7.72021 100
> all.equal(R_matvecprod_elwise(X, e), Rcpp_matvecprod_elwise(X, e))
[1] TRUE
For starters, I'd write the Armadillo version (interface) as
#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
using namespace Rcpp;
using namespace arma;
// [[Rcpp::export]]
arama::mat A_matvecprod_elwise(const arma::mat & X, const arma::vec & y){
int k = X.n_cols ;
arma::mat Y = repmat(y, 1, k) ; //
arma::mat out = X % Y;
return out;
}
as you're doing an additional conversion in and out (though the wrap() gets added by the glue code). The const & is notional (as you learned via your last question, a SEXP is a pointer object that is lightweight to copy) but better style.
You didn't show your benchmark results so I can't comment on the effect of matrix size etc pp. I suspect you might get better answers on rcpp-devel than here. Your pick.
Edit: If you really want something cheap and fast, I would just do this:
// [[Rcpp::export]]
mat cheapHadamard(mat X, vec y) {
// should row dim of X versus length of Y here
for (unsigned int i=0; i<y.n_elem; i++) X.row(i) *= y(i);
return X;
}
which allocates no new memory and will hence be faster, and probably be competitive with R.
Test output:
R> cheapHadamard(testmat, testvec)
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 4 10 16
[3,] 9 18 27
R>
My apologies for giving an essentially C answer to a C++ question, but as has been suggested the solution generally lies in the efficient BLAS implementation of things. Unfortunately, BLAS itself lacks a Hadamard multiply so you would have to implement your own.
Here is a pure Rcpp implementation that basically calls C code. If you want to make it proper C++, the worker function can be templated but for most applications using R that isn't a concern. Note that this also operates "in-place", which means that it modifies X without copying it.
// it may be necessary on your system to uncomment one of the following
//#define restrict __restrict__ // gcc/clang
//#define restrict __restrict // MS Visual Studio
//#define restrict // remove it completely
#include <Rcpp.h>
using namespace Rcpp;
#include <cstdlib>
using std::size_t;
void hadamardMultiplyMatrixByVectorInPlace(double* restrict x,
size_t numRows, size_t numCols,
const double* restrict y)
{
if (numRows == 0 || numCols == 0) return;
for (size_t col = 0; col < numCols; ++col) {
double* restrict x_col = x + col * numRows;
for (size_t row = 0; row < numRows; ++row) {
x_col[row] *= y[row];
}
}
}
// [[Rcpp::export]]
NumericMatrix C_matvecprod_elwise_inplace(NumericMatrix& X,
const NumericVector& y)
{
// do some dimension checking here
hadamardMultiplyMatrixByVectorInPlace(X.begin(), X.nrow(), X.ncol(),
y.begin());
return X;
}
Here is a version that makes a copy first. I don't know Rcpp well enough to do this natively and not incur a substantial performance hit. Creating and returning a NumericMatrix(numRows, numCols) on the stack causes the code to run about 30% slower.
#include <Rcpp.h>
using namespace Rcpp;
#include <cstdlib>
using std::size_t;
#include <R.h>
#include <Rdefines.h>
void hadamardMultiplyMatrixByVector(const double* restrict x,
size_t numRows, size_t numCols,
const double* restrict y,
double* restrict z)
{
if (numRows == 0 || numCols == 0) return;
for (size_t col = 0; col < numCols; ++col) {
const double* restrict x_col = x + col * numRows;
double* restrict z_col = z + col * numRows;
for (size_t row = 0; row < numRows; ++row) {
z_col[row] = x_col[row] * y[row];
}
}
}
// [[Rcpp::export]]
SEXP C_matvecprod_elwise(const NumericMatrix& X, const NumericVector& y)
{
size_t numRows = X.nrow();
size_t numCols = X.ncol();
// do some dimension checking here
SEXP Z = PROTECT(Rf_allocVector(REALSXP, (int) (numRows * numCols)));
SEXP dimsExpr = PROTECT(Rf_allocVector(INTSXP, 2));
int* dims = INTEGER(dimsExpr);
dims[0] = (int) numRows;
dims[1] = (int) numCols;
Rf_setAttrib(Z, R_DimSymbol, dimsExpr);
hadamardMultiplyMatrixByVector(X.begin(), X.nrow(), X.ncol(), y.begin(), REAL(Z));
UNPROTECT(2);
return Z;
}
If you're curious about usage of restrict, it means that you as the programmer enter a contract with the compiler that different bits of memory do not overlap, allowing the compiler to make certain optimizations. The restrict keyword is part of C++11 (and C99), but many compilers added extensions to C++ for earlier standards.
Some R code to benchmark:
require(rbenchmark)
n <- 50000
k <- 50
X <- matrix(rnorm(n*k), nrow=n)
e <- rnorm(n)
R_matvecprod_elwise <- function(mat, vec) mat*vec
all.equal(R_matvecprod_elwise(X, e), C_matvecprod_elwise(X, e))
X_dup <- X + 0
all.equal(R_matvecprod_elwise(X, e), C_matvecprod_elwise_inplace(X_dup, e))
benchmark(R_matvecprod_elwise(X, e),
C_matvecprod_elwise(X, e),
C_matvecprod_elwise_inplace(X, e),
columns = c("test", "replications", "elapsed", "relative"),
order = "relative", replications = 1000)
And the results:
test replications elapsed relative
3 C_matvecprod_elwise_inplace(X, e) 1000 3.317 1.000
2 C_matvecprod_elwise(X, e) 1000 7.174 2.163
1 R_matvecprod_elwise(X, e) 1000 10.670 3.217
Finally, the in-place version may actually be faster, as the repeated multiplications into the same matrix can cause some overflow mayhem.
Edit:
Removed the loop unrolling, as it provided no benefit and was otherwise distracting.
I'm trying to define a templated function that can handle both sparse and dense matrix inputs using RcppArmadillo. I got the very simple case of sending a dense or sparse matrix to C++ and back to R to work like this:
library(inline); library(Rcpp); library(RcppArmadillo)
sourceCpp(code = "
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp ;
using namespace arma ;
template <typename T> T importexport_template(const T X) {
T ret = X ;
return ret ;
};
//[[Rcpp::export]]
SEXP importexport(SEXP X) {
return wrap( importexport_template(X) ) ;
}")
library(Matrix)
X <- diag(3)
X_sp <- as(X, "dgCMatrix")
importexport(X)
## [,1] [,2] [,3]
##[1,] 1 0 0
##[2,] 0 1 0
##[3,] 0 0 1
importexport(X_sp)
##3 x 3 sparse Matrix of class "dgCMatrix"
##
##[1,] 1 . .
##[2,] . 1 .
##[3,] . . 1
and I interpret that to mean that the templating basically works (i.e., a dense R-matrix gets turned into a arma::mat, while a sparse R-matrix gets turned into a arma::sp_mat-object by the implicit calls to Rcpp::as, and the corresponding impliict Rcpp:wraps then do the right thing as well and return dense for dense and sparse for sparse).
The actual function I try to write needs multiple arguments of course, and that's where I fail -- doing something like:
sourceCpp(code ="
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp ;
using namespace arma ;
template <typename T> T scalarmult_template(const T X, double scale) {
T ret = X * scale;
return ret;
};
//[[Rcpp::export]]
SEXP scalarmult(SEXP X, double scale) {
return wrap(scalarmult_template(X, scale) ) ;
}")
fails because the compiler doesn't know how to resolve * at compile time for SEXPREC* const.
So I guess I need something like the switch-statement in this Rcpp Gallery snippet to properly dispatch to specific template functions, but I don't know how to write that for types that seem more complicated than INTSXP etc.
I think I know how to access the type I would need for such a switch statement, e.g.:
sourceCpp(code ="
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp ;
using namespace arma ;
//[[Rcpp::export]]
SEXP printtype(SEXP Xr) {
Rcpp::Rcout << TYPEOF(Xr) << std::endl ;
return R_NilValue;
}")
printtype(X)
##14
##NULL
printtype(X_sp)
##25
##NULL
but I don't understand how to proceed from there. What would a version of scalarmult_template that works for sparse and dense matrices look like?
Answering my own question based on #KevinUshey's comment. I do matrix multiplication for 3 cases: dense-dense, sparse-dense, and "indMatrix"-dense:
library(inline)
library(Rcpp)
library(RcppArmadillo)
library(Matrix)
library(rbenchmark)
sourceCpp(code="
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp ;
using namespace arma ;
arma::mat matmult_sp(const arma::sp_mat X, const arma::mat Y){
arma::mat ret = X * Y;
return ret;
};
arma::mat matmult_dense(const arma::mat X, const arma::mat Y){
arma::mat ret = X * Y;
return ret;
};
arma::mat matmult_ind(const SEXP Xr, const arma::mat Y){
// pre-multplication with index matrix is a permutation of Y's rows:
S4 X(Xr);
arma::uvec perm = X.slot("perm");
arma::mat ret = Y.rows(perm - 1);
return ret;
};
//[[Rcpp::export]]
arma::mat matmult_cpp(SEXP Xr, const arma::mat Y) {
if (Rf_isS4(Xr)) {
if(Rf_inherits(Xr, "dgCMatrix")) {
return matmult_sp(as<arma::sp_mat>(Xr), Y) ;
} ;
if(Rf_inherits(Xr, "indMatrix")) {
return matmult_ind(Xr, Y) ;
} ;
stop("unknown class of Xr") ;
} else {
return matmult_dense(as<arma::mat>(Xr), Y) ;
}
}")
n <- 10000
d <- 20
p <- 30
X <- matrix(rnorm(n*d), n, d)
X_sp <- as(diag(n)[,1:d], "dgCMatrix")
X_ind <- as(sample(1:d, n, rep=TRUE), "indMatrix")
Y <- matrix(1:(d*p), d, p)
matmult_cpp(as(X_ind, "ngTMatrix"), Y)
## Error: unknown class of Xr
all.equal(X%*%Y, matmult_cpp(X, Y))
## [1] TRUE
all.equal(as.vector(X_sp%*%Y),
as.vector(matmult_cpp(X_sp, Y)))
## [1] TRUE
all.equal(X_ind%*%Y, matmult_cpp(X_ind, Y))
## [1] TRUE
EDIT: This has been turned into an Rcpp Gallery post.