Deniz Akdemir
Deniz Akdemir

Reputation: 13

How can I call a user defined R function in parallel from within an Rcpp function?

I am writing an R package that makes use of user-defined R functions. These functions need to be evaluated many times from within an Rcpp function.

I see two ways out:

1- Create several R sessions using RInline, evaluate the function with different arguments in each R session then gather these results?

2- Write a wrapper around the user-defined R function so that it is vectorized and evaluates the different inputs of the R function in parallel. Then pass this function to Rcpp hoping that when called the R function will still run in parallel.

I am not sure if any of these approaches will work. It is easy to try the second! But maybe someone has a better solution.

Upvotes: 0

Views: 291

Answers (1)

Deniz Akdemir
Deniz Akdemir

Reputation: 13

I think I got the second option to work. Thanks for the quick response anyway. I also think the first approach can be made to work. But this one suffices for my purposes. See the example below:

library(Rcpp)
library(future.apply)


userfunc<-function(x){
   Sys.sleep(1)
   return(x)
}
 

wrapperufpar<-function(xvec){
   plan(multisession)
   future_sapply(xvec, userfunc)
 } 
   cppFunction('NumericVector cppfunc(NumericVector xvec, Function ufunc) {
  NumericVector out(xvec.length());
  for (int i=0;i<xvec.length();i++){
   out(i)=as<double>(ufunc(xvec(i)));
   }
   return out;
 }')

 
cppFunction('NumericVector cppfuncpar(NumericVector xvec, Function ufuncw) {
  NumericVector out=as<NumericVector>(ufuncw(xvec));
   return out;
 }')

 cppfunc(1:10, userfunc)
 [1]  1  2  3  4  5  6  7  8  9 10
 cppfuncpar(1:10, wrapperufpar)
 [1]  1  2  3  4  5  6  7  8  9 10
 
 microbenchmark::microbenchmark(wrapperufpar(1:10),
                                sapply(1:10, userfunc),
                                cppfunc(1:10, userfunc),
                                cppfuncpar(1:10, wrapperufpar),
                                times=10)

Unit: seconds

                       expr       min        lq      mean    median
    wrapperufpar(1:10)  4.372158  4.456099  4.488181  4.477420
    sapply(1:10, userfunc) 10.002320 10.003834 10.005113 10.004944
    cppfunc(1:10, userfunc) 10.002743 10.004133 10.005217 10.004824
    cppfuncpar(1:10, wrapperufpar)  4.434338  4.475258  4.490961  4.491418


       uq       max neval
 4.548762  4.564422    10
10.006996 10.007854    10
10.006614 10.008436    10
 4.509277  4.545920    10

Upvotes: 1

Related Questions