CODEWITHSUNDEEP
r
mathematical.coffee
mathematical.coffee

Reputation: 56905

Call R function from C wrapper

I have a function like so:

callFunc <- function (f) {
    f(1)
}

f could be (for example) f <- function (x) x. To simplify things, let's say that I know that f should return a numeric and take in a single numeric.

I'd like to move callFunc to C, but still have the function f defined in R, i.e.

.Call('callFunc', function (x) x)

I'm struggling with how to evaluate my callback on the C side. I have it like this at the moment:

#include <R.h>
#include <Rdefines.h>

SEXP callFunc (SEXP i_func) {
    return i_func(1);
}

(Then to test it:

R CMD SHLIB test.c
# then in R
dyn.load('test.so'); .Call('callFunc', function (x) x)

)

Of course, the above does not work because

Could anyone give me pointers on how to go about doing this? I'm working my way through writing R extensions but this is rather long and I haven't found what I'm after yet. Also there is this question on R-help but the answer looks like they implemented the callback f in C as well, rather than leaving it as an R object.

Upvotes: 5

Views: 361

Answers (2)

mathematical.coffee
mathematical.coffee

Reputation: 56905

For completeness, here is how you'd do it without Rcpp (I took my cue from the XML package, which lets you provide handlers). You construct a call (first argument is the function as a SEXP, subsequent arguments are the function arguments, all SEXP) and use eval.

// takes a callback and evaluates it (with argument 1), returning the result.   
SEXP callFunc(SEXP func) {                                      
    SEXP call, ans;                                              

    PROTECT(call = allocVector(LANGSXP, 2)); // call + arg       

    SEXP c;                                                      
    c = call;                                                    

    SETCAR(call, func);                                          
    c = CDR(c);                                                  

    // for some reason if I just SETCDR(c, ScalarReal(1.0)) I get
    // a memory fault, but using SETCAR like this is fine. 
    SETCAR(c, ScalarReal(1.0));                      

    ans = eval(call, R_GlobalEnv);  // maybe PROTECT?
    UNPROTECT(1);             

    return(ans);              
}

From R:

.Call('callFunc', function (x) sin(x))

Upvotes: 3

hadley
hadley

Reputation: 103898

This is very easy with Rcpp:

Rcpp::cppFunction("SEXP callFun(Function f) {
  return f(1);
}")

callFun(function(x) x + 10)
# [1] 11

Upvotes: 3

Related Questions