使用rcpp将R函数传递给C例程

Question

I have a C function from a down-stream library that I call in C like this

result = cfunction(input_function)

input_function is a callback that needs to have the following structure

double input_function(const double &x)
{
  return(x*x);
}

Where x*x is a user-defined computation that is usually much more complicated. I'd like to wrap cfunction using Rcpp so that the R user could call it on arbitrary R functions.

NumericVector rfunction(Function F){

  NumericVector result(1);

  // MAGIC THAT I DON'T KNOW HOW TO DO
  // SOMEHOW TURN F INTO COMPATIBLE input_funcion

  result[0] = cfunction(input_function);

  return(result);
  }

The R user then might do rfunction(function(x) {x*x}) and get the right result.

I am aware that calling R functions within cfunction will kill the speed but I figure that I can figure out how to pass compiled functions later on. I'd just like to get this part working.

The closest thing I can find that does what I need is this https://sites.google.com/site/andrassali/computing/user-supplied-functions-in-rcppgsl which wraps a function that uses callback that has an oh-so-useful second parameter within which I could stuff the R function.

Advice would be gratefully received.

Answer 1

One possible solution would be saving the R-function into a global variable and defining a function that uses that global variable. Example implementation where I use an anonymous namespace to make the variable known only within the compilation unit:

#include <Rcpp.h>

extern "C" {
    double cfunction(double (*input_function)(const double&)) {
        return input_function(42);
    }
}

namespace {
std::unique_ptr<Rcpp::Function> func;
}

double input_function(const double &x) {
    Rcpp::NumericVector result = (*func)(x);
    return result(0);
}


// [[Rcpp::export]]
double rfunction(Rcpp::Function F){
    func = std::make_unique<Rcpp::Function>(F);
    return cfunction(input_function);
}

/*** R
rfunction(sqrt)
rfunction(log)
*/

Output:

> Rcpp::sourceCpp('57137507/code.cpp')

> rfunction(sqrt)
[1] 6.480741

> rfunction(log)
[1] 3.73767