Inside a function of type SEXP myfun(SEXP n, SEXP d) I allocate an (n, d)-matrix which contains the result of a function computed in C:
SEXP res = PROTECT(allocMatrix(REALSXP, n, d));
I would like to 'fill' this matrix (it can then be returned by myfun) and thus would like to convert it to an (n, d)-matrix in C (or pointer or so). How can this be done?
If res was a vector, I could do:
double *res_ = REAL(res);
and then walk through res_ with a for loop. However, when I use that for the above matrix, it loses its dimension, i.e., indexing via res_[i][j] for computing the result fails. Of course one could work with a vector and keep track of the row/col indices oneself, but ideally I would like to simply write res_[i][j]. Is this doable without significant amount of extra code?
The matrix is going to be stored as a vector internally, which should imply that [i][j] is meaningless in C. Here is an example from Writing R Extensions on how you would do this:
#include <R.h>
#include <Rinternals.h>
SEXP out(SEXP x, SEXP y)
{
R_len_t i, j, nx = length(x), ny = length(y);
double tmp, *rx = REAL(x), *ry = REAL(y), *rans;
SEXP ans;
PROTECT(ans = allocMatrix(REALSXP, nx, ny));
rans = REAL(ans);
for(i = 0; i < nx; i++) {
tmp = rx[i];
for(j = 0; j < ny; j++)
rans[i + nx*j] = tmp * ry[j];
}
UNPROTECT(1);
return(ans);
}
Speed if course very important, but I also like code clarity. The solution by BrodieG could be written as a much shorter RcppArmadillo function -- it really is just a single outer product:
#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
// [[Rcpp::export]]
arma::mat outCpp(arma::colvec x, arma::rowvec y) {
return x * y;
}
If we test this against Brodie's (renamed to outC()) we get his:
R> sourceCpp("/tmp/marius.cpp")
R> library(rbenchmark)
R> a <- as.numeric(1:3)
R> b <- as.numeric(1:4)
R> outC(a, b)
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 4 6 8
[3,] 3 6 9 12
R> outCpp(a, b)
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 4 6 8
[3,] 3 6 9 12
R> benchmark(outC(a,b), outCpp(a,b), replications=1e5)[,1:4]
test replications elapsed relative
1 outC(a, b) 100000 0.382 1.000
2 outCpp(a, b) 100000 0.484 1.267
R>
So running 100,000 replications takes 380 vs 480 msec.
That means for each call, the difference is one millionth of a second. I think I take for having a single line of code that is easier to read and maintain.
Related
I was struggling with subsetting columns of a matrix of class arma::mat.
Let's say arma::mat X is given, and I tried to create a vector of indices IDX, in order to do X.cols(IDX). Especially, the index vector has every k-th integer from 1 to p (dimension of X). For example, one may be interested in every even columns IDX=[2,4,6,8, ...].
Based on this documentation, contiguous indices such as [0, 1, 2, ..., m-1] can be extracted easily using X.cols(0, m - 1) if m <= p. However, I couldn't find a good way to subset a matrix with the index vector IDX described above.
I wonder how I complete this code to give a desired output.
My "subset_armamat.cpp" file looks like
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp;
using namespace arma;
// [[Rcpp::export]]
mat subset_armamat(mat X, int k){
uvec IDX = "every k-th integer from 0 to X.ncols";
return X.cols(IDX);
}
and R code to execute the defined function is
library("Rcpp")
sourceCpp("subset_armamat.cpp")
subset_armamat(matrix(1:10, 2, 5, byrow = T), 2)
This is expected to produce a 2-by-3 matrix as the following R code would give
> matrix(1:10, 2, 5, byrow = T)[,seq(1, 5, by = 2)]
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 6 8 10
It would be very appreciated if you give any input.
p.s. I've tried to
generate a sequence vector seq(1,m) * 2 manually, but this does not work with X.cols().
or find an index using find(seq(1,p) % 2 == 0), but % operator does not work well between seq(1,p) and 2.
F. Privé's answer showed that you can in fact use a uvec to subset a matrix using .cols() even if its not a contiguous range, using the base R seq() function to generate the sequence. I will further demonstrate that you can generate the sequence using an Armadillo function; you can use arma::regspace() -- it "generate[s] a vector with regularly spaced elements" (Armadillo documentation source):
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp;
using namespace arma;
// [[Rcpp::export]]
mat subset_armamat(mat X, int k) {
uvec IDX = regspace<uvec>(0, k, X.n_cols-1);
return X.cols(IDX);
}
As a comparison to calling R's seq() (where subset_armamatR() is the function from F. Privé's answer):
library("Rcpp")
sourceCpp("subset_armamat.cpp")
mat <- matrix(1:10, 2, 5, byrow = TRUE)
subset_armamat(mat, 2)
#> [,1] [,2] [,3]
#> [1,] 1 3 5
#> [2,] 6 8 10
subset_armamatR(mat, 2)
#> [,1] [,2] [,3]
#> [1,] 1 3 5
#> [2,] 6 8 10
library(microbenchmark)
microbenchmark(Rseq = subset_armamatR(mat, 2),
regspace = subset_armamat(mat, 2))
#> Unit: microseconds
#> expr min lq mean median uq max neval cld
#> Rseq 235.535 239.1615 291.1954 241.9850 248.6005 4704.467 100 a
#> regspace 14.221 15.0225 520.9235 15.8165 16.6740 50408.375 100 a
Update: Passing by reference
A comment from hbrerkere warrants some brief additional discussion. If you are calling this function from C++, you'll gain speed by changing mat subset_armamat(mat X, int k) to mat subset_armamat(const mat& X, int k). Passing by reference like this avoids an unnecessary copy, and when you do not intend to change an object passed by reference, you should use const. However, if you are calling this function from R, you cannot avoid a copy as arma::mat is not a native R type (see, for example, this answer by Dirk Eddelbuettel (the maintainer of both Rcpp and RcppArmadillo). Consider the following example:
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
// [[Rcpp::export]]
void reference_example(arma::mat& X) {
X(0, 0) = 42;
}
// [[Rcpp::export]]
void print_reference_example(arma::mat X) {
reference_example(X);
Rcpp::Rcout << X << "\n";
}
Then calling from R:
library("Rcpp")
sourceCpp("reference_example.cpp")
mat <- matrix(1:4, 2, 2)
mat
#> [,1] [,2]
#> [1,] 1 3
#> [2,] 2 4
reference_example(mat)
mat
#> [,1] [,2]
#> [1,] 1 3
#> [2,] 2 4
print_reference_example(mat)
#> 42.0000 3.0000
#> 2.0000 4.0000
mat
#> [,1] [,2]
#> [1,] 1 3
#> [2,] 2 4
This works:
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp;
using namespace arma;
// [[Rcpp::export]]
mat subset_armamat(mat X, int k) {
// Obtain environment containing function
Rcpp::Environment base("package:base");
// Make function callable from C++
Rcpp::Function seq = base["seq"];
uvec IDX = as<uvec>(seq(0, X.n_cols, k));
return X.cols(IDX);
}
I just call R function base::seq() from Rcpp.
what's a fast way to match two matrices (one and two) together and to extract the index of matrix two for the matches. Matrix two is large (hundreds to thousands of rows).
one
[,1] [,2]
9 11
13 2
head(two)
[,1][,2]
[1,] 9 11
[2,] 11 9
[3,] 2 3
[4,] 13 2
[5,] 2 4
[6,] 3 3
The output should be (notice how index 2 is not an output value)
1 4
One way of doing this :
a = apply(one, 1, paste0, collapse = "-")
b = apply(two, 1, paste0, collapse = "-")
match(a, b)
#[1] 1 4
We paste all the columns together row-wise for both the matrices and then match them to get the rows which are same.
Just for reference,
a
#[1] "9-11" "13-2"
b
#[1] "9-11" "11-9" "2-3" "13-2" "2-4" "3-3"
You could write a C++ loop to do it fairly quick
library(Rcpp)
cppFunction('NumericVector matrixIndex(NumericMatrix m1, NumericMatrix m2){
int m1Rows = m1.nrow();
int m2Rows = m2.nrow();
NumericVector out;
for (int i = 0; i < m1Rows; i++){
for (int j = 0; j < m2Rows; j++){
if(m1(i, 0) == m2(j, 0) && m1(i, 1) == m2(j, 1)){
//out[j] = (j+1);
out.push_back(j + 1);
}
}
}
return out;
}')
matrixIndex(m1, m2)
[1] 1 4
Although I suspect it would be faster to pre-allocate the result vector first, something like
cppFunction('NumericVector matrixIndex(NumericMatrix m1, NumericMatrix m2){
int m1Rows = m1.nrow();
int m2Rows = m2.nrow();
NumericVector out(m2Rows);
for (int i = 0; i < m1Rows; i++){
for (int j = 0; j < m2Rows; j++){
if(m1(i, 0) == m2(j, 0) && m1(i, 1) == m2(j, 1)){
out[j] = (j+1);
//out.push_back(j + 1);
}
}
}
return out;
}')
matrixIndex(m1, m2)
[1] 1 0 0 4 0 0
## 0 == nomatch.
You don't say if by "fast" you mean compute time or person time. If it only needs doing once, the overall time is probably shortest if you optimize person time, and Ronak's answer is going to be hard to beat, it's clear and robust.
If the numbers are all less than a certain number (say, 100, as in your example data), you can do a similar thing but use arithmetic to combine the two columns together and then match. I suspect (but haven't tested) that this would be faster than converting to character vectors. There are of course other arithmetic options too depending on your circumstance.
a <- one[,1]*100 + one[,2]
b <- two[,1]*100 + two[,2]
match(a, b)
We can use %in%
which(do.call(paste, as.data.frame(two)) %in% do.call(paste, as.data.frame(one)))
#[1] 1 4
I would like to take an arma::vec object and reshape it to an arma::cube object.
For example:
vec param(mm*n*g);
param.randn();
cube LL = reshape(param,mm,n,g); // this line doesn't work
The easiest way I can get this to work is:
paramtemp = as<NumericVector>(wrap(param));
cube LL(paramtemp.begin(),mm,n,g);
But surely there is a more elegant way?
Many Armadillo classes provide constructors which take an argument that is a pointer to another memory location; generally this will be a begin iterator of another object. For example,
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
// [[Rcpp::export]]
arma::cube to_cube(int x, int y, int z) {
arma::vec v(x * y * z);
v.randn();
arma::cube res((const double*)v.begin(), x, y, z);
return res;
}
/***R
to_cube(3, 3, 3)
# , , 1
#
# [,1] [,2] [,3]
# [1,] -0.8052190 0.5206867 0.4562287
# [2,] 0.6407149 0.8247035 -0.2375103
# [3,] -0.2766542 0.0527188 -1.2807390
#
# , , 2
#
# [,1] [,2] [,3]
# [1,] -0.49995982 0.7240956 0.66634699
# [2,] 0.06367092 -0.7991327 -0.36003560
# [3,] -0.90958952 -0.4431064 0.05952237
#
# , , 3
#
# [,1] [,2] [,3]
# [1,] 0.457159 1.6725911 -0.9299367
# [2,] 1.205733 0.6185083 0.3805266
# [3,] 0.545668 -0.4356577 -0.9111175
*/
I'm not sure if the cast to const double* is strictly necessary, but it is there to distinguish between the following two constructors,
cube(const ptr_aux_mem, n_rows, n_cols, n_slices)
cube(ptr_aux_mem, n_rows, n_cols, n_slices, copy_aux_mem = true, strict = false)
where the first (which is the intention above) is a read-only copy.
I have a nonzero symmetric matrix 'matr' that is 12000X12000. I need to find the indices of the top 10000 elements in 'matr' in R. The code I have written takes a long time - I was wondering if there was any pointers to make it faster.
listk <- numeric(0)
for( i in 1:10000) {
idx <- which(matr == max(matr), arr.ind=T)
if( length(idx) != 0) {
listk <- rbind( listk, idx[1,])
matr[idx[1,1], idx[1,2]] <- 0
matr[idx[2,1], idx[2,2]] <- 0
}
}
Here's how you might find the indices (ij) of the 4 largest elements in a 10-by-10 matrix m.
## Sample data
m <- matrix(runif(100), ncol=10)
## Extract the indices of the 4 largest elements
(ij <- which(m >= sort(m, decreasing=T)[4], arr.ind=TRUE))
# row col
# [1,] 2 1
# [2,] 5 1
# [3,] 6 2
# [4,] 3 10
## Use the indices to extract the values
m[ij]
# [1] 0.9985190 0.9703268 0.9836373 0.9914510
Edit:
For large matrices, performing a partial sort will be a faster way to find the 10,000th largest element:
v <- runif(1e7)
system.time(a <- sort(v, decreasing=TRUE)[10000])
# user system elapsed
# 4.35 0.03 4.38
system.time(b <- -sort(-v, partial=10000)[10000])
# user system elapsed
# 0.60 0.09 0.69
a==b
# [1] TRUE
I like #JoshO'Brien 's answer; the use of partial sorting is great! Here's an Rcpp solution (I'm not a strong C++ programmer so probably bone-headed errors; corrections welcome... how would I template this in Rcpp, to handle different types of input vector?)
I start by including the appropriate headers and using namespaces for convenience
#include <Rcpp.h>
#include <queue>
using namespace Rcpp;
using namespace std;
Then arrange to expose my C++ function to R
// [[Rcpp::export]]
IntegerVector top_i_pq(NumericVector v, int n)
and define some variables, most importantly a priority_queue to hold as a pair the numeric value and index. The queue is ordered so the smallest values are at the 'top', with small relying on the standard pair<> comparator.
typedef pair<double, int> Elt;
priority_queue< Elt, vector<Elt>, greater<Elt> > pq;
vector<int> result;
Now I'll walk through the input data, adding it to the queue if either (a) I don't yet have enough values or (b) the current value is larger than the smallest value in the queue. In the latter case, I pop off the smallest value, and insert it's replacement. In this way the priority queue always contains the n_max largest elements.
for (int i = 0; i != v.size(); ++i) {
if (pq.size() < n)
pq.push(Elt(v[i], i));
else {
Elt elt = Elt(v[i], i);
if (pq.top() < elt) {
pq.pop();
pq.push(elt);
}
}
}
And finally I pop the indexes from the priority queue into the return vector, remembering to translate to 1-based R coordinates.
result.reserve(pq.size());
while (!pq.empty()) {
result.push_back(pq.top().second + 1);
pq.pop();
}
and return the result to R
return wrap(result);
This has nice memory use (the priority queue and return vector are both small relative to the original data) and is fast
> library(Rcpp); sourceCpp("top_i_pq.cpp"); z <- runif(12000 * 12000)
> system.time(top_i_pq(z, 10000))
user system elapsed
0.992 0.000 0.998
Problems with this code include:
The default comparator greater<Elt> works so that, in the case of a tie spanning the value of the _n_th element, the last, rather than first, duplicate is retained.
NA values (and non-finite values?) may not be handled correctly; I'm not sure whether this is true or not.
The function only works for NumericVector input, but the logic is appropriate for any R data type for which an appropriate ordering relationship is defined.
Problems 1 and 2 can likely be dealt with by writing an appropriate comparator; maybe for 2 this is already implemented in Rcpp? I don't know how to leverage C++ language features and the Rcpp design to avoid re-implementing the function for each data type I want to support.
Here's the full code:
#include <Rcpp.h>
#include <queue>
using namespace Rcpp;
using namespace std;
// [[Rcpp::export]]
IntegerVector top_i_pq(NumericVector v, int n)
{
typedef pair<double, int> Elt;
priority_queue< Elt, vector<Elt>, greater<Elt> > pq;
vector<int> result;
for (int i = 0; i != v.size(); ++i) {
if (pq.size() < n)
pq.push(Elt(v[i], i));
else {
Elt elt = Elt(v[i], i);
if (pq.top() < elt) {
pq.pop();
pq.push(elt);
}
}
}
result.reserve(pq.size());
while (!pq.empty()) {
result.push_back(pq.top().second + 1);
pq.pop();
}
return wrap(result);
}
A bit late into the party, but I came up with this, which avoids the sort.
Say you want the top 10k elements from you 12k x 12k matrix. The idea is to "clip" the data to the elements corresponding to a quantile of that size.
find_n_top_elements <- function( x, n ){
#set the quantile to correspond to n top elements
quant <- n / (dim(x)[1]*dim(x)[2])
#select the cutpoint to get the quantile above quant
lvl <- quantile(x, probs=1.0-quant)
#select the elements above the cutpoint
res <- x[x>lvl[[1]]]
}
#create a 12k x 12k matrix (1,1Gb!)
n <- 12000
x <- matrix( runif(n*n), ncol=n)
system.time( res <- find_n_top_elements( x, 10e3 ) )
Resulting in
system.time( res <- find_n_top_elements( x, 10e3 ) )
user system elapsed
3.47 0.42 3.89
For comparison, just sorting x on my system takes
system.time(sort(x))
user system elapsed
30.69 0.21 31.33
Matrix in R is like a vector.
mat <- matrix(sample(1:5000, 10000, rep=T), 100, 100)
mat.od <- order(mat, decreasing = T)
mat.od.arr <- cbind(mat.od%%nrow(mat), mat.od%/%nrow(mat)+1)
mat.od.arr[,2][mat.od.arr[,1]==0] <- mat.od.arr[,2][mat.od.arr[,1]==0] - 1
mat.od.arr[,1][mat.od.arr[,1]==0] <- nrow(mat)
head(mat.od.arr)
# [,1] [,2]
# [1,] 58 5
# [2,] 59 72
# [3,] 38 22
# [4,] 23 10
# [5,] 38 14
# [6,] 90 15
mat[58, 5]
# [1] 5000
mat[59, 72]
# [1] 5000
mat[38, 22]
# [1] 4999
mat[23, 10]
# [1] 4998
I have a nonzero symmetric matrix 'matr' that is 12000X12000. I need to find the indices of the top 10000 elements in 'matr' in R. The code I have written takes a long time - I was wondering if there was any pointers to make it faster.
listk <- numeric(0)
for( i in 1:10000) {
idx <- which(matr == max(matr), arr.ind=T)
if( length(idx) != 0) {
listk <- rbind( listk, idx[1,])
matr[idx[1,1], idx[1,2]] <- 0
matr[idx[2,1], idx[2,2]] <- 0
}
}
Here's how you might find the indices (ij) of the 4 largest elements in a 10-by-10 matrix m.
## Sample data
m <- matrix(runif(100), ncol=10)
## Extract the indices of the 4 largest elements
(ij <- which(m >= sort(m, decreasing=T)[4], arr.ind=TRUE))
# row col
# [1,] 2 1
# [2,] 5 1
# [3,] 6 2
# [4,] 3 10
## Use the indices to extract the values
m[ij]
# [1] 0.9985190 0.9703268 0.9836373 0.9914510
Edit:
For large matrices, performing a partial sort will be a faster way to find the 10,000th largest element:
v <- runif(1e7)
system.time(a <- sort(v, decreasing=TRUE)[10000])
# user system elapsed
# 4.35 0.03 4.38
system.time(b <- -sort(-v, partial=10000)[10000])
# user system elapsed
# 0.60 0.09 0.69
a==b
# [1] TRUE
I like #JoshO'Brien 's answer; the use of partial sorting is great! Here's an Rcpp solution (I'm not a strong C++ programmer so probably bone-headed errors; corrections welcome... how would I template this in Rcpp, to handle different types of input vector?)
I start by including the appropriate headers and using namespaces for convenience
#include <Rcpp.h>
#include <queue>
using namespace Rcpp;
using namespace std;
Then arrange to expose my C++ function to R
// [[Rcpp::export]]
IntegerVector top_i_pq(NumericVector v, int n)
and define some variables, most importantly a priority_queue to hold as a pair the numeric value and index. The queue is ordered so the smallest values are at the 'top', with small relying on the standard pair<> comparator.
typedef pair<double, int> Elt;
priority_queue< Elt, vector<Elt>, greater<Elt> > pq;
vector<int> result;
Now I'll walk through the input data, adding it to the queue if either (a) I don't yet have enough values or (b) the current value is larger than the smallest value in the queue. In the latter case, I pop off the smallest value, and insert it's replacement. In this way the priority queue always contains the n_max largest elements.
for (int i = 0; i != v.size(); ++i) {
if (pq.size() < n)
pq.push(Elt(v[i], i));
else {
Elt elt = Elt(v[i], i);
if (pq.top() < elt) {
pq.pop();
pq.push(elt);
}
}
}
And finally I pop the indexes from the priority queue into the return vector, remembering to translate to 1-based R coordinates.
result.reserve(pq.size());
while (!pq.empty()) {
result.push_back(pq.top().second + 1);
pq.pop();
}
and return the result to R
return wrap(result);
This has nice memory use (the priority queue and return vector are both small relative to the original data) and is fast
> library(Rcpp); sourceCpp("top_i_pq.cpp"); z <- runif(12000 * 12000)
> system.time(top_i_pq(z, 10000))
user system elapsed
0.992 0.000 0.998
Problems with this code include:
The default comparator greater<Elt> works so that, in the case of a tie spanning the value of the _n_th element, the last, rather than first, duplicate is retained.
NA values (and non-finite values?) may not be handled correctly; I'm not sure whether this is true or not.
The function only works for NumericVector input, but the logic is appropriate for any R data type for which an appropriate ordering relationship is defined.
Problems 1 and 2 can likely be dealt with by writing an appropriate comparator; maybe for 2 this is already implemented in Rcpp? I don't know how to leverage C++ language features and the Rcpp design to avoid re-implementing the function for each data type I want to support.
Here's the full code:
#include <Rcpp.h>
#include <queue>
using namespace Rcpp;
using namespace std;
// [[Rcpp::export]]
IntegerVector top_i_pq(NumericVector v, int n)
{
typedef pair<double, int> Elt;
priority_queue< Elt, vector<Elt>, greater<Elt> > pq;
vector<int> result;
for (int i = 0; i != v.size(); ++i) {
if (pq.size() < n)
pq.push(Elt(v[i], i));
else {
Elt elt = Elt(v[i], i);
if (pq.top() < elt) {
pq.pop();
pq.push(elt);
}
}
}
result.reserve(pq.size());
while (!pq.empty()) {
result.push_back(pq.top().second + 1);
pq.pop();
}
return wrap(result);
}
A bit late into the party, but I came up with this, which avoids the sort.
Say you want the top 10k elements from you 12k x 12k matrix. The idea is to "clip" the data to the elements corresponding to a quantile of that size.
find_n_top_elements <- function( x, n ){
#set the quantile to correspond to n top elements
quant <- n / (dim(x)[1]*dim(x)[2])
#select the cutpoint to get the quantile above quant
lvl <- quantile(x, probs=1.0-quant)
#select the elements above the cutpoint
res <- x[x>lvl[[1]]]
}
#create a 12k x 12k matrix (1,1Gb!)
n <- 12000
x <- matrix( runif(n*n), ncol=n)
system.time( res <- find_n_top_elements( x, 10e3 ) )
Resulting in
system.time( res <- find_n_top_elements( x, 10e3 ) )
user system elapsed
3.47 0.42 3.89
For comparison, just sorting x on my system takes
system.time(sort(x))
user system elapsed
30.69 0.21 31.33
Matrix in R is like a vector.
mat <- matrix(sample(1:5000, 10000, rep=T), 100, 100)
mat.od <- order(mat, decreasing = T)
mat.od.arr <- cbind(mat.od%%nrow(mat), mat.od%/%nrow(mat)+1)
mat.od.arr[,2][mat.od.arr[,1]==0] <- mat.od.arr[,2][mat.od.arr[,1]==0] - 1
mat.od.arr[,1][mat.od.arr[,1]==0] <- nrow(mat)
head(mat.od.arr)
# [,1] [,2]
# [1,] 58 5
# [2,] 59 72
# [3,] 38 22
# [4,] 23 10
# [5,] 38 14
# [6,] 90 15
mat[58, 5]
# [1] 5000
mat[59, 72]
# [1] 5000
mat[38, 22]
# [1] 4999
mat[23, 10]
# [1] 4998