Sitting on top of R’s external pointers, the RcppXPtr class provides a powerful and generic framework for Passing user-supplied C++ functions to a C++ backend. This technique is exploited in the RcppDE package, an efficient C++ based implementation of the DEoptim package that accepts optimisation objectives as both R and compiled functions (see demo("compiled", "RcppDE") for further details). This solution has a couple of issues though:

1. Some repetitive scaffolding is always needed in order to bring the XPtr to R space.
2. There is no way of checking whether a user-provided C++ function complies with the internal signature supported by the C++ backend, which may lead to weird runtime errors.

Better XPtr handling with RcppXPtrUtils

In a nutshell, RcppXPtrUtils provides functions for dealing with these two issues: namely, cppXPtr and checkXPtr. As a package author, you only need to 1) import and re-export cppXPtr to compile code and transparently retrieve an XPtr, and 2) use checkXPtr to internally check function signatures.

cppXPtr works in the same way as Rcpp::cppFunction, but instead of returning a wrapper to directly call the compiled function from R, it returns an XPtr to be passed to, unwrapped and called from C++. The returned object is an R’s externalptr wrapped into a class called XPtr along with additional information about the function signature.

library(RcppXPtrUtils)

ptr <- cppXPtr("double foo(int a, double b) { return a + b; }")
class(ptr)

[1] "XPtr"

ptr

'double foo(int a, double b)' <pointer: 0x55c64060de40>

The checkXptr function checks the object against a given signature. If the verification fails, it throws an informative error:

checkXPtr(ptr, type="double", args=c("int", "double")) # returns silently
checkXPtr(ptr, "int", c("int", "double"))

Error in checkXPtr(ptr, "int", c("int", "double")): Bad XPtr signature:
  Wrong return type 'double', should be 'int'.

checkXPtr(ptr, "int", c("int"))

Error in checkXPtr(ptr, "int", c("int")): Bad XPtr signature:
  Wrong return type 'double', should be 'int'.
  Wrong number of arguments, should be 1'.

checkXPtr(ptr, "int", c("double", "std::string"))

Error in checkXPtr(ptr, "int", c("double", "std::string")): Bad XPtr signature:
  Wrong return type 'double', should be 'int'.
  Wrong argument type 'int', should be 'double'.
  Wrong argument type 'double', should be 'std::string'.

Complete use case

First, let us define a templated C++ backend that performs some processing with a user-supplied function and a couple of adapters:

#include <Rcpp.h>
using namespace Rcpp;

template <typename T>
NumericVector core_processing(T func, double l) {
  double accum = 0;
  for (int i=0; i<1e3; i++)
    accum += sum(as<NumericVector>(func(3, l)));
  return NumericVector(1, accum);
}

// [[Rcpp::export]]
NumericVector execute_r(Function func, double l) {
  return core_processing<Function>(func, l);
}

typedef SEXP (*funcPtr)(int, double);

// [[Rcpp::export]]
NumericVector execute_cpp(SEXP func_, double l) {
  funcPtr func = *XPtr<funcPtr>(func_);
  return core_processing<funcPtr>(func, l);
}

Note that the user-supplied function takes two arguments: one is also user-provided and the other is provided by the backend itself. This core is exposed through the following R function:

execute <- function(func, l) {
  stopifnot(is.numeric(l))
  if (is.function(func))
    execute_r(func, l)
  else {
    checkXPtr(func, "SEXP", c("int", "double"))
    execute_cpp(func, l)
  }
}

Finally, we can compare the XPtr approach with a pure R-based one, and with a compiled function wrapped in R, as returned by Rcpp::cppFunction:

func_r <- function(n, l) rexp(n, l)
cpp <- "SEXP foo(int n, double l) { return rexp(n, l); }"
func_r_cpp <- Rcpp::cppFunction(cpp)
func_cpp <- cppXPtr(cpp)

microbenchmark::microbenchmark(
  execute(func_r, 1.5),
  execute(func_r_cpp, 1.5),
  execute(func_cpp, 1.5)
)

Unit: microseconds
                     expr       min        lq       mean     median
     execute(func_r, 1.5) 13812.742 15287.713 16429.4728 16017.6470
 execute(func_r_cpp, 1.5) 12150.643 13347.326 14482.0998 14145.5830
   execute(func_cpp, 1.5)   288.156   369.646   440.1885   400.6895
        uq       max neval cld
 16818.716 53182.418   100   c
 15078.917 22634.887   100  b 
   445.511  1525.653   100 a