How to create a combination of k elements between n in Rcpp? - r

Good afternoon ,
We know that in R , we can retrieve all possible combinations of k elements between A = { 1 , 2 , ... , n } in that manner :
Example : A = { 1 , 2, ,3 ,4 ,5 } and K = 3
> C_wo <- combn(1:5, 3)
> C_wo
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 1 1 1 1 1 2 2 2 3
[2,] 2 2 2 3 3 4 3 3 4 4
[3,] 3 4 5 4 5 5 4 5 5 5
My question :
Is there any built-in function for Creating those combinations in rcpp ?
Thank You in advance !

I don't think there are such built-in Rcpp functions but these kinds of functions are implemented in {RcppAlgos}.

Try this out.
library(microbenchmark)
z1 <- combncpp(50,5)
z2 <- combn(50,5)
identical(t(z1), z2) # I prefer column-wise so it is transposed
[1] TRUE
microbenchmark(cpp = combncpp(25,10),
r = combn(25,10), times = 5)
Unit: milliseconds
expr min lq mean median uq max neval
cpp 275.882 295.9357 295.4369 299.9468 300.0149 305.4051 5
r 2729.003 2755.1360 2789.3226 2798.6658 2819.9010 2843.9075 5
The function:
#include <Rcpp.h>
#include <algorithm>
using namespace Rcpp;
// [[Rcpp::export]]
uint64_t choosecpp(uint64_t n, uint64_t k) {
if(k == 0) return 1;
return (n * choosecpp(n - 1, k - 1)) / k;
}
// [[Rcpp::export]]
IntegerMatrix combncpp(int N, int K) {
if(K > N) Rcpp::stop("K > N");
std::string bitmask(K, 1);
bitmask.resize(N, 0);
uint64_t n_combos = choosecpp(N,K);
IntegerMatrix results(n_combos, K);
uint64_t row_position = 0;
do {
uint64_t col_position = 0;
for (int i = 0; i < N; ++i) {
if (bitmask[i]) {
results(row_position, col_position) = i+1;
col_position++;
}
}
row_position++;
} while (std::prev_permutation(bitmask.begin(), bitmask.end()));
return results;
}
Credit where it is due, the function was modified from the algorithm listed here: Creating all possible k combinations of n items in C++

Related

Rcpp: retrieve and replace off-diagonal values of a square matrix

Using Rcpp/Armadillo, how can I efficiently extract/replace off-diagonal values of a square matrix? In R it can be achieved using: old_values = A[row(A) == (col(A) - k)]; A[row(A) == (col(A) - k)] = new_values. Using Armadillo a for-loop (see below) can be used to achive this goal. But is there a simpler way to write the code? As I need to do this operation for all k of a big matrix (>10000 rows, > 10000 columns), efficiency is better to be considered. Here is a reproducible example:
A = matrix(1:25, 5, 5)
A[row(A) == (col(A) - 3)] # extract the 3rd off-diagnal values
A[row(A) == (col(A) - 2)] = -5 of # replace the 2nd off-diagnal values with -5
The cpp code using a for loop:
arma::vec retrieve_off_diag_values( arma::mat A, unsigned k )
{
unsigned n_cols = A.n_cols;
arma::vec off_diag_values(n_cols - k);
for( unsigned i=0; i <(n_cols - k); i++ )
{
off_diag_values(i) = A(i, i+k);
}
return off_diag_values;
}
To extract values from a specified diagonal into a vector, where k < 0 indicates subdiagonals, k = 0 indicates the main diagonal, and k > 0 indicates superdiagonals:
#include<RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
// [[Rcpp::export]]
arma::vec diag_get(const arma::mat& X, int k) // note the 'const' and '&'
{
return X.diag(k);
}
To set values on a diagonal to a specific value:
// [[Rcpp::export]]
void diag_fill(arma::mat& X, int k, double value) // note the '&' character
{
X.diag(k).fill(value);
}
To change instances of a specific value on a diagonal with another value:
// [[Rcpp::export]]
void diag_change(arma::mat& X, int k, double old_value, double new_value)
{
X.diag(k).replace(old_value, new_value);
}
Retrieving off-diagonal
You can use armadillo's .diag() member function with an index k to retrieve off-diagonal.
Cases:
if k == 0 (default), then the main diagonal.
else if k < 0, then a lower triangular diagonal.
else then an upper triangular diagonal.
Example:
#include<RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
// [[Rcpp::export]]
arma::vec offdiag_extract(arma::mat& A, int k) {
return A.diag(k);
}
Test:
A = matrix(1:25, 5, 5)
offdiag_extract(A, 3)
# [,1]
# [1,] 16
# [2,] 22
Replacing off-diagonal
Edit: This section has been updated thanks to #mtall's point regarding behavior provided by other member functions.
However, .diag()= can only be used to save into the main diagonal. To ensure the replacement being viable for all diagonals, you would need to chain the .diag() member function with .fill(value), e.g.
#include<RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
// [[Rcpp::export]]
arma::mat offdiag_fill_arma(arma::mat& A, int k, double replace_value) {
A.diag(k).fill(replace_value);
return A;
}
Test:
offdiag_fill_arma(A, 2, 4)
# [,1] [,2] [,3] [,4] [,5]
# [1,] 1 6 4 16 21
# [2,] 2 7 12 4 22
# [3,] 3 8 13 18 4
# [4,] 4 9 14 19 24
# [5,] 5 10 15 20 25
Implementing off-diagonal replacement
In short, one could implement off-diagonal replacement using a single for loop with the appropriate k offset.
#include<RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
// [[Rcpp::export]]
arma::mat offdiag_replace(arma::mat& A, int k, double replace_val = -5) {
// Determine whether to go over upper or lower diagonal
unsigned int row_offset = (k < 0) ? -k : 0;
unsigned int col_offset = (k > 0) ? k : 0;
// Compute total number of elements
unsigned int N = std::min(A.n_rows - row_offset, A.n_cols - col_offset);
// Loop over diagonal
for(unsigned int i = 0; i < N; ++i) {
unsigned int row = i + row_offset;
unsigned int col = i + col_offset;
// Disregard bounds checks with .at()
A.at(row,col) = replace_val;
}
return A;
}
Test:
offdiag_replace(A, 2, 4)
# [,1] [,2] [,3] [,4] [,5]
# [1,] 1 6 4 16 21
# [2,] 2 7 12 4 22
# [3,] 3 8 13 18 4
# [4,] 4 9 14 19 24
# [5,] 5 10 15 20 25

RcppArmadillo LogicalMatrix operations

I am trying to do some logical matrix multiplication in RcppArmadillo, but I got some problems. In R, for example, one may do so in the following code:
times = c(1,2,3)
ti = c(times,4)
lst = c(4,5,6)
st = matrix(lst,nrow=1) %*% outer(times,ti,"<")
Result:
> st
[,1] [,2] [,3] [,4]
[1,] 0 4 9 15
Here matrix(lst,nrow=1) is a 1 x 3 matrix, and outer(times,ti,"<") is a 3 x 4 Logical Matrix:
> matrix(lst,nrow=1)
[,1] [,2] [,3]
[1,] 4 5 6
> outer(times,ti,"<")
[,1] [,2] [,3] [,4]
[1,] FALSE TRUE TRUE TRUE
[2,] FALSE FALSE TRUE TRUE
[3,] FALSE FALSE FALSE TRUE
The RcppArmadillo version is following:
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp;
// [[Rcpp::export(".vm")]]
arma::mat vm_mult(const arma::vec lhs,
const arma::umat rhs)
{
return lhs.t() * rhs;
}
// [[Rcpp::export]]
NumericMatrix ty(NumericVector times, NumericVector ti,NumericVector lst){
LogicalMatrix m = outer(times,ti,std::less<double>());
NumericMatrix st = vm_mult(lst,m);
return st;
}
vm_mult is the vector matrix multiplication, and I define the matrix as type umat, which is Mat<unsigned int>. I got the following error when try to run via sourceCpp:
error: conversion from 'LogicalMatrix' (aka 'Matrix<10>') to 'arma::umat' (aka 'Mat<unsigned int>') is ambiguous
NumericMatrix st = vm_mult(mag,m);
^
I also change the type to const arma::Mat<unsigned char> rhs, and similar error appears:
error: conversion from 'LogicalMatrix' (aka 'Matrix<10>') to 'arma::Mat<unsigned char>' is ambiguous
NumericMatrix st = vm_mult(mag,m);
^
I check the documentation of Armadillo library, it seems there is no Logical Matrix specifically defined.
So what should I do except convert the Logical Matrix to 1,0 Integer Matrix.
OK, I figured it out ! It turns that one needs to pass LogicalMatrix from Rcpp to arma::umat using as<arma::umat>.
The following code should work fine.
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp;
// [[Rcpp::export]]
arma::mat ty(NumericVector times, NumericVector ti,NumericVector mag){
LogicalMatrix m = outer(times,ti,std::less<double>());
arma::umat rhs = as<arma::umat>(m);
arma::vec lhs = as<arma::vec>(mag);
arma::mat st = lhs.t() * rhs;
return st;
}
Result:
> sourceCpp('vm.cpp')
> ty(times,ti,lst)
[,1] [,2] [,3] [,4]
[1,] 0 4 9 15

R: Summing up neighboring matrix elements. How to speed up?

I'm working with large matrices of about 2500x2500x50 (lonxlatxtime). The matrix contains only 1 and 0. I need to know for each timestep the sum of the 24 surrounding elements. So far I did it about this way:
xdim <- 2500
ydim <- 2500
tdim <- 50
a <- array(0:1,dim=c(xdim,ydim,tdim))
res <- array(0:1,dim=c(xdim,ydim,tdim))
for (t in 1:tdim){
for (x in 3:(xdim-2)){
for (y in 3:(ydim-2)){
res[x,y,t] <- sum(a[(x-2):(x+2),(y-2):(y+2),t])
}
}
}
This works, but it is much too slow for my needs. Has anybody please an advice how to speed up?
Intro
I have to say, there are so many hidden things behind just the setup of the arrays. The remainder of the problem is trivial though. As a result, there are two ways to go about it really:
Bruteforce given by #Alex (written in C++)
Observing replication patterns
Bruteforce with OpenMP
If we want to 'brute force' it, then we can use the suggestion given by #Alex to employ OpenMP with Armadillo
#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
// Add a flag to enable OpenMP at compile time
// [[Rcpp::plugins(openmp)]]
// Protect against compilers without OpenMP
#ifdef _OPENMP
#include <omp.h>
#endif
// [[Rcpp::export]]
arma::cube cube_parallel(arma::cube a, arma::cube res, int cores = 1) {
// Extract the different dimensions
unsigned int tdim = res.n_slices;
unsigned int xdim = res.n_rows;
unsigned int ydim = res.n_cols;
// Same calculation loop
#pragma omp parallel for num_threads(cores)
for (unsigned int t = 0; t < tdim; t++){
// pop the T
arma::mat temp_mat = a.slice(t);
// Subset the rows
for (unsigned int x = 2; x < xdim-2; x++){
arma::mat temp_row_sub = temp_mat.rows(x-2, x+2);
// Iterate over the columns with unit accumulative sum
for (unsigned int y = 2; y < ydim-2; y++){
res(x,y,t) = accu(temp_row_sub.cols(y-2,y+2));
}
}
}
return res;
}
Replication Patterns
However, the smarter approach is understanding how the array(0:1, dims) is being constructed.
Most notably:
Case 1: If xdim is even, then only the rows of a matrix alternate.
Case 2: If xdim is odd and ydim is odd, then rows alternate as well as the matrices alternate.
Case 3: If xdim is odd and ydim is even, then only the rows alternate
Examples
Let's see the cases in action to observe the patterns.
Case 1:
xdim <- 2
ydim <- 3
tdim <- 2
a <- array(0:1,dim=c(xdim,ydim,tdim))
Output:
, , 1
[,1] [,2] [,3]
[1,] 0 0 0
[2,] 1 1 1
, , 2
[,1] [,2] [,3]
[1,] 0 0 0
[2,] 1 1 1
Case 2:
xdim <- 3
ydim <- 3
tdim <- 3
a <- array(0:1,dim=c(xdim,ydim,tdim))
Output:
, , 1
[,1] [,2] [,3]
[1,] 0 1 0
[2,] 1 0 1
[3,] 0 1 0
, , 2
[,1] [,2] [,3]
[1,] 1 0 1
[2,] 0 1 0
[3,] 1 0 1
, , 3
[,1] [,2] [,3]
[1,] 0 1 0
[2,] 1 0 1
[3,] 0 1 0
Case 3:
xdim <- 3
ydim <- 4
tdim <- 2
a <- array(0:1,dim=c(xdim,ydim,tdim))
Output:
, , 1
[,1] [,2] [,3] [,4]
[1,] 0 1 0 1
[2,] 1 0 1 0
[3,] 0 1 0 1
, , 2
[,1] [,2] [,3] [,4]
[1,] 0 1 0 1
[2,] 1 0 1 0
[3,] 0 1 0 1
Pattern Hacking
Alrighty, based on the above discussion, we opt to make a bit of code the exploits this unique pattern.
Creating Alternating Vectors
An alternating vector in this case switches between two different values.
#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
// ------- Make Alternating Vectors
arma::vec odd_vec(unsigned int xdim){
// make a temporary vector to create alternating 0-1 effect by row.
arma::vec temp_vec(xdim);
// Alternating vector (anyone have a better solution? )
for (unsigned int i = 0; i < xdim; i++) {
temp_vec(i) = (i % 2 ? 0 : 1);
}
return temp_vec;
}
arma::vec even_vec(unsigned int xdim){
// make a temporary vector to create alternating 0-1 effect by row.
arma::vec temp_vec(xdim);
// Alternating vector (anyone have a better solution? )
for (unsigned int i = 0; i < xdim; i++) {
temp_vec(i) = (i % 2 ? 1 : 0); // changed
}
return temp_vec;
}
Creating the three cases of matrix
As mentioned above, there are three cases of matrix. The even, first odd, and second odd cases.
// --- Handle the different cases
// [[Rcpp::export]]
arma::mat make_even_matrix(unsigned int xdim, unsigned int ydim){
arma::mat temp_mat(xdim,ydim);
temp_mat.each_col() = even_vec(xdim);
return temp_mat;
}
// xdim is odd and ydim is even
// [[Rcpp::export]]
arma::mat make_odd_matrix_case1(unsigned int xdim, unsigned int ydim){
arma::mat temp_mat(xdim,ydim);
arma::vec e_vec = even_vec(xdim);
arma::vec o_vec = odd_vec(xdim);
// Alternating column
for (unsigned int i = 0; i < ydim; i++) {
temp_mat.col(i) = (i % 2 ? o_vec : e_vec);
}
return temp_mat;
}
// xdim is odd and ydim is odd
// [[Rcpp::export]]
arma::mat make_odd_matrix_case2(unsigned int xdim, unsigned int ydim){
arma::mat temp_mat(xdim,ydim);
arma::vec e_vec = even_vec(xdim);
arma::vec o_vec = odd_vec(xdim);
// Alternating column
for (unsigned int i = 0; i < ydim; i++) {
temp_mat.col(i) = (i % 2 ? e_vec : o_vec); // slight change
}
return temp_mat;
}
Calculation Engine
Same as the previous solution, just without the t as we no longer need to repeat calculations.
// --- Calculation engine
// [[Rcpp::export]]
arma::mat calc_matrix(arma::mat temp_mat){
unsigned int xdim = temp_mat.n_rows;
unsigned int ydim = temp_mat.n_cols;
arma::mat res = temp_mat;
// Subset the rows
for (unsigned int x = 2; x < xdim-2; x++){
arma::mat temp_row_sub = temp_mat.rows(x-2, x+2);
// Iterate over the columns with unit accumulative sum
for (unsigned int y = 2; y < ydim-2; y++){
res(x,y) = accu(temp_row_sub.cols(y-2,y+2));
}
}
return res;
}
Call Main Function
Here is the core function that pieces everything together. This gives us the desired distance arrays.
// --- Main Engine
// Create the desired cube information
// [[Rcpp::export]]
arma::cube dim_to_cube(unsigned int xdim = 4, unsigned int ydim = 4, unsigned int tdim = 3) {
// Initialize values in A
arma::cube res(xdim,ydim,tdim);
if(xdim % 2 == 0){
res.each_slice() = calc_matrix(make_even_matrix(xdim, ydim));
}else{
if(ydim % 2 == 0){
res.each_slice() = calc_matrix(make_odd_matrix_case1(xdim, ydim));
}else{
arma::mat first_odd_mat = calc_matrix(make_odd_matrix_case1(xdim, ydim));
arma::mat sec_odd_mat = calc_matrix(make_odd_matrix_case2(xdim, ydim));
for(unsigned int t = 0; t < tdim; t++){
res.slice(t) = (t % 2 ? sec_odd_mat : first_odd_mat);
}
}
}
return res;
}
Timing
Now, the real truth is how well does this perform:
Unit: microseconds
expr min lq mean median uq max neval
r_1core 3538.022 3825.8105 4301.84107 3957.3765 4043.0085 16856.865 100
alex_1core 2790.515 2984.7180 3461.11021 3076.9265 3189.7890 15371.406 100
cpp_1core 174.508 180.7190 197.29728 194.1480 204.8875 338.510 100
cpp_2core 111.960 116.0040 126.34508 122.7375 136.2285 162.279 100
cpp_3core 81.619 88.4485 104.54602 94.8735 108.5515 204.979 100
cpp_cache 40.637 44.3440 55.08915 52.1030 60.2290 302.306 100
Script used for timing:
cpp_parallel = cube_parallel(a,res, 1)
alex_1core = alex(a,res,xdim,ydim,tdim)
cpp_cache = dim_to_cube(xdim,ydim,tdim)
op_answer = cube_r(a,res,xdim,ydim,tdim)
all.equal(cpp_parallel, op_answer)
all.equal(cpp_cache, op_answer)
all.equal(alex_1core, op_answer)
xdim <- 20
ydim <- 20
tdim <- 5
a <- array(0:1,dim=c(xdim,ydim,tdim))
res <- array(0:1,dim=c(xdim,ydim,tdim))
ga = microbenchmark::microbenchmark(r_1core = cube_r(a,res,xdim,ydim,tdim),
alex_1core = alex(a,res,xdim,ydim,tdim),
cpp_1core = cube_parallel(a,res, 1),
cpp_2core = cube_parallel(a,res, 2),
cpp_3core = cube_parallel(a,res, 3),
cpp_cache = dim_to_cube(xdim,ydim,tdim))
Here's one solution that's fast for a large array:
res <- apply(a, 3, function(a) t(filter(t(filter(a, rep(1, 5), circular=TRUE)), rep(1, 5), circular=TRUE)))
dim(res) <- c(xdim, ydim, tdim)
I filtered the array using rep(1,5) as the weights (i.e. sum values within a neighborhood of 2) along each dimension. I then modified the dim attribute since it initially comes out as a matrix.
Note that this wraps the sum around at the edges of the array (which might make sense since you're looking at latitude and longitude; if not, I can modify my answer).
For a concrete example:
xdim <- 500
ydim <- 500
tdim <- 15
a <- array(0:1,dim=c(xdim,ydim,tdim))
and here's what you're currently using (with NAs at the edges) and how long this example takes on my laptop:
f1 <- function(a, xdim, ydim, tdim){
res <- array(NA_integer_,dim=c(xdim,ydim,tdim))
for (t in 1:tdim){
for (x in 3:(xdim-2)){
for (y in 3:(ydim-2)){
res[x,y,t] <- sum(a[(x-2):(x+2),(y-2):(y+2),t])
}
}
}
return(res)
}
system.time(res1 <- f1(a, xdim, ydim, tdim))
# user system elapsed
# 14.813 0.005 14.819
And here's a comparison with the version I described:
f2 <- function(a, xdim, ydim, tdim){
res <- apply(a, 3, function(a) t(filter(t(filter(a, rep(1, 5), circular=TRUE)), rep(1, 5), circular=TRUE)))
dim(res) <- c(xdim, ydim, tdim)
return(res)
}
system.time(res2 <- f2(a, xdim, ydim, tdim))
# user system elapsed
# 1.188 0.047 1.236
You can see there's a significant speed boost (for large arrays). And to check that it's giving the correct solution (note that I'm adding NAs so both results match, since the one I gave filters in a circular manner):
## Match NAs
res2NA <- ifelse(is.na(res1), NA, res2)
all.equal(res2NA, res1)
# [1] TRUE
I'll add that your full array (2500x2500x50) took just under a minute (about 55 seconds), although it did use a lot of memory in the process, FYI.
Your current code has a lot of overhead from redundant subsetting and calculation. Clean this up if you want better speed.
At xdim <- ydim <- 20; tdim <- 5, I see a 23% speedup on my machine.
At xdim <- ydim <- 200; tdim <- 10, I see a 25% speedup.
This comes at small cost of additional memory, which is obvious by examining the code below.
xdim <- ydim <- 20; tdim <- 5
a <- array(0:1,dim=c(xdim,ydim,tdim))
res <- array(0:1,dim=c(xdim,ydim,tdim))
microbenchmark(op= {
for (t in 1:tdim){
for (x in 3:(xdim-2)){
for (y in 3:(ydim-2)){
res[x,y,t] <- sum(a[(x-2):(x+2),(y-2):(y+2),t])
}
}
}
},
alex= {
for (t in 1:tdim){
temp <- a[,,t]
for (x in 3:(xdim-2)){
temp2 <- temp[(x-2):(x+2),]
for (y in 3:(ydim-2)){
res[x,y,t] <- sum(temp2[,(y-2):(y+2)])
}
}
}
}, times = 50)
Unit: milliseconds
expr min lq mean median uq max neval cld
op 4.855827 5.134845 5.474327 5.321681 5.626738 7.463923 50 b
alex 3.720368 3.915756 4.213355 4.012120 4.348729 6.320481 50 a
Further improvements:
If you write this in C++, my guess is that recognizing res[x,y,t] = res[x,y-1,t] - sum(a[...,y-2,...]) + sum(a[...,y+2,...]) will save you additional time. In R, it did not in my timing tests.
This problem is also embarrassingly parallel. There's no reason you couldn't split the t dimension to make more use of a multi-core architecture.
Both of these are left to the reader / OP.

List of matrices multiplied by a scalar, dimension attributes are not preserved in Rcpp

I am using Rcpp to speed up some R codes (and actually this is one of the items of my 'to do' List for 2014), part of the code consists of multiplying a list of matrices by a scalar, I am able to get the results, nontheless the matrices are not longer matrices, they are vectors instead and I want a list of matrices as the final output.
Here's the code I have so far:
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp;
using namespace arma;
// I got this template from here: http://stackoverflow.com/a/18014655/1315767
template <typename WHAT>
class ListOf : public List {
public:
template <typename T>
ListOf( const T& x) : List(x){}
WHAT operator[](int i){ return as<WHAT>( ( (List*)this)->operator[]( i) ) ; }
} ;
// [[Rcpp::export]]
List FooList(NumericVector fi1, ListOf<NumericMatrix> Ct){
List TempList(Ct.size());
NumericMatrix ct(2,2);
for(int i=0; i<Ct.size(); i++){
ct = Ct[i] ;
TempList[i] = ct * fi1[i] ; // multiply each matrix by each scalar in fi1
}
return TempList;
}
When running this code, I get the following:
> sourceCpp("FooList.cpp")
> A <- replicate(3,matrix(1:4, 2), simplify=FALSE) # a list of matrices
> vec <- 0.5 * c(1:3) # a vector
> FooList(vec, A) # dim are not preserved
[[1]]
[1] 0.5 1.0 1.5 2.0
[[2]]
[1] 1 2 3 4
[[3]]
[1] 1.5 3.0 4.5 6.0
The output given by FooList is ok, but the format is not, I expected to get something like this:
[[1]]
[,1] [,2]
[1,] 0.5 1.5
[2,] 1.0 2.0
[[2]]
[,1] [,2]
[1,] 1 3
[2,] 2 4
[[3]]
[,1] [,2]
[1,] 1.5 4.5
[2,] 3.0 6.0
I don't understand why I'm getting this output, because ct is a matrix, if I get rid of fi1[i] the output is indeed a list of matrices, I even tried using as_scalar(fi) and I get the same as before. I also tried using ct.attr("dim") = Dimension(2, 2); with no sucess.
The key problem is that when you are multiplying the matrix by a scalar in C++, you're using Rcpp's syntactic sugar for *, which is vectorized. For whatever reason, it doesn't understand how to return a matrix (I haven't looked at the documentation extensively).
If we instead multiply each element of each matrix by the scalar, you get the expected results:
FooList.R
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp;
using namespace arma;
// I got this template from here: http://stackoverflow.com/a/18014655/1315767
template <typename WHAT>
class ListOf : public List {
public:
template <typename T>
ListOf( const T& x) : List(x){}
WHAT operator[](int i){ return as<WHAT>( ( (List*)this)->operator[]( i) ) ; }
} ;
// [[Rcpp::export]]
List FooList(NumericVector fi1, ListOf<NumericMatrix> Ct){
List TempList(Ct.size());
NumericMatrix ct(2,2);
for(int i=0; i<Ct.size(); i++){
ct = Ct[i] ;
for (int j=0; j < ct.nrow(); j++) {
for (int k=0; k < ct.ncol(); k++) {
ct(j, k) *= fi1[i]; // Multiply each element of the matrix by the scalar in fi1
}
}
TempList[i] = ct;
}
return TempList;
}
Interactive Session:
> sourceCpp("FooList.cpp")
> A <- replicate(3,matrix(1:4, 2), simplify=FALSE) # a list of matrices
> vec <- 0.5 * c(1:3) # a vector
> FooList(vec, A)
[[1]]
[,1] [,2]
[1,] 0.5 1.5
[2,] 1.0 2.0
[[2]]
[,1] [,2]
[1,] 1 3
[2,] 2 4
[[3]]
[,1] [,2]
[1,] 1.5 4.5
[2,] 3.0 6.0

Multiplying a column vector by a numeric scalar in RcppArmadillo

I am having some trouble compiling this simple c++ code using Rcpp and the RcppArmadillo package. Take the following simple example to multiply each column of a matrix by a numeric scalar:
code <- 'arma::mat out = Rcpp::as<arma::mat>(m);
for(int i = 0; i < out.n_cols; ++i){
out.col(i) *= v;
}
return Rcpp::wrap( out );'
Trying to compile this using...
require( RcppArmadillo )
armMult <- cxxfunction( signature( m = "numeric" , v = "numeric" ),
code , plugin = "RcppArmadillo" )
Results in the compile error....
#error: no match for 'operator*=' in 'arma::Mat<eT>::col(arma::uword) [with eT = double, arma::uword = unsigned int](((unsigned int)i)) *= v'
However, if we swap the numeric variable v for 2.0 as below....
code <- 'arma::mat out = Rcpp::as<arma::mat>(m);
for(int i = 0; i < out.n_cols; ++i){
out.col(i) *= 2.0; //Notice we use 2.0 instead of a variable
}
return Rcpp::wrap( out );'
It compiles just fine....
armMult <- cxxfunction( signature(m="numeric"),
code,plugin="RcppArmadillo")
And we can then do...
m <- matrix( 1:4 , 2 , 2 )
armMult( m )
[,1] [,2]
[1,] 2 6
[2,] 4 8
What am I missing here? How can I make this work with a simple numeric scalar. I would like to be able to pass a scalar like...
armMult( m , 2.0 )
And return the same result as above.
If you want to multiply each column of a matrix A by the corresponding element of a vector x then try this:
Rcpp:::cppFunction(
"arma::mat fun(arma::mat A, arma::rowvec x)
{
A.each_row() %= x;
return A;
}", depends = "RcppArmadillo"
)
fun(matrix(rep(1, 6), 3, 2), c(5, 1))
[,1] [,2]
[1,] 5 1
[2,] 5 1
[3,] 5 1
Whenever I scratch my head over issues like this, I start by reducing the problem. Try a C++ three-liner just using Armadillo headers. Make it work, then move it over to RcppArmadillo.
Edit: One can do better than your answer as you don't need to multiply each column individually (though one can). Anyway, this just shows off Rcpp Attributes:
> cppFunction("arma::mat simon(arma::mat m, double v) { return m * v;}",
+ depends="RcppArmadillo")
> simon(matrix(1:4,2,2), 3)
[,1] [,2]
[1,] 3 9
[2,] 6 12
>
Thanks to a comment by #DirkEddelbuettel it was simply because I had not defined v...
code <- '
arma::mat out = Rcpp::as<arma::mat>(m);
double scl = Rcpp::as<double>(v);
for(int i = 0; i < out.n_cols; ++i){
out.col(i) *= scl;
}
return Rcpp::wrap( out );
'
armMult <- cxxfunction( signature( m = "numeric" , v = "numeric" ),
code , plugin = "RcppArmadillo" )
armMult( m , 2.0 )
[,1] [,2]
[1,] 2 6
[2,] 4 8

Resources