使用Rcpp中其他包的C函数

Question

我正在尝试从c ++函数中的cubature包调用C例程来执行多维集成.

我试图重现的基本R例子是

library(cubature)
integrand <- function(x) sin(x)
adaptIntegrate(integrand, 0, pi)

我可以从图库中按照这个配方从Rcpp调用这个R函数,但是从c/c ++到R来回切换会有一些性能损失.从C++直接调用C函数似乎更合理.

C例程adapt_integrate从出口cubature与

 // R_RegisterCCallable("cubature", "adapt_integrate", (DL_FUNC) adapt_integrate);

但是,我不明白如何从c ++中调用它.这是我的蹩脚尝试,

sourceCpp(code = '
#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
double integrand(double x){
 return(sin(x));
}

// [[Rcpp::depends(cubature)]]
// [[Rcpp::export]]
Rcpp::List integratecpp(double llim, double ulim)
{
  Rcpp::Function p_cubature = R_GetCCallable("cubature", "adapt_integrate");

  Rcpp::List result = p_cubature(integrand, llim, ulim);
  return(result);
}
'
)

integratecpp(0, pi)

这无法编译; 显然,我正在做一些非常愚蠢的事情,并且缺少一些重要的步骤来将输出R_GetCCallable转换为Rcpp::Function(或直接调用它？).我已经阅读了几篇涉及函数指针的相关文章,但还没有看到使用外部C函数的示例.

Answer 1

遗憾的是cubature,不会发送标题inst/include,因此您必须从它们那里借用它并在代码中执行以下操作:

typedef void (*integrand) (unsigned ndim, const double *x, void *,
           unsigned fdim, double *fval);

int adapt_integrate(
    unsigned fdim, integrand f, void *fdata,
    unsigned dim, const double *xmin, const double *xmax, 
    unsigned maxEval, double reqAbsError, double reqRelError, 
    double *val, double *err)
{
    typedef int (*Fun)(unsigned,integrand,void*,unsigned,
        const double*,const double*, unsigned, double, double, double*, double*) ;
    Fun fun = (Fun) R_GetCCallable( "cubature", "adapt_integrate" ) ;           
    return fun(fdim,f,fdata,dim,xmin,xmax,maxEval,reqAbsError, reqRelError,val,err); 
}

与维护人员进行交谈可能是一个好主意,cubature因为他inst/include只需要使用声明LinkingTo.

Answer 2

之前没看到这个问题，看来@Romain 已经解决了。

为完整起见，xts和RcppXts包提供了当所有各方都参与时如何执行此操作的工作示例。在 中xts，我们在（源）文件中执行此操作（对于大约十个函数）inst/include/xtsAPI.h：

SEXP attribute_hidden xtsLag(SEXP x, SEXP k, SEXP pad) {     
    static SEXP(*fun)(SEXP,SEXP,SEXP) = NULL;         
    if (fun == NULL)                                  
        fun = (SEXP(*)(SEXP,SEXP,SEXP)) R_GetCCallable("xts","lagXts");   
    return fun(x, k, pad);                               
}  

除了通常的业务R_registerRoutines和R_RegisterCCallable。

在RcppXts这被拾取（在 Rcpp 模块中）作为

function("xtsLag", 
         &xtsLag,    
         List::create(Named("x"), Named("k"), Named("pad")),   
         "Extract the coredata from xts object");

效果很好。有人斥责我要写xts得更紧凑（因为这if NULL是虚假的），我将......最终。