Passing user-supplied C++ functions with RcppXPtrUtils

August 3, 2017
By

(This article was first published on Rcpp Gallery, and kindly contributed to R-bloggers)

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

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 on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...



If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.

Search R-bloggers

Sponsors

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)