rowApply

apply-benchmark.cpp

#include <Rcpp.h>
using namespace Rcpp;
 
// [[Rcpp::export]]
NumericVector rowApply0(NumericMatrix& x, const Function& FUN)
{
  int n = x.nrow();
  NumericVector result = no_init(n);
  
  for (int r = 0; r < n; r++) {
    result[r] = as<double>(FUN(x(r, _) ) );
  }
  return result;
}
 
// [[Rcpp::export]]
NumericVector rowApply1(NumericMatrix& x, const Function& FUN)
{
  int n = x.nrow();
  NumericVector result = no_init(n);
  
  for (int r = 0; r < n; r++) {
    Language call(FUN, x(r, _)) ;
    result[r] = as<double>(call.fast_eval() );
  }
  return result;
}
 
// [[Rcpp::export]]
NumericVector rowApply2(NumericMatrix& x, const Function& FUN)
{
  int n = x.nrow();
  NumericVector result = no_init(n);
  
  Language call(FUN, R_NilValue);
  Language::Proxy proxy(call, 1);
  for (int r = 0; r < n; r++) {
    proxy = x(r, _) ;
    result[r] = as<double>(call.fast_eval() );
  }
  return result;
}
 
// [[Rcpp::export]]
NumericVector rowApply3(NumericMatrix& x, const Function& FUN)
{
  int n = x.nrow();
  NumericVector result = no_init(n);
  
  NumericVector row( x.ncol() ) ;
  Language call(FUN, row);
  for (int r = 0; r < n; r++) {
    row = x(r, _) ;
    result[r] = as<double>(call.fast_eval() );
  }
  return result;
}
 

inline void grab_row( const NumericMatrix& x, int row, NumericVector& target, int ncol, int nrow){
    for( int i=0, k = row; i<ncol; i++, k+= nrow)
        target[i] = x[k];
}

// [[Rcpp::export]]
NumericVector rowApply4(NumericMatrix& x, const Function& FUN){
  int n = x.nrow();
  NumericVector result = no_init(n);
  
  int ncol = x.ncol() ;
  NumericVector row( ncol ) ;
  Language call(FUN, row);
  for (int r = 0; r < n; r++) {
    grab_row( x, r, row, ncol, n ) ;
    result[r] = as<double>(call.fast_eval() );
  }
  return result;
}


/*** R
 
library(microbenchmark)
options(digits = 3)

mean_ <- function(.) .Internal(mean(.))

M <- matrix(rnorm(15L), nrow=3L);
identical(rowMeans(M), apply(M, 1L, mean));
identical(rowMeans(M), rowApply0(M, mean));
identical(rowMeans(M), rowApply1(M, mean));
identical(rowMeans(M), rowApply2(M, mean));
identical(rowMeans(M), rowApply3(M, mean));
identical(rowMeans(M), rowApply3(M, mean_));
identical(rowMeans(M), rowApply4(M, mean_));

microbenchmark(rowMeans(M),
  apply(M, 1L, mean),
  rowApply0(M, mean),
  rowApply1(M, mean),
  rowApply2(M, mean), 
  rowApply3(M, mean),
  rowApply3(M, mean_), 
  rowApply4(M, mean_) 
  )
 
M <- matrix(rnorm(1500L), nrow=30L);
microbenchmark(rowMeans(M),
  apply(M, 1L, mean),
  rowApply0(M, mean),
  rowApply1(M, mean),
  rowApply2(M, mean),
  rowApply3(M, mean),
  rowApply3(M, mean_),
  rowApply4(M, mean_)
  )
 
*/

output.txt

$ RcppScript rowApply.cpp

> library(microbenchmark)

> options(digits = 3)

> mean_ <- function(.) .Internal(mean(.))

> M <- matrix(rnorm(15), nrow = 3)

> identical(rowMeans(M), apply(M, 1, mean))
[1] TRUE

> identical(rowMeans(M), rowApply0(M, mean))
[1] TRUE

> identical(rowMeans(M), rowApply1(M, mean))
[1] TRUE

> identical(rowMeans(M), rowApply2(M, mean))
[1] TRUE

> identical(rowMeans(M), rowApply3(M, mean))
[1] TRUE

> identical(rowMeans(M), rowApply3(M, mean_))
[1] TRUE

> identical(rowMeans(M), rowApply4(M, mean_))
[1] TRUE

> microbenchmark(rowMeans(M), apply(M, 1, mean), rowApply0(M,
+     mean), rowApply1(M, mean), rowApply2(M, mean), rowApply3(M,
+     mean), rowAppl .... [TRUNCATED]
Unit: microseconds
                expr   min    lq median   uq   max neval
         rowMeans(M)  6.89  9.28  10.30 11.5  22.2   100
  apply(M, 1L, mean) 64.11 68.62  71.26 87.7 133.5   100
  rowApply0(M, mean) 66.97 71.78  74.74 90.3 831.4   100
  rowApply1(M, mean) 25.88 27.77  30.01 36.9  55.7   100
  rowApply2(M, mean) 25.37 27.83  30.94 36.5  43.5   100
  rowApply3(M, mean) 25.36 27.06  29.23 34.3  41.9   100
 rowApply3(M, mean_)  6.37  7.75   8.78 10.6  25.4   100
 rowApply4(M, mean_)  6.45  7.82   8.41 10.2  14.8   100

> M <- matrix(rnorm(1500), nrow = 30)

> microbenchmark(rowMeans(M), apply(M, 1, mean), rowApply0(M,
+     mean), rowApply1(M, mean), rowApply2(M, mean), rowApply3(M,
+     mean), rowAppl .... [TRUNCATED]
Unit: microseconds
                expr   min    lq median    uq    max neval
         rowMeans(M)  10.7  14.4   15.1  15.7   21.1   100
  apply(M, 1L, mean) 350.6 362.0  371.2 382.7 2225.8   100
  rowApply0(M, mean) 635.8 655.2  672.3 716.8 2595.1   100
  rowApply1(M, mean) 225.1 233.8  239.7 249.8 2212.1   100
  rowApply2(M, mean) 221.3 229.4  236.6 260.2  329.0   100
  rowApply3(M, mean) 217.0 223.9  229.1 247.7 2077.2   100
 rowApply3(M, mean_)  34.3  38.2   39.3  41.1   47.0   100
 rowApply4(M, mean_)  34.1  36.7   38.0  39.3   47.1   100