I am working on interfacing some existing Fortran code for some R analyses. As a precursor I wanted to create a test function to confirm how I pass matrices in and out of the functions.
As per the answer here I thought I could use Rcpp to pass a NumericMatrix pointer to the C function with the .begin() method.
fortran_test.f
subroutine test(matrix, M, N)
IMPLICIT NONE
integer, intent(in) :: M,N
double precision, intent(inout) :: matrix(M,N)
integer :: i,j
do 10 i=1,M
do 20 j=1,N
matrix(i,j) = 2.0D0
20 end do
10 end do
end
cpp_test.cpp
#include <Rcpp.h>
extern "C"
{
void test_(double *, int, int);
}
using namespace Rcpp;
//' #export
// [[Rcpp::export]]
SEXP cpp_test(NumericMatrix X){
int nr = X.nrow();
int nc = X.ncol();
test_(X.begin(), nr, nc);
Rcpp::Rcout << X << std::endl;
return X;
}
However, when I try:
mydata <- matrix(rnorm(16), 4, 4)
cpp_test(mydata)
The program just crashes.
Strangely, if I try to use the .Fortran interface (which I am trying to avoid as I would like to do some further C++ before the Fortran call) the function doesn't crash but the matrix doesn't update either. I through in some Print statements in the Fortran to confirm that the internal matrix object is updating but it isn't returning those changes.
What am I missing here?
Edit
I have since noticed the the .Fortran call does return a list with the updated matrix. I would prefer however to have the 'in-place' modification but I don't now if that is possible. The C++ interface initially described above is my true goal.
Related
If I create a large Tensor in Eigen, and I like to return the Tensor back to R as multi-dimension array. I know how to do it with data copy like below. Question: is it possible to do it without the data-copy step?
#include <Rcpp.h>
#include <RcppEigen.h>
#include <unsupported/Eigen/CXX11/Tensor>
// [[Rcpp::depends(RcppEigen)]]
using namespace Rcpp;
template <typename T>
NumericVector copyFromTensor(const T& x)
{
int n = x.size();
NumericVector ans(n);
IntegerVector dim(x.NumDimensions);
for (int i = 0; i < x.NumDimensions; ++i) {
dim[i] = x.dimension(i);
}
memcpy((double*)ans.begin(), (double*)x.data(), n * sizeof(double));
ans.attr("dim") = dim;
return ans;
}
// [[Rcpp::export]]
NumericVector getTensor() {
Eigen::Tensor<double, 3> x(4, 3, 1);
x.setRandom();
return copyFromTensor(x);
}
/*** R
getTensor()
*/
As a general rule you can zero-copy one the way into your C++ code with data coming from R and already managed by R.
On the way out of your C++ code with data returning to R anything that is not created used the R allocator has to be copied.
Here your object x is a stack-allocated so you need a copy. See Writing R Extensions about the R allocator; Eigen may let you use it when you create a new Tensor object. Not a trivial step. I think I would just live with the copy.
I commonly work with a short Rcpp function that takes as input a matrix where each row contains K probabilities that sum to 1. The function then randomly samples for each row an integer between 1 and K corresponding to the provided probabilities. This is the function:
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadilloExtensions/sample.h>
using namespace Rcpp;
// [[Rcpp::export]]
IntegerVector sample_matrix(NumericMatrix x, IntegerVector choice_set) {
int n = x.nrow();
IntegerVector result(n);
for ( int i = 0; i < n; ++i ) {
result[i] = RcppArmadillo::sample(choice_set, 1, false, x(i, _))[0];
}
return result;
}
I recently updated R and all packages. Now I cannot compile this function anymore. The reason is not clear to me. Running
library(Rcpp)
library(RcppArmadillo)
Rcpp::sourceCpp("sample_matrix.cpp")
throws the following error:
error: call of overloaded 'sample(Rcpp::IntegerVector&, int, bool, Rcpp::Matrix<14>::Row)' is ambiguous
This basically tells me that my call to RcppArmadillo::sample() is ambiguous. Can anyone enlighten me as to why this is the case?
There are two things happening here, and two parts to your problem and hence the answer.
The first is "meta": why now? Well we had a bug let in the sample() code / setup which Christian kindly fixed for the most recent RcppArmadillo release (and it is all documented there). In short, the interface for the very probability argument giving you trouble here was changed as it was not safe for re-use / repeated use. It is now.
Second, the error message. You didn't say what compiler or version you use but mine (currently g++-9.3) is actually pretty helpful with the error. It is still C++ so some interpretative dance is needed but in essence it clearly stating you called with Rcpp::Matrix<14>::Row and no interface is provided for that type. Which is correct. sample() offers a few interface, but none for a Row object. So the fix is, once again, simple. Add a line to aid the compiler by making the row a NumericVector and all is good.
Fixed code
#include <RcppArmadillo.h>
#include <RcppArmadilloExtensions/sample.h>
// [[Rcpp::depends(RcppArmadillo)]]
using namespace Rcpp;
// [[Rcpp::export]]
IntegerVector sample_matrix(NumericMatrix x, IntegerVector choice_set) {
int n = x.nrow();
IntegerVector result(n);
for ( int i = 0; i < n; ++i ) {
Rcpp::NumericVector z(x(i, _));
result[i] = RcppArmadillo::sample(choice_set, 1, false, z)[0];
}
return result;
}
Example
R> Rcpp::sourceCpp("answer.cpp") # no need for library(Rcpp)
R>
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
--------- 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;
}
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
}