[Rcpp-devel] Passing an exposed function to another C++ function as a parameter

Dear all,

I'm rewriting the AMORE package using Rcpp --- in fact it's more like
I'm having a lot of fun while rewriting the AMORE package thanks to Rcpp.
Nevertheless, I'm facing this little problem that I hope it would be
pretty easy for you to solve.

Let's consider the C++ function Tanh_f0

double

Tanh_f0(double inducedLocalField)

  {

    return tanh(inducedLocalField);

  }


After compilation using inline, Tanh_f0 is exposed to R using Module
and accessible through actMod$Tanh_f0


actMod$Tanh_f0(0.1)

# [1] 0.09966799


Now, I want to pass actMod$Tanh_f0 as a parameter of a function in
order to use the original C++ function Tanh_f0.



testCode <- ' Rcpp::Function fx (myfun);

double result = as<double>(fx(x));

return wrap( result );

'

usingTanhf0 <- cfunction(sig=signature(myfun="function", x="numeric"),
body=testCode,?)


And that indeed works, but when compared to using a simple tanh
function it shows quite a bad performance.



testCode <- ' double value = as<double>(x);

double result = tanh(value);

return wrap( result );

'


usingTanh <- cfunction(sig=signature(x="numeric"), body=testCode, ? )

benchmark(usingTanhf0(myfun=actMod$Tanh_f0, x=0.1) , usingTanh(
x=0.1), columns=c("test", "replications", "elapsed", "relative"),
order="relative", replications=1000)

#                                           test replications elapsed
relative

# 2                           usingTanh(x = 0.1)         1000   0.004
      1

# 1 usingTanhf0(myfun = actMod$Tanh_f0, x = 0.1)         1000   0.080
      20


Looks like having to go the R way to get access to Tanh_f0 has a high
cost. In order to be faster, it would be great if I could have access
to the original Tanh_f0 which I guess is pointed to by
 actMod$Tanh_f0, may be at the address 0x100153d30 ?


actMod$Tanh_f0

# internal C++ function <0x100153d30>

#     signature : double Tanh_f0(double)


After having had a look at RppDE sources, I guess the solution would
be to pass the function as an external pointer; something like :

testCode <- '

typedef double (*funPtr)(double) ;

Rcpp::XPtr<  funPtr > fx (myfun);

double result = (*fx)(0.1);

return wrap( result );

'

testCodefun <- cfunction(sig=signature(myfun="C++Function"),
body=testCode,?)

result <- testCodefun(myfun=actMod$Tanh_f0)


But this does NOT work and crashes R.

Any hints?

Thank you for your patience in reading such long message!
Manuel