r-simmer / simmer

Discrete-Event Simulation for R
https://r-simmer.org
GNU General Public License v2.0
222 stars 42 forks source link

Add support for compiled functions via externalptr #111

Open Enchufa2 opened 7 years ago

Enchufa2 commented 7 years ago

Motivation:

library(microbenchmark)

task_r <- function() rexp(1, 1)
# defines task_cpp, loop_r, loop_cpp, get_xptr
Rcpp::sourceCpp("code.cpp")

microbenchmark(
  loop_r(task_r),
  loop_r(task_cpp),
  loop_cpp(get_xptr())
)
#> Unit: microseconds
#>                  expr       min         lq       mean     median         uq        max neval cld
#>        loop_r(task_r) 11661.451 12740.7555 13626.1702 13300.6855 14165.9430  18038.164   100   b
#>      loop_r(task_cpp) 10456.355 11274.2640 13177.5561 12030.9100 13110.6395 105324.910   100   b
#>  loop_cpp(get_xptr())    69.542    75.5615   104.8892    79.3105    86.3375   1799.072   100  a 

where code.cpp is the following:

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
SEXP task_cpp() {
  return rexp(1, 1);
}

typedef SEXP (*funcPtr)();

// [[Rcpp::export]]
SEXP get_xptr() {
  return XPtr<funcPtr>(new funcPtr(&task_cpp));
}

// [[Rcpp::export]]
double loop_cpp(SEXP x, int n=1e3) {
  funcPtr func = *XPtr<funcPtr>(x);
  double accum = 0;
  for (int i=0; i<n; i++)
    accum += as<double>(func());
  return accum;
}

// [[Rcpp::export]]
double loop_r(Function func, int n=1e3) {
  double accum = 0;
  for (int i=0; i<n; i++)
    accum += as<double>(func());
  return accum;
}
Enchufa2 commented 6 years ago

Expose as a const ops class or structure: