using `XPtr` to create pointer to a user defined function in Rcpp - r

--------- Adding a summary of the problem ---------------------------------
I want to create a externalpointer for a user defined function which can be passed to the another function. The user will provide function name as a string, my question is how can I convert that into a function pointer, after checking that the user provided string (say fstr) matches with the name of the function that was created by the user, i.e.
if (fstr == "<USER_DEFINED_FUNCTION_NAME>")
XPtr<funcPtr> fun(new funcPtr(&<USER_DEFINED_FUNCTION_NAME>), true);
else
Rcpp::Rcout << "Supply the correct function name" << std::endl;
since, I don't know the name of the function created by the user, essentially the problem is - how can I get the string stored in the variable fstr?
The full problem is described below. Of course, I could be thinking of this problem in a totally wrong way and there may be a better way to create a function pointer to a user defined function.
Thanks
I am writing a package which provides a wrapper around the cvode solver for solving ODEs from the SUNDIALS ODE solving C library. The C function which describes the right hand side of the ODEs must be have the signature
int <FUNCTION_NAME> (realtype t, N_Vector y, N_Vector ydot, void *user_data)
where realtype, N_Vector are datatypes defined in the library and t is time, y is the vector of states (dependent variables) and ydot is the rate of change of those variables w.r.t. time.
I have written a package which provides a wrapper around the cvode function in this library to solve ODEs expressed as above. The package source code can be found here. The cvode function can be used to solve the example in SUNDIALS provided as follows:
I create a test.cpp (pasted below) which describes the RHS of ODEs, it also has the exported function to create externalpointer for the function which gets exported to R. Note that NV_Ith_S is also defined by the library. Also, a good example about function pointers in Rcpp can be found here
First I run Rcpp::sourceCpp(test.cpp), then I run my_fun <- putFunPtrInXPtr() to create a external pointer my_fun to my test function in test.cpp. Finally, after loading the package, I run the command
time_t <- c(0.0, 0.4, seq(from = 10.4, len = 12, by = 10)) # time vector
cvode(time_t, c(1,0,0), my_fun, 1e-04, c(1e-08, 1e-08, 1e-08))
to get results on console successfully. Here the second argument is the initial conditions (IC), my_fun is the pointer to ODE function, third argument is relative tolerance and fourth argument is absolute tolerance. See details about cvode here.
My question is this - I want to change the cvode in my package so that it can take function name as a string, i.e. cvode(NumericVector time, NumericVector IC, std::string fstr, double reltol, NumericVector abstol), instead of cvode(NumericVector, NumericVector, SEXP, double, NumericVector) where the string (fstr) is the user given name which should be same as the same of the function defined in .cpp file (here test function in test.cpp).
I am thinking in my cvode function, I can write
if (fstr == "<USER_DEFINED_FUNCTION_NAME>")
XPtr<funcPtr> fun(new funcPtr(&<USER_DEFINED_FUNCTION_NAME>), true);
else
Rcpp::Rcout << "Supply the correct function name" << std::endl;
However, I cannot think of any way of getting information regarding the USER_DEFINED_FUNCTION_NAME. Essentially, I want fun to point to the USER_DEFINED_FUNCTION_NAME, but can't think of any way.
In the end, I actually want the RHS function defined in .cpp to have the signature int <FUNCTION_NAME>(double t, NumericVector y, NumericVector ydot, void *user_data), from which I create a function with the correct signature to be fed to cvode, but not sure how this is possible also.
I would be very thankful for any guidance. Thanks!
#include <Rcpp.h>
using namespace Rcpp;
#include <cvode/cvode.h> /* prototypes for CVODE fcts., consts. */
#include <nvector/nvector_serial.h> /* serial N_Vector types, fcts., macros */
#include <cvode/cvode_dense.h> /* prototype for CVDense */
#include <sundials/sundials_dense.h> /* definitions DlsMat DENSE_ELEM */
#include <sundials/sundials_types.h> /* definition of type realtype */
int test (realtype t, N_Vector y, N_Vector ydot, void *user_data){
// static keyword before int is not really required here
NV_Ith_S(ydot,0) = -0.04 * NV_Ith_S(y,0) + 1e04 * NV_Ith_S(y,1) * NV_Ith_S(y,2);
NV_Ith_S(ydot,2) = 3e07 * NV_Ith_S(y,1) * NV_Ith_S(y,1);
NV_Ith_S(ydot,1) = -NV_Ith_S(ydot,0) - NV_Ith_S(ydot,2);
return(0);
}
// declare funcPtr as a type for function pointer to a function with the
// signature same as function which describes the RHS for ODEs
// see reference here - http://gallery.rcpp.org/articles/passing-cpp-function-pointers/
typedef int (*funcPtr)(realtype t, N_Vector y, N_Vector ydot, void *user_data);
// [[Rcpp::export]]
XPtr<funcPtr> putFunPtrInXPtr() {
// return(XPtr<funcPtr> (new funcPtr(&test)));
XPtr<funcPtr> testptr(new funcPtr(&test), true);
return testptr;
}

Related

How do I resolve compile error in RcppParallel function which points to an RcppParallel header file

I'm trying to speed up numeric computation in my R code using RcppParallel and am attempting to edit an example that uses the Cpp sqrt() function to take the square root of each element of a matrix. My edited code replaces matrices with vectors and multiplies the sqrt() by a constant. (In actual use I will have 3 constants and my own operator function.)
The example comes from
https://gallery.rcpp.org/articles/parallel-matrix-transform/
The compiler identifies the error as in the 'algorithm' file on a comment line:
Line 7 no matching function for call to object of type 'SquareRootPlus::sqrtWrapper'
This is my initial attempt to use RcppParallel and I've not used
Cpp for several years.
Edit: running macOS Ventura on apple silicon,
Rcpp ver 1.0.10,
RcppParallel ver 5.1.6,
and R version 4.2.1 (2022-06-23) -- "Funny-Looking Kid"
It would be called like this (if it compiled):
where c is a numerical constant aka a double and res is a numerical vector
res <- parallelMatrixSqrt(someNumericalVector, c)
My testing code is:
#include <Rcpp.h>
#include <RcppParallel.h>
using namespace RcppParallel;
using namespace Rcpp;
struct SquareRootPlus : public Worker
{
// source vector etc
const RVector<double> input;
const double constParam;
// destination vector
RVector<double> output;
// initialize with source and destination
// get the data type correctly unless auto promoted/cast
SquareRootPlus(const Rcpp::NumericVector input, const double constParam,
Rcpp::NumericVector output)
: input(input), constParam(constParam), output(output) {}
struct sqrt_wrapper { // describe worker function
public: double operator()(double a, double cp) {
return ::sqrt(a) * cp;
}
};
// take the square root of the range of elements requested
// (and multiply it by the constant)
void operator()(std::size_t begin, std::size_t end) {
std::transform(input.begin() + begin,
input.begin() + end,
output.begin() + begin,
sqrt_wrapper());
}
};
// public called routine
// [[Rcpp::export]]
Rcpp::NumericVector paralleVectorSqrt(Rcpp::NumericVector x, double c) {
// allocate the output matrix
Rcpp::NumericVector output(x.length());
// SquareRoot functor (pass input and output matrixes)
SquareRootPlus squareRoot(x, c, output);
// call parallelFor to do the work
parallelFor(0, x.length(), squareRoot);
// return the output matrix
return output;
}
That still works fine for me (Ubuntu 22.10, g++-12) -- modulo same warnings we often get from libraries like Boost, and here now from the include TBB library (and the repo should have a newer one so you can try that).
I just did (straight from the Rcpp Gallery source directory):
> library(Rcpp)
> sourceCpp("2014-06-29-parallel-matrix-transform.cpp")
In file included from /usr/local/lib/R/site-library/RcppParallel/include/tbb/tbb.h:41,
from /usr/local/lib/R/site-library/RcppParallel/include/RcppParallel/TBB.h:10,
from /usr/local/lib/R/site-library/RcppParallel/include/RcppParallel.h:21,
from 2014-06-29-parallel-matrix-transform.cpp:59:
/usr/local/lib/R/site-library/RcppParallel/include/tbb/concurrent_hash_map.h:343:23: warning: ‘template<class _Category, class _Tp, class _Distance, class _Pointer, class _Reference> struct std::iterator’ is dep
recated [-Wdeprecated-declarations]
[... more like this omitted for brevity ...]
> # allocate a matrix
> m <- matrix(as.numeric(c(1:1000000)), nrow = 1000, ncol = 1000)
> # ensure that serial and parallel versions give the same result
> stopifnot(identical(matrixSqrt(m), parallelMatrixSqrt(m)))
> # compare performance of serial and parallel
> library(rbenchmark)
> res <- benchmark(matrixSqrt(m),
+ parallelMatrixSqrt(m),
+ order="relative")
> res[,1:4]
test replications elapsed relative
2 parallelMatrixSqrt(m) 100 0.496 1.000
1 matrixSqrt(m) 100 0.565 1.139
>
and as you can see it not only builds but also runs the example call from R.
You would have to give us more detail about how you call it and what OS and package versions you use. And I won't have time now to dig into your code and do a code review for you but given that (still relatively simple) reference example works maybe you can reduce your currently-not-working approach down to something simpler that works.
Edit Your example appears to have switched from a unary function to one with two arguments in the signature. Sadly it ain't that easy. The fuller error message is (on my side with g++-12)
/usr/include/c++/12/bits/stl_algo.h:4263:31: error: no match for call to ‘(SquareRootPlus::sqrt_wrapper) (const double&)’
4263 | *__result = __unary_op(*__first);
| ~~~~~~~~~~^~~~~~~~~~
question.cpp:25:20: note: candidate: ‘double SquareRootPlus::sqrt_wrapper::operator()(double, double)’
25 | public: double operator()(double a, double cp) {
| ^~~~~~~~
question.cpp:25:20: note: candidate expects 2 arguments, 1 provided
So you need to rework / extend the example framework for this.
Edit 2: The gory details about std::transform() and its unary function are e.g. here at cppreference.com.
Edit 3: Building on the previous comment, when you step back a bit and look at what is happening here you may seen that RcppParellel excels at parceling up a large data structure, then submitting all the piece in parallel and finally reassemble the result. That still works. You simply cannot apply for 'richer signature function' via std::transform(). No more, no less. You need to work the guts of work which applies your function to the chunk it sees. Check the other RcppParallel examples for inspiration.

Passing R functions to C routines using rcpp

I have a C function from a down-stream library that I call in C like this
result = cfunction(input_function)
input_function is a callback that needs to have the following structure
double input_function(const double &x)
{
return(x*x);
}
Where x*x is a user-defined computation that is usually much more complicated. I'd like to wrap cfunction using Rcpp so that the R user could call it on arbitrary R functions.
NumericVector rfunction(Function F){
NumericVector result(1);
// MAGIC THAT I DON'T KNOW HOW TO DO
// SOMEHOW TURN F INTO COMPATIBLE input_funcion
result[0] = cfunction(input_function);
return(result);
}
The R user then might do rfunction(function(x) {x*x}) and get the right result.
I am aware that calling R functions within cfunction will kill the speed but I figure that I can figure out how to pass compiled functions later on. I'd just like to get this part working.
The closest thing I can find that does what I need is this https://sites.google.com/site/andrassali/computing/user-supplied-functions-in-rcppgsl which wraps a function that uses callback that has an oh-so-useful second parameter within which I could stuff the R function.
Advice would be gratefully received.
One possible solution would be saving the R-function into a global variable and defining a function that uses that global variable. Example implementation where I use an anonymous namespace to make the variable known only within the compilation unit:
#include <Rcpp.h>
extern "C" {
double cfunction(double (*input_function)(const double&)) {
return input_function(42);
}
}
namespace {
std::unique_ptr<Rcpp::Function> func;
}
double input_function(const double &x) {
Rcpp::NumericVector result = (*func)(x);
return result(0);
}
// [[Rcpp::export]]
double rfunction(Rcpp::Function F){
func = std::make_unique<Rcpp::Function>(F);
return cfunction(input_function);
}
/*** R
rfunction(sqrt)
rfunction(log)
*/
Output:
> Rcpp::sourceCpp('57137507/code.cpp')
> rfunction(sqrt)
[1] 6.480741
> rfunction(log)
[1] 3.73767

using global SEXP to store XPtr gives garbage values

I am building a package which solves Ordinary Differential Equations (ODEs) using the CVODE C routine (part of the SUNDIALS C library).
The package works if the user supplies a function which calculates derivatives and has the following form
#include <Rcpp.h>
using namespace Rcpp;
#include <cvode/cvode.h> /* prototypes for CVODE fcts., consts. */
#include <nvector/nvector_serial.h> /* serial N_Vector types, fcts., macros */
int test (realtype t, N_Vector y, N_Vector ydot, void *user_data){
// test function
NV_Ith_S(ydot,0) = 1*NV_Ith_S(y,0);
NV_Ith_S(ydot,1) = 2*NV_Ith_S(y,1);
NV_Ith_S(ydot,2) = 3*NV_Ith_S(y,2);
return(0);
}
typedef int (*funcPtr)(realtype t, N_Vector y, N_Vector ydot, void *user_data);
// [[Rcpp::export]]
XPtr<funcPtr> putFunPtrInXPtr() {
// return(XPtr<funcPtr> (new funcPtr(&test)));
XPtr<funcPtr> testptr(new funcPtr(&test), false);
return testptr;
A function pointer, i.e. my_fun <- putFunPtrInXPtr() is formed in R and my_fun is provided to the cvode function from the package (cvode inputs my_fun as an SEXP, see code here). This works, i.e. gives the right results (see detailed instructions here). However, this requires that user has SUNDIALS installed on their system (to access cvode.h and nvector_serial.h).
I am trying to make the package so the user does not need to have SUNDIALS installed. So, the function to get derivatives (and generate function pointer) will be as below
#include <Rcpp.h>
using namespace Rcpp;
//---------------------------------------------------------------------------------
typedef NumericVector (*funcPtr1) (double t, NumericVector y, NumericVector ydot);
//---------------------------------------------------------------------------------
// [[Rcpp::export]]
NumericVector test1 (double t, NumericVector y, NumericVector ydot){
ydot[0] = 1 * y[0];
ydot[1] = 2 * y[1];
ydot[2] = 3 * y[2];
return ydot;
}
// [[Rcpp::export]]
XPtr<funcPtr1> putFunPtrInXPtr1() {
XPtr<funcPtr1> testptr1(new funcPtr1(&test1), false);
return testptr1;
}
On the R side, my_fun1 <- putFunPtrInXPtr1() will be run and my_fun1 will be provided to cvode_test (a test function defined in package to be able to handle derivative functions defined using NumericVector only.
In my package to convert function pointer type from XPtr<funcPtr1>to XPtr<funcPtr>, I do the following
1) A global SEXP (sexp_g) is defined outside any function
2) In cvode_test the input SEXP is assigned to sexp_g
3) Finally, a function fun_test1 is defined as follows, which converts N_Vector to NumericVector, uses the function in sexp_g to get derivatives and then puts them again in an N_Vector, i.e.
typedef int (*funcPtr_test)(double time, NumericVector y, NumericVector ydot);
SEXP sexp_g; // declare a global SEXP
int fun_test1(realtype t, N_Vector y, N_Vector ydot, void* user_data){
// convert y to NumericVector y1
int y_len = NV_LENGTH_S(y);
NumericVector y1(y_len); // filled with zeros
for (int i = 0; i < y_len; i++){
y1[i] = NV_Ith_S(y,i);
}
// use function pointer to get the derivatives
XPtr<funcPtr_test> xpfun(sexp_g);
funcPtr_test fun_test = *xpfun;
NumericVector ydot1(y1.length());
ydot1 = fun_test(t, y1, ydot1);
// convert ydot1 to N_Vector ydot
// N_Vector ydot; ydot = NULL;
ydot = N_VNew_Serial(ydot1.length());
for (int i = 0; i<ydot1.length(); i++){
NV_Ith_S(ydot, i) = ydot1[i];
}
return (0);
}
Finally, in cvode_test, this fun_test1 is used as follows
flag = CVodeInit(cvode_mem, fun_test1, T0, y0);
This also compiles but the issue is when I supply my_fun1 (i.e., a pointer to test1) to cvode_test for integration, I get garbage values back. I am not sure what is going wrong here, I have read a few articles about protecting SEXP (i.e., the one here) but I don't know how to implement it here.
Any help regarding what is wrong here, and if there is a better approach than a global SEXP variable will be helpful. Since the rhs function for CVOdeInit has to have the following signature
int RHS_function (N_Vector, N_Vector, void*);
I am finding it impossible to insert information in a function defined as above from a function defined outside the package using a different signature (using an SEXP), other than using a global variable and have been struggling with this problem for quite some time. Any help would be much appreciated!
A different approach that I have not tried is 1) declaring XPtr<funPtr_test> outside any function, 2) unwrapping SEXP to XPtr<funcPtr_test> inside the cvode_test and assigning it to the pointer declared outside the function. But I am struggling with the syntax to declare a function pointer of the type XPtr<funcPtr_test>.
The full code for cvode and cvode_test can be found here
Thanks

Call R functions in RcppArmadillo with armadillo data type

I am translating my R code with some prepared functions to RcppArmadillo. I want to use some of these functions directly in my Rcpp code,instead of translating. For example, I want to call the sigma2 function:
sigma2<- function(xi.vec,w.vec,log10lambda,n,q){
lambda <- 10^log10lambda
(1/(n-q))*sum((lambda*xi.vec*(w.vec^2))/(lambda*xi.vec+1))
}
A typical Rcpp code is as below:
#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
// [[Rcpp::export]]
SEXP myS(){
Rcpp::Environment myEnv = Rcpp::Environment::global_env();
Rcpp::Function myS = myEnv["sigma2"];
arma::vec xvec = myEnv["xi.vec"];
arma::vec wvec = myEnv["w.vec"];
double l = myEnv["log10lambda"];
int n = myEnv["n"];
int q = myEnv["q"];
return myS(Rcpp::Named("xi.vec",xvec),
Rcpp::Named("w.vec",wvec),
Rcpp::Named("l",l),
Rcpp::Named("n",n),
Rcpp::Named("q",q));
}
Of course it works. But my problem is that in my case, the parameters of sigma2 function should be defined before as output of another function(say func1) in RcppArmadillo and they have armadillo data type. For instance, xi.vec and w.vec have vec type. Now I want to know how can I modified this code to call sigma2? Do I need to change my environment?
First, just say no to embedding R functions and environments into C++ routines. There is no speedup in this case; only a considerable slowdown. Furthermore, there is a greater potential for things to go cockeye if the variables are not able to be retrieved in the global.env scope.
In your case, you seem to be calling myS() from within myS() with no terminating condition. Thus, your function will never end.
e.g.
SEXP myS(){
Rcpp::Function myS = myEnv["sigma2"];
return myS(Rcpp::Named("xi.vec",xvec),
Rcpp::Named("w.vec",wvec),
Rcpp::Named("l",l),
Rcpp::Named("n",n),
Rcpp::Named("q",q));
}
Switch one to be myS_R and myS_cpp.
Regarding environment hijacking, you would need to pass down to C++ the values. You cannot reach into an R function to obtain values specific passed to it before it is called.
e.g.
SEXP myS_cpp(arma::vec xvec, arma::vec wvec, double l, int n, int q){
// code here
}

Call R functions in Rcpp [duplicate]

This question already has answers here:
Call a function from c++ via environment Rcpp
(2 answers)
Closed 6 years ago.
I was trying to call the sd(x), which is a R function, in Rcpp. I've seen an example of calling the R function dbate(x) in Rcpp and it works perfectly.
// dens calls the pdf of beta distribution in R
//[[Rcpp::export]]
double dens(double x, double a, double b)
{
return R::dbeta(x,a,b,false);
}
But when I tired to apply this method to sd(x) as following, it went wrong.
// std calls the sd function in R
//[[Rcpp::export]]
double std(NumericVector x)
{
return R::sd(x);
}
Does anyone know why this doesn't work?
There are a few issues with your code.
std is related to the C++ Standard Library namespace
This is triggering:
error: redefinition of 'std' as different kind of symbol
The R:: is a namespace that deals with Rmath functions. Other R functions will not be found in within this scope.
To directly call an R function from within C++ you must use Rcpp::Environment and Rcpp::Function as given in the example sd_r_cpp_call().
There are many issues with this approach though including but not limited to the loss of speed.
It is ideal to use Rcpp sugar expressions or implement your own method.
With this being said, let's talk code:
#include <Rcpp.h>
//' #title Accessing R's sd function from Rcpp
// [[Rcpp::export]]
double sd_r_cpp_call(const Rcpp::NumericVector& x){
// Obtain environment containing function
Rcpp::Environment base("package:stats");
// Make function callable from C++
Rcpp::Function sd_r = base["sd"];
// Call the function and receive its list output
Rcpp::NumericVector res = sd_r(Rcpp::_["x"] = x,
Rcpp::_["na.rm"] = true); // example of additional param
// Return test object in list structure
return res[0];
}
// std calls the sd function in R
//[[Rcpp::export]]
double sd_sugar(const Rcpp::NumericVector& x){
return Rcpp::sd(x); // uses Rcpp sugar
}
/***R
x = 1:5
r = sd(x)
v1 = sd_r_cpp_call(x)
v2 = sd_sugar(x)
all.equal(r,v1)
all.equal(r,v2)
*/

Resources