Вызов функции Р из С оберткой

Question

У меня есть функция, например, так:

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

f может быть (например) f <- function (x) x. Чтобы упростить ситуацию, скажем, что я знаю, что f должен возвращать числовое число и принимать один числовой.

Я хотел бы перейти callFunc С, но по-прежнему имеют функцию f определены в R, то есть

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

Я изо всех сил с тем, как оценить свою функцию обратного вызова на стороне C. я его, как это на данный момент:

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

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

(Затем, чтобы проверить это:

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

)

Конечно, выше не работает, потому что

• Я не принуждал i_func к соответствующей форме закрытия; Я не уверен, как это сделать (есть AS_foo макросов в Rdefines.h, но нет AS_CLOSURE).
• Я даже не сказал код C, что i_func должен принимать числовое значение и возвращать числовое значение, так как он может даже оценить?

Может ли кто-нибудь дать мне указания о том, как это сделать? Я прокладываю себе путь через writing R extensions, но это довольно долго, и я еще не нашел то, что мне нужно. Также есть this question on R-help, но ответ выглядит так: они также внедрили обратный вызов f в C, а не оставляли его как объект R.

Answer 1

Это очень легко с Rcpp:

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

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

Answer 2

Для полноты, вот как вы могли бы сделать это без Rcpp (я взял реплику из пакета XML, который позволяет обеспечить обработчики). Вы строите вызов (первым аргументом является функция как SEXP, последующие аргументы - аргументы функции, все SEXP) и используют 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);    
} 

От R:

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