r语言 - 加速Rcpp ' anyNA '等效



这个问题与这个老问题和这个老问题有关。

R具有很好的包装函数anyNA,可以更快地求出any(is.na(x))。当在Rcpp中工作时,可以通过以下方式给出类似的最小实现:

// CharacterVector example
#include <Rcpp.h>
using namespace Rcpp;
template<typename T, typename S>
bool any_na(S x){
T xx = as<T>(x);
for(auto i : xx){
if(T::is_na(i))
return true;
}
return false;
}
// [[Rcpp::export(rng = false)]]
LogicalVector any_na(SEXP x){
return any_na<CharacterVector>(x);
}
// [[Rcpp::export(rng = false)]]
SEXP overhead(SEXP x){
CharacterVector xx = as<CharacterVector>(x);
return wrap(xx);
}
/***R
library(microbenchmark)
vec <- sample(letters, 1e6, TRUE)
vec[1e6] <- NA_character_
any_na(vec)
# [1] TRUE
*/

但是将此性能与anyNA进行比较,我对

下面的基准测试感到惊讶
library(microbenchmark)
microbenchmark(
Rcpp = any_na(vec), 
R = anyNA(vec),
overhead = overhead(vec), 
unit = "ms"
)
Unit: milliseconds
expr      min        lq     mean    median       uq      max neval cld
Rcpp 2.647901 2.8059500 3.243573 3.0435010 3.675051 5.899100   100   c
R 0.800300 0.8151005 0.952301 0.8577015 0.961201 3.467402   100  b 
overhead 0.001300 0.0029010 0.011388 0.0122510 0.015751 0.048401   100 a  

,其中最后一行是"从SEXPCharacterVector来回转换产生的(结果可以忽略不计)。显而易见,Rcpp版本大约比R版本慢3.5倍。我很好奇,所以我检查了Rcpp的is_na的源代码,发现没有明显的原因导致性能缓慢,我继续检查anyNA的源代码,以获取R自己的字符向量,并使用R的C API思想重新实现该函数,以加速此

// Added after SEXP overhead(SEXP x){ --- }
inline bool anyNA2(SEXP x){
R_xlen_t n = Rf_length(x);
for(R_xlen_t i = 0; i < n; i++){
if(STRING_ELT(x, i) == NA_STRING)
return true;
}
return false;
}
// [[Rcpp::export(rng = false)]]
SEXP any_na2(SEXP x){
bool xx = anyNA2(x);
return wrap(xx);
}
// [[Rcpp::export(rng = false)]]
SEXP any_na3(SEXP x){
Function anyNA("anyNA");
return anyNA(x);
}
/***R
microbenchmark(
Rcpp = any_na(vec), 
R = anyNA(vec),
R_C_api = any_na2(vec),
Rcpp_Function = any_na3(vec),
overhead = overhead(vec),
unit = "ms"
)
# Unit: milliseconds
# expr      min        lq       mean    median       uq      max neval  cld
# Rcpp 2.654901 2.8650515 3.54936501 3.2392510 3.997901 8.074201   100    d
# R 0.803701 0.8303015 1.01017200 0.9400015 1.061751 2.019902   100  b
# R_C_api 2.336402 2.4536510 3.01576302 2.7220010 3.314951 6.905101   100   c
# Rcpp_Function 0.844001 0.8862510 1.09259990 0.9597505 1.120701 3.011801   100  b
# overhead 0.001500 0.0071005 0.01459391 0.0146510 0.017651 0.101401   100 a
*/

注意,我还包含了一个简单的包装器,调用anyNARcpp::Function。再说一次,anyNA的实现不仅仅是一点点,而是很多比基本实现慢。

所以问题变成了两倍:

  1. 为什么Rcpp这么慢?
  2. 源自1:这怎么可能被"改变"?加快编码速度?

这些问题本身并不是很有趣,但如果它影响了Rcpp实现的多个部分,这些部分可能会总体上获得显著的性能提升,那就有趣了。

<标题>SessonInfo ()
sessionInfo()
R version 4.0.3 (2020-10-10)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19042)
Matrix products: default
locale:
[1] LC_COLLATE=English_Denmark.1252  LC_CTYPE=English_Denmark.1252    LC_MONETARY=English_Denmark.1252 LC_NUMERIC=C                     LC_TIME=English_Denmark.1252    
attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     
other attached packages:
[1] microbenchmark_1.4-7    cmdline.arguments_0.0.1 glue_1.4.2              R6_2.5.0                Rcpp_1.0.6             
loaded via a namespace (and not attached):
[1] codetools_0.2-18 lattice_0.20-41  mvtnorm_1.1-1    zoo_1.8-8        MASS_7.3-53      grid_4.0.3       multcomp_1.4-15  Matrix_1.2-18    sandwich_3.0-0   splines_4.0.3   
[11] TH.data_1.0-10   tools_4.0.3      survival_3.2-7   compiler_4.0.3  

编辑(不只是windows的问题):

我想确定这不是一个"Windows问题"。所以我在运行linux的Docker容器中执行了这个问题。结果如下所示,非常相似

# Unit: milliseconds
#           expr    min      lq     mean  median      uq     max neval
#           Rcpp 2.3399 2.62155 4.093380 3.12495 3.92155 26.2088   100
#              R 0.7635 0.84415 1.459659 1.10350 1.42145 12.1148   100
#        R_C_api 2.3358 2.56500 3.833955 3.11075 3.65925 14.2267   100
#  Rcpp_Function 0.8163 0.96595 1.574403 1.27335 1.56730 11.9240   100
#       overhead 0.0009 0.00530 0.013330 0.01195 0.01660  0.0824   100

会话信息:

sessionInfo()
R version 4.0.2 (2020-06-22)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 20.04 LTS
Matrix products: default
BLAS/LAPACK: /usr/lib/x86_64-linux-gnu/openblas-openmp/libopenblasp-r0.3.8.so
locale:
[1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C
[3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8
[5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=C
[7] LC_PAPER=en_US.UTF-8       LC_NAME=C
[9] LC_ADDRESS=C               LC_TELEPHONE=C
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base
other attached packages:
[1] microbenchmark_1.4-7 Rcpp_1.0.5
loaded via a namespace (and not attached):
[1] compiler_4.0.2 tools_4.0.2

这是一个有趣的问题,但答案很简单:STRING_ELT有两个版本,一个是R内部使用的,或者如果你在Rinlinedfuns.h中设置USE_RINTERNALS宏,一个是memory.c中的plebs。

比较两个版本,您可以看到pleb版本有更多的检查,这完全说明了速度的差异。

如果你真的想要速度而不关心安全,你通常可以至少比R快一点点。

// [[Rcpp::export(rng = false)]]
bool any_na_unsafe(SEXP x) {
SEXP* ptr = STRING_PTR(x);
R_xlen_t n = Rf_xlength(x);
for(R_xlen_t i=0; i<n; ++i) {
if(ptr[i] == NA_STRING) return true;
}
return false;
}

板凳:

> microbenchmark(
+   R = anyNA(vec),
+   R_C_api = any_na2(vec),
+   unsafe = any_na_unsafe(vec),
+   unit = "ms"
+ )
Unit: milliseconds
expr    min      lq     mean  median      uq     max neval
R 0.5058 0.52830 0.553696 0.54000 0.55465  0.7758   100
R_C_api 1.9990 2.05170 2.214136 2.06695 2.10220 12.2183   100
unsafe 0.3170 0.33135 0.369585 0.35270 0.37730  1.2856   100

虽然这样写是不安全的,但如果在循环开始前添加一些检查,就可以了。

这个问题很好地说明了为什么有些人对微基准测试大发牢骚。

Baseline是一个内置的原语

这里应该被击败的函数实际上是一个基本的所以这已经有点棘手了

> anyNA
function (x, recursive = FALSE)  .Primitive("anyNA")
> 

ALTREP设置性能下限

接下来,一个小实验表明,基线函数anyNA()永远不会循环。我们定义了一个很短的向量srt和一个很长的向量lng,它们都包含一个NA值。结果……R通过ALTREP进行优化,在数据结构头中保留匹配位,并且检查的成本与长度:

无关。
> srt <- c("A",NA_character_); lng <- c(rep("A", 1e6), NA_character_)
> microbenchmark(short=function(srt) { anyNA(srt) }, 
+                long=function(lng) { anyNA(lng) }, times=1000)
Unit: nanoseconds
expr min lq   mean median uq   max neval cld
short  48 50 69.324     51 53  5293  1000   a
long  48 50 92.166     51 52 15494  1000   a
> 

注意这里的单位(纳秒)和花费的时间。我们正在测量单个比特

(编辑:删掉那个。我的想法很匆忙,请看评论

Rcpp函数有一些小的开销

这不是新的,也没有文档记录。如果您查看由Rcpp Attributes生成的代码,它方便地为我们提供了一个与我们指定的c++函数同名的R函数,您会发现至少涉及到一个其他函数调用。加上一个内置的try/catch层,RNG设置(这里关闭)等等。它不可能是零,而且如果对任何合理的进行平摊它在测量中都不会出现

然而,这里的练习被设置为匹配查找一个位的原始函数。这是一场谁也赢不了的比赛。这是我的最终表格

> microbenchmark(anyNA = anyNA(vec), Rcpp_plain = rcpp_c_api(vec), 
+     Rcpp_tmpl = rcpp_any_na(vec), Rcpp_altrep = rcpp_altrep(vec), 
+     times = .... [TRUNCATED] 
Unit: microseconds
expr      min      lq     mean   median      uq      max neval  cld
anyNA  643.993  658.43  827.773  700.729  819.78  6280.85  5000 a   
Rcpp_plain 1916.188 1952.55 2168.708 2022.017 2191.64  8506.71  5000    d
Rcpp_tmpl 1709.380 1743.04 1933.043 1798.788 1947.83  8176.10  5000   c 
Rcpp_altrep 1501.148 1533.88 1741.465 1590.572 1744.74 10584.93  5000  b

它包含原始的R函数,原始的(模板化的)c++函数,看起来仍然很好,使用Rcpp(和它的小开销),只使用C API(加上自动包装入/出)稍微慢一点——然后比较Michel的checkmate包中的一个函数,确实查看ALTREP位。而且它也只是稍微快一点。

所以我们在这里真正看到的是函数调用的开销,它妨碍了度量微操作。所以,不,Rcpp不能比高度优化的原语更快。这个问题看起来很有趣,但说到底,还是有些不恰当。有时候,克服这些困难是值得的。

我的代码版本如下:

// CharacterVector example
#include <Rcpp.h>
using namespace Rcpp;
template<typename T, typename S>
bool any_na(S x){
T xx = as<T>(x);
for (auto i : xx){
if (T::is_na(i))
return true;
}
return false;
}
// [[Rcpp::export(rng = false)]]
LogicalVector rcpp_any_na(SEXP x){
return any_na<CharacterVector>(x);
}
// [[Rcpp::export(rng = false)]]
SEXP overhead(SEXP x){
CharacterVector xx = as<CharacterVector>(x);
return wrap(xx);
}
// [[Rcpp::export(rng = false)]]
bool rcpp_c_api(SEXP x) {
R_xlen_t n = Rf_length(x);
for (R_xlen_t i = 0; i < n; i++) {
if(STRING_ELT(x, i) == NA_STRING)
return true;
}
return false;
}
// [[Rcpp::export(rng = false)]]
SEXP any_na3(SEXP x){
Function anyNA("anyNA");
return anyNA(x);
}
// courtesy of the checkmate package
// [[Rcpp::export(rng=false)]]
R_xlen_t rcpp_altrep(SEXP x) {
#if defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0)
if (STRING_NO_NA(x))
return 0;
#endif
const R_xlen_t nx = Rf_xlength(x);
for (R_xlen_t i = 0; i < nx; i++) {
if (STRING_ELT(x, i) == NA_STRING)
return i + 1;
}
return 0;
}

/***R
library(microbenchmark)
srt <- c("A",NA_character_)
lng <- c(rep("A", 1e6), NA_character_)
microbenchmark(short = function(srt) { anyNA(srt) },
long = function(lng) { anyNA(lng) },
times=1000)
N <- 1e6
vec <- sample(letters, N, TRUE)
vec[N] <- NA_character_
anyNA(vec)                      # to check

microbenchmark(
anyNA       = anyNA(vec),
Rcpp_plain  = rcpp_c_api(vec),
Rcpp_tmpl   = rcpp_any_na(vec),
Rcpp_altrep = rcpp_altrep(vec),
#Rcpp_Function = any_na3(vec),
#overhead = overhead(vec),
times = 5000
#  unit="relative"
)
*/

最新更新