从Rcpp调用R函数的替代方法

Question

I was reading up very generic advice from lots of references, including the very introduction from Rcpp homepage and other posts in stackoverflow, such as Calling an R function using inline and rcpp is still just as low as original R .

My concern is that as we are building a CRAN package, evaluation of a posterior distribution (yes, I'm Bayesian) should be declared in R. Main algorithm was written in Rcpp, NumericMatrix sampling(NumericVector x, Function func) . I tried (1) simply inputting R function and (2) define an object with cppFunction to be passed into cpp script. It has, of course, no performance difference as expected.

So my main question should be

Should there be other ways to pass an evaluting function func as an input argument to generic Rcpp script of ours if its form in C/C++ is provided by an user ?

I've been struggling with this issue for quite a long time - looking through Rcpp gallery and its related projects. Since our target audience is much less literate in coding than I am, we hope specifying a function should not far exceed than simply writing an inline function. We would really appreciate any advice in advance.

Answer 1

I tried to create an example, inspired by RcppDE.

First we define a C++ function which calls n-times a "sum" function passed as argument. The given function can be an R function or a xptr<> wrapping a function pointer.
Code:

require(Rcpp)

# C++ function which calls a given "sum" function n-times.
# The passed function can be an R function or 
# an xptr wrapping a function pointer.
sourceCpp(code="
#include <Rcpp.h>

typedef double (*sumFnPtr)(Rcpp::NumericVector);

// [[Rcpp::export]]
Rcpp::NumericVector callSumFunctionNTimes(SEXP sumFn, Rcpp::NumericVector toSum,int times){
  Rcpp::NumericVector output(times);
  switch (TYPEOF(sumFn)){ 
    case EXTPTRSXP:
    {
      Rcpp::XPtr<sumFnPtr> xptr = Rcpp::as< Rcpp::XPtr<sumFnPtr> >(sumFn);
      for(int i = 0; i < times; i++){
        output[i] = (*(xptr))(toSum);
      }
      break;
    }
    // we suppose is a R function
    default: 
    {
      Rcpp::Function fn = Rcpp::as<Rcpp::Function>(sumFn);
      for(int i = 0; i < times; i++)
        output[i] = Rcpp::as<double>( fn(toSum) );
      break;
    }
  }
  return output;
}
")

Then, in C++ we define "mySum" function and another function returning a xptr<> wrapping it.
Code :

require(Rcpp)

# Here we define the sum function in C++ and we also 
# define a function returning a xptr wrapping the function
sourceCpp(code="
#include <Rcpp.h>

typedef double (*sumFnPtr)(Rcpp::NumericVector);

// [[Rcpp::export]]
double mySum(Rcpp::NumericVector toSum){
  double s = 0;
  for(int i = 0; i < toSum.length(); i++){
    s += toSum[i];
  }
  return s;
}

// [[Rcpp::export]]
SEXP getSumFunctionPtr(){
  return Rcpp::XPtr<sumFnPtr>(new sumFnPtr(&mySum));
}
")

Finally, we define a function which computes all the sums in C++ (ie without receiving the function as argument). Code :

require(Rcpp)

sourceCpp(code="
#include <Rcpp.h>

// [[Rcpp::export]]
Rcpp::NumericVector doEverythingInCpp(Rcpp::NumericVector toSum, int times){
  Rcpp::NumericVector output(times);
  for(int i = 0; i < times; i++){
    double s = 0;
    for(int j =0; j < toSum.length();j++){
      s += toSum[j];
    }
    output[i] = s;
  }
}

")

Let's test what happens when :

• TEST 1 : we call an R function (sum) 1 million times
• TEST 2 : we call an Rcpp function (mySum) 1 million times
• TEST 3 : we call an Rcpp function wrapped in xptr<> 1 million times
• TEST 4 : we do everything in C++ (ie we compute the sum 1 million times in C++)

Code:

# TEST 1
system.time(callSumFunctionNTimes(sum,1:100,1e6))
#  user  system elapsed 
# 13.45    0.00   13.45 

# TEST 2
system.time(callSumFunctionNTimes(mySum,1:100,1e6))
#  user  system elapsed 
# 13.97    0.00   13.97

# TEST 3
mySumFunctionnPtr <- getSumFunctionPtr()
system.time(callSumFunctionNTimes(mySumFunctionnPtr,1:100,1e6))
# user  system elapsed 
# 0.28    0.00    0.29

# TEST 4
system.time(doEverythingInCpp(1:100,1e6))
# user  system elapsed 
# 0.27    0.00    0.27

As you can see the R <-> C++ transition overhead disappears when we pass a compiled function (ie the function pointer wrapped in an xptr<> ) to C++, in fact the TEST 3 and 4 have basically the same performance.