Rcpp函数比Rf_eval慢

时间:2016-06-15 20:19:49

标签: r rcpp

我一直致力于使用Rcpp在一组大型医学成像文件上应用任意R代码的软件包。我注意到我的Rcpp实现比原始的纯C版本慢得多。我跟踪了通过Function调用函数与原始Rf_eval的区别。我的问题是为什么有接近4倍的性能下降,有没有办法加快函数调用,使其与Rf_eval的性能更接近?

示例:

library(Rcpp)                                                                                                                                                          
library(inline)                                                                                                                                                        
library(microbenchmark)                                                                                                                                                

cpp_fun1 <-                                                                                                                                                            
  '                                                                                                                                                                    
Rcpp::List lots_of_calls(Function fun, NumericVector vec){                                                                                                             
  Rcpp::List output(1000);                                                                                                                                             
  for(int i = 0; i < 1000; ++i){                                                                                                                                       
    output[i] = fun(NumericVector(vec));                                                                                                                               
  }                                                                                                                                                                    
  return output;                                                                                                                                                       
}                                                                                                                                                                      
'                                                                                                                                                                      

cpp_fun2 <-                                                                                                                                                            
  '                                                                                                                                                                    
Rcpp::List lots_of_calls2(SEXP fun, SEXP env){                                                                                                                         
  Rcpp::List output(1000);                                                                                                                                             
  for(int i = 0; i < 1000; ++i){                                                                                                                                       
    output[i] = Rf_eval(fun, env);                                                                                                                                     
  }                                                                                                                                                                    
  return output;                                                                                                                                                       
}                                                                                                                                                                      
'                                                                                                                                                                      

lots_of_calls <- cppFunction(cpp_fun1)                                                                                                                                 
lots_of_calls2 <- cppFunction(cpp_fun2)                                                                                                                                

microbenchmark(lots_of_calls(mean, 1:1000),                                                                                                                            
               lots_of_calls2(quote(mean(1:1000)), .GlobalEnv))

结果

Unit: milliseconds
                                            expr      min       lq     mean   median       uq      max neval
                     lots_of_calls(mean, 1:1000) 38.23032 38.80177 40.84901 39.29197 41.62786 54.07380   100
 lots_of_calls2(quote(mean(1:1000)), .GlobalEnv) 10.53133 10.71938 11.08735 10.83436 11.03759 18.08466   100

2 个答案:

答案 0 :(得分:3)

Rcpp很棒,因为它让程序员看起来很荒谬 clean 。清洁度具有模板化响应和一系列假设的成本,这些假设会降低执行时间。但是,广义与特定代码设置就是这种情况。

例如Rcpp::Function的呼叫路由。初始构建然后外部调用Rf_reval的修改版本需要Rcpp_eval.h中给出的特殊Rcpp特定评估函数。反过来,当通过与其关联的Shield调用R时,此功能包含在保护中以防止功能错误。等等...

相比之下,Rf_eval没有。如果它失败了,你将在没有桨的情况下上河。 (当然,除非您implement error catching通过R_tryEval获取它。)

有了这个说法,加速计算的最好方法是在C++中简单地编写计算所需的一切。

答案 1 :(得分:2)

除了@coatless提出的观点之外,你甚至不比较苹果和苹果。您的Rf_eval示例未将向量传递给函数,更重要的是,通过quote()对函数进行操作。

总之,这有点傻。

以下是使用糖函数mean()的更完整示例。

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
List callFun(Function fun, NumericVector vec) {
  List output(1000);
  for(int i = 0; i < 1000; ++i){
    output[i] = fun(NumericVector(vec));
  }
  return output;
}

// [[Rcpp::export]]
List callRfEval(SEXP fun, SEXP env){
  List output(1000);
  for(int i = 0; i < 1000; ++i){
    output[i] = Rf_eval(fun, env);
  }
  return output;
}

// [[Rcpp::export]]
List callSugar(NumericVector vec) {
  List output(1000);
  for(int i = 0; i < 1000; ++i){
    double d = mean(vec);
    output[i] = d;
  }
  return output;
}

/*** R
library(microbenchmark)
microbenchmark(callFun(mean, 1:1000),   
               callRfEval(quote(mean(1:1000)), .GlobalEnv),
               callSugar(1:1000))
*/

你可以sourceCpp()这个:

R> sourceCpp("/tmp/ch.cpp")

R> library(microbenchmark)

R> microbenchmark(callFun(mean, 1:1000), 
+                callRfEval(quote(mean(1:1000)), .GlobalEnv),
+                callSugar(1:1000))
Unit: milliseconds
                                        expr      min       lq     mean   median       uq       max neval
                       callFun(mean, 1:1000) 14.87451 15.54385 18.57635 17.78990 18.29127 114.77153   100
 callRfEval(quote(mean(1:1000)), .GlobalEnv)  3.35954  3.57554  3.97380  3.75122  4.16450   6.29339   100
                           callSugar(1:1000)  1.50061  1.50827  1.62204  1.51518  1.76683   1.84513   100
R>