On 20 September 2011 at 10:26, Alireza Mahani wrote:
 I have a function in R that takes another function as argument:

 f < function(g, ...) { #g is expected to be a function
 }

 I want to see if there is a way to implement "f" in C and calling it from R
 using ".C" interface. I know that I can use function pointers for my C
 implementation, but I imagine it's going to be nearly impossible to pass a
 function from R to C. Are there any exact or approximate solutions
 available?
Yes you can  using .Call() with can receive/return SEXPtyped variable, and
you can use an external pointer wrapped up in a SEXP. The standard C API to
R supports it.
Now, Romain and I argue that the Rcpp interface for C++ makes it easier.
So what I am showing you now uses C++. You could do all that in C as well,
but you'd need to add a lot more handholding code which we hide behind the
C++ type system.
To keep this concrete, I have a full example in the Rcppusing variant of
DEoptim, the RcppDE package which is on CRAN and RForge. Here are some core
pieces of what demo(CompiledBenchmark) does:
R function:
Wild < function(x) { ## 'Wild' function, global minimum at about 15.81515
sum(10 * sin(0.3 * x) * sin(1.3 * x^2) + 0.00001 * x^4 + 0.2 * x + 80)/length(x)
}
C++ variant of same function:
double wild(SEXP xs) {
Rcpp::NumericVector x(xs);
int n = x.size();
double sum = 0.0;
for (int i=0; i<n; i++) {
sum += 10 * sin(0.3 * x[i]) * sin(1.3 * x[i]*x[i]) + 0.00001 * x[i]*x[i]*x[i]*x[i] + 0.2 * x[i] + 80;
}
sum /= n;
return(sum);
}
and the key is then to (using the inline package, wrapping C++ code) create
an external pointer object (using the Rcpp::XPtr type) pointing at this C++
function just shown (and the real version does this for three different
functions with a switch, but the essence is just this):
## now via a class returning external pointer
src.xptr < 'return(XPtr<funcPtr>(new funcPtr(&wild)));'
create_xptr < cxxfunction(signature(funname="character"), body=src.xptr, inc=inc, plugin="Rcpp")
Calling create_xptr() in R gives us the XPtr in R  and there we just pass
it down to the optimising function which then has a simple switch on the type
it receives to see whether it evaluates an R function, or a C++ function. So
in the C++ function implementing the inner core of the optimisation (in
devol.cpp), we do
if (TYPEOF(fcall) == EXTPTRSXP) { // nonstandard mode: we are being passed an external pointer
ev = new Rcpp::DE::EvalCompiled(fcall); // so assign a pointer using external pointer in fcall SEXP
} else { // standard mode: env_ is an env, fcall_ is a function
ev = new Rcpp::DE::EvalStandard(fcall, rho); // so assign R function and environment
}
and that simple branches between two cases of evaluator helper class.
To evaluate the R function at the C++ level we do
double eval(SEXP par) {
neval++;
return defaultfun(par);
}
with
double defaultfun(SEXP par) { // essentialy same as the old evaluate
SEXP fn = ::Rf_lang3(fcall, par, R_DotsSymbol);
SEXP sexp_fvec = ::Rf_eval(fn, env);
double f_result = REAL(sexp_fvec)[0];
if (ISNAN(f_result))
::Rf_error("NaN value of objective function! \nPerhaps adjust the bounds.");
return(f_result);
}
whereas to evaluate the C++ function passed in, we do
EvalCompiled( SEXP xps ) { // get funptr from external pointer
Rcpp::XPtr<funcPtr> xptr(xps);
funptr = *(xptr);
};
double eval(SEXP par) {
neval++;
return funptr(par);
}
This can probably be refined further, as it was mostly just one big proof of
concept. But it works fine, do
library(RcppDE)
demo(CompiledBenchmark)
and several RvsC++ comparison of objective funtions should be timed for you.
If you're interested, we're always happy to take on Rcppspecific questions
on the rcppdevel list.
Hope this helps, Dirk

New Rcpp master class for R and C++ integration is scheduled for
San Francisco (Oct 8), more details / reg.info available at
http://www.revolutionanalytics.com/products/training/public/rcppmasterclass.php______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/rdevel