Passing user-supplied C++ functions with RcppXPtrUtils

Iñaki Ucar — written Aug 4, 2017 — source

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:

Some repetitive scaffolding is always needed in order to bring the XPtr to R space.
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: 0x564011b984e0>

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 'int', should be 'double'.

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

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

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

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

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        uq
     execute(func_r, 1.5) 9010.765 9434.233 9985.919 9739.334 10469.518
 execute(func_r_cpp, 1.5) 8751.593 9218.137 9776.670 9430.297 10257.962
   execute(func_cpp, 1.5)  170.708  193.201  248.939  229.528   300.495
       max neval cld
 14538.013   100   b
 13712.093   100   b
   416.451   100  a

tags: function

Extending R with C++ and Fortran — Dirk Eddelbuettel and JBrandon Duck-Mayr
Benchmarking Rcpp code with RcppClock — Zach DeBruine
Simulation Smoother using RcppArmadillo — Tomasz Woźniak