Calling Rcpp function with Xptr and Function - only xptr case works

Question

I am trying to develop a package in which I need to input a function from user (could be defined using Rcpp or in R), send it to another function (within the package) in a struct and process it there.

When I use Rcpp::Xptr (i.e., function pointer) the code works, but the same does not work with Rcpp::Function. The advantage with using Rcpp::Function for the user would be that they would be able to define the function in R (although lose a lot of performance gain).

First what works:

#include <Rcpp.h>
using namespace Rcpp;

// define the structure
struct xptr_data{
  SEXP xptr;
};

// a minimal function (user-defined)
// [[Rcpp::export]]
NumericVector timesTwo(NumericVector x) {
  return x * 2;
}

// pointer to function defined
typedef NumericVector (*funcPtr) (NumericVector y);

// [[Rcpp::export]]
XPtr<funcPtr> putFunPtrInXPtr() {

  XPtr<funcPtr> rhs_ptr(new funcPtr(&timesTwo), false); 
  return rhs_ptr;
}

// this function will be in the package
NumericVector call_by_xptr_struct(NumericVector y, void* user_data){

  struct xptr_data *my_rhs_ptr = (struct xptr_data*)user_data;
  SEXP xpsexp = (*my_rhs_ptr).xptr;

  // use function pointer to get the derivatives
  XPtr<funcPtr> rhs_xptr(xpsexp);
  funcPtr rhs_fun = *rhs_xptr;

  // use the function to calculate value of RHS ----
  return(rhs_fun(y));
}


// using xptr to evaluate function - this will be exported
// from the package
//[[Rcpp::export]]
NumericVector xptr_call_struct(NumericVector y, SEXP xpsexp){

  struct xptr_data my_xptr = {NULL};

  my_xptr.xptr = xpsexp;
  return call_by_xptr_struct(y, (void*)&my_xptr);
}

/*** R    
rhs_ptr <- putFunPtrInXPtr()

xptr_call_struct(c(1,2), rhs_ptr)
[1] 2 4
*/ 

What doesn't work,

If the function is defined in R and I use Rcpp::Function directly, it crashes the entire R session,

#include <Rcpp.h>
using namespace Rcpp;

// define the function based structure
struct func_data{
  Function func;
};

// processes the input function 
NumericVector call_by_func_struct(NumericVector y, void* user_data){

  struct func_data *my_rhs_fun = (struct func_data*)user_data;
  Function func = (*my_rhs_fun).func;

  return(func(y));
}

// this will be exported from the package
//[[Rcpp::export]]
NumericVector func_call_struct(NumericVector y, Function func){

  struct func_data my_func = {NULL};

  my_func.func = func;
  return call_by_func_struct(y, (void*)&my_func);
}

/*** R
timesThree <- function(y){

  y <- 3 * y
  y
}

*/

The code above compiles fine, but when I call the function func_call_struct(c(1,2), timesThree)), it crashes entire R session.

Any guidance regarding why R is crashing and how to input functions defined in R would be very helpful.

Additionally, is there any way to pass input functions defined in Rcpp (e.g., timesTwo above) and not their Xptr. I am thinking that would be slightly less confusing for the end-user (as they won't have to generate a function pointer) without sacrificing the speed that comes with Rcpp.

Answer 1

It works if you initialize the struct using the available Function:

[...]
// this will be exported from the package
//[[Rcpp::export]]
NumericVector func_call_struct(NumericVector y, Function func){

  struct func_data my_func = {func};
  return call_by_func_struct(y, (void*)&my_func);
}

As for your additional question: I do not see a possibility to store a C++ function pointer within R without using an external pointer. Can't you provide a helper function (possibly as wrap()) that creates the external pointer from the function pointer? Something along these lines:

#include <Rcpp.h>
using namespace Rcpp;

// define the structure
struct xptr_data{
  SEXP xptr;
};

// pointer to function defined
typedef NumericVector (*funcPtr) (NumericVector y);


// this function will be in the package
NumericVector call_by_xptr_struct(NumericVector y, void* user_data){

  struct xptr_data *my_rhs_ptr = (struct xptr_data*)user_data;
  SEXP xpsexp = (*my_rhs_ptr).xptr;

  // use function pointer to get the derivatives
  XPtr<funcPtr> rhs_xptr(xpsexp);
  funcPtr rhs_fun = *rhs_xptr;

  // use the function to calculate value of RHS ----
  return(rhs_fun(y));
}


// using xptr to evaluate function - this will be exported
// from the package
//[[Rcpp::export]]
NumericVector xptr_call_struct(NumericVector y, SEXP xpsexp){

  struct xptr_data my_xptr = {xpsexp};
  return call_by_xptr_struct(y, (void*)&my_xptr);
}


// function in package with only C++ API
XPtr<funcPtr> wrapFunPtr(funcPtr& f) {
  XPtr<funcPtr> rhs_ptr(&f, false); 
  return rhs_ptr;
}



// user-defined functions
NumericVector timesTwo(NumericVector x) {
  return x * 2;
}

// [[Rcpp::export]]
XPtr<funcPtr> putFunPtrInXPtr() {
  static funcPtr f = &timesTwo;
  return wrapFunPtr(f);
}



/*** R    
rhs_ptr <- putFunPtrInXPtr()

xptr_call_struct(c(1,2), rhs_ptr)
*/ 

The user would supply the last two functions. With C++11 this could be simplified like this:

// [[Rcpp::export]]
XPtr<funcPtr> putFunPtrInXPtr() {
  static funcPtr timesTwo{ [](NumericVector x) -> NumericVector { return x * 2; } };
  return wrapFunPtr(timesTwo); 
}

Although in this case it might be sufficient to use

// [[Rcpp::export]]
XPtr<funcPtr> putFunPtrInXPtr() {
  static funcPtr timesTwo{ [](NumericVector x) -> NumericVector { return x * 2; } };
  XPtr<funcPtr> rhs_ptr(timesTwo, false); 
  return rhs_ptr;
}

without the need for wrapFunPtr in the package. The user has to supply one function, which includes some boiler-plate code plus the actual "meat" within the lambda expression.