I have a user defined function in r:
blacksch<-function(s_0,k,sigma,r,t)
{
d1=(log(s_0/k) + (r + (sigma^2)/2)*(t))/(sigma*sqrt(t))
d2=(log(s_0/k) + (r - (sigma^2)/2)*(t))/(sigma*sqrt(t))
p=(pnorm(-d2)*k*exp(-r*t))-pnorm(-d1)*s_0
}
And I would like to use this function in c++ code that I have written using Rcpp and cppFunction. I have been through the documentation and examples a few times, but have not been successful.
bs_martin<-cppFunction('NumericMatrix compMartin (NumericMatrix st, NumericMatrix dv, double s_0, double k,
double t, double sigma, double r, int steps, int paths, Function blacksch(fun)) {
// Ensure RNG scope set
RNGScope scope;
int min_bs_step=0;
double minbsvalue=0;
vector<double> u[0]=100.0;
for(int i=1;i<=paths; i++)
{
min_bs_step=0;
for(int j=1;j<=steps;j++)
{
if (dv[i,j]>0 && min_bs_step==0)
{
min_bs_step=i;
minbsvalue=blacksch(s_0,k,sigma,r,t);
}
else if (min_bs_step!=0)
{
dv[i,j]=1 - minbsvalue;
}
}
}
return dv;
}')
I would suggest the following:
Study our documentation and examples. We show how to pass functions around too, even if we do not recommend it (for obvious performance reason, calling R from C++ ain't speedy).
If you somewhat complex example does not work, try a smaller one. At the end of the day you may just want a tester which receives two numbers and passes those to a supplied function.
And lastly: You really want blacksch in C++ too. All the statistical functions are available under the same names.
Related
Is there a way to input a parameter (besides the seed) into a user-defined RNG in R? I understand the basics of RNGkind("user") and creating a RNG with RCPP, but I am unsure if I can defined a parameter can be used in this process. For instance, say I would want to create a function, say RNG_parameter(seed=123, multiplier=3) that simply multiplies my initialization table by a number (I wish to do more, but this example will hopefully make it easier). Essentially, this will create my user_unif_init but it will allow multiple parameters to be called. Is this possible to do? Whenever I try to create an exported function in my RCPP, it then says that: 'user_unif_rand' not in load table.
Edited: Example added (standard RNG example from Random.user)
I am looking for a way to add a parameter into a function which initializes the table, I am not sure if it can be done with user_unif_init or if I need to find another way to do it. I tried looking at Seeding a user supplied random number generator in R as similar example but RNGkind("user") wouldn't work for me when I added an exported function into the file.
#include <R_ext/Random.h>
static Int32 seed;
static double res;
static int nseed = 2;
double * user_unif_rand()
{
seed = 69069 * seed + 1;
res = seed * 2.32830643653869e-10;
return &res;
}
void user_unif_init(Int32 seed_in, int multiplier) {
seed[1]= seed_in;
seed[2]= seed_in* multiplier;
}
int * user_unif_nseed() { return &nseed; }
int * user_unif_seedloc() { return (int *) &seed; }
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
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
}
I've been thinking about it all day and still cannot figure out why this happens. My objective is simple: STEP1, generate a function S(h,p); STEP2, numerically integrate S(h,p) with respect to p by trapezoidal rule and obtain a new function SS(h). I wrote the code and source it by sourceCpp, and it successfully generated two functions S(h,p) and SS(h) in R. But when I tried to test it by calculating SS(1), R just kept running and never gave the result, which is weird because the calculation amount is not that big. Any idea why this would happen？
My code is here:
#include <Rcpp.h>
using namespace Rcpp;
//generate the first function that gives S(h,p)
// [[Rcpp::export]]
double S(double h, double p){
double out=2*(h+p+h*p);
return out;
}
//generate the second function that gives the numerically integreation of S(h,p) w.r.t p
//[[Rcpp::export]]
double SS(double h){
double out1=0;
double sum=0;
for (int i=0;i<1;i=i+0.01){
sum=sum+S(h,i);
}
out1=0.01/2*(2*sum-S(h,0)-S(h,1));
return out1;
}
The problem is that you are treating i as if it were not an int in this statement:
for (int i=0;i<1;i=i+0.01){
sum=sum+S(h,i);
}
After each iteration you are attempting to add 0.01 to an integer, which is of course immediately truncated towards 0, meaning that i is always equal to zero, and you have an infinite loop. A minimal example highlighting the problem, with a couple of possible solutions:
#include <Rcpp.h>
// [[Rcpp::export]]
void bad_loop() {
for (int i = 0; i < 1; i += 0.01) {
std::printf("i = %d\n", i);
Rcpp::checkUserInterrupt();
}
}
// [[Rcpp::export]]
void good_loop() {
for (int i = 0; i < 100; i++) {
std::printf("i = %d\n", i);
Rcpp::checkUserInterrupt();
}
}
// [[Rcpp::export]]
void good_loop2() {
for (double j = 0.0; j < 1.0; j += 0.01) {
std::printf("j = %.2f\n", j);
Rcpp::checkUserInterrupt();
}
}
The first alternative (good_loop) is to scale your step size appropriately -- looping from 0 through 99 by 1 takes the same number of iterations as looping from 0 to 0.99 by 0.01. Additionally, you could just use a double instead of an int, as in good_loop2. At any rate, the main takeaway here is that you need to be more careful about choosing your variable types in C++. Unlike R, when you declare i to be an int it will be treated like an int, not a floating point number.
As #nrussell pointed out very expertly, there is an issue with treating i as an int when the type held is a double. The goal of posting this answer is to stress the need to avoid using a double or float as a loop incrementer. I've opted to post it as an answer instead of a comment for readability.
Please note, the loop increment should not ever be given as a double or a float due to precision issues. e.g. it is hard to get i = .99 since i = 0.981111111 et cetera...
Instead, I would opt to have the loop be processed as an int and convert it to a double / float as soon as possible, e.g.
for (int i=0; i < 100; i++){
// Make sure to use double division
// (e.g. either numerator or denominator is a floating / double)
sum += S(h, i/100.0);
}
Further notes:
RcppArmadillo and C++ division issue
Using float / double as a loop variable
I have been trying to parallelize one of my Rcpp routines. In doing so I have been trying to follow the Parallel Distance Calculation example from jjalaire. Unfortunately, once I got everything coded up and started to play around, my R session would crash. Sometimes after the first execution, sometimes after the third. To be honest, it was a crap shoot as to when R would crash when I ran the routine. So, I have paired down my code to a small reproducible example to play with.
Rcpp File (mytest.cpp)
#include <Rcpp.h>
// [[Rcpp::depends(RcppParallel)]]
#include <RcppParallel.h>
using namespace std;
using namespace Rcpp;
using namespace RcppParallel;
struct MyThing : public Worker {
RVector<double> _pc;
RVector<double> _pcsd;
MyThing(Rcpp::NumericVector _pc, Rcpp::NumericVector _pcsd) : _pc(_pc), _pcsd(_pcsd){}
void operator()(std::size_t begin, std::size_t end) {
for(int j = begin; j <= end; j++) {
_pc[j] = 1;
// _pcsd[j] = 1;
}
}
};
// [[Rcpp::export]]
void calculateMyThingParallel() {
NumericVector _pc(100);
NumericVector _pcsd(100);
MyThing mt(_pc, _pcsd);
parallelFor(0, 100, mt);
}
R Compilation and Execution Script (mytest.R)
library(Rcpp)
library(inline)
sourceCpp('mytest.cpp')
testmything = function() {
calculateMyThingParallel()
}
if(TRUE) {
for(i in 1:20) {
testmything()
}
}
The error seems to be directly related to my setting of the _pc and _pcsd variables in the operator() method. If I take those out things dramatically improve. Based on the Parallel Distance Calculation example, I am not sure what it is that I have done wrong here. I was under the impression that RVector was thread safe. Although that is my impression, I know this is an issue with threads somehow. Can anybody help me to understand why the above code randomly crashes my R sessions?
For information I am running the following:
Windows 7
R: 3.1.2
Rtools: 3.1
Rcpp: 0.11.3
inline: 0.3.13
RStudio: 0.99.62
After cross-posting this question on the rcpp-devel list, a user responded and infomed me that my loop over j in the operator() method should go between begin <= j < end and not begin <= j <= end which is what I had.
I made that change and sure nuff, everything seems to be working right now.
seems like overextending ones reach past allocated memory spaces still results in unintended consequences...