Passing user-supplied C++ functions with RcppXPtrUtils

[This article was first published on Rcpp Gallery, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

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)' 

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 
using namespace Rcpp;

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

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

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

// [[Rcpp::export]]
NumericVector execute_cpp(SEXP func_, double l) {
  funcPtr func = *XPtr(func_);
  return core_processing(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  

To leave a comment for the author, please follow the link and comment on their blog: Rcpp Gallery.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)