矢量Rcpp随机二项式绘制

时间:2015-04-03 10:47:53

标签: r rcpp

这是以下问题的后续问题:Generating same random variable in Rcpp and R

我试图加快对这种形式的rbinom的矢量化调用:

    x <- c(0.1,0.4,0.6,0.7,0.8)
    rbinom(length(x),1 ,x)

在x的实时代码中是一个可变长度的向量(但通常以百万为单位编号)。我没有Rcpp的经验,但我想知道我可以使用Rcpp来加快速度。从链接的问题来看,这个Rcpp代码被建议用于@Dirk Eddelbuettel的非矢量化rbinom调用:

    cppFunction("NumericVector cpprbinom(int n, double size, double prob) { \
         return(rbinom(n, size, prob)); }")
    set.seed(42); cpprbinom(10, 1, 0.5)

....并且速度是非Rcpp选项的两倍,但无法处理我的矢量化版本

    cpprbinom(length(x), 1, x)

如何修改Rcpp代码以实现此目的?

由于

2 个答案:

答案 0 :(得分:7)

遵循Dirk的回复here

  
    

有没有一种方法可以在不使用显式循环的情况下修复代码     在C ++代码中?

  
     

我不这么认为。该代码目前有这种硬连线:&lt; ...&gt;所以   直到我们中的一个人有足够的[时间]来扩展它(并测试它)   在你的最后做循环。

这是我实施的一个&#34; vectorised&#34;代码:

library(Rcpp)
cppFunction("NumericVector cpprbinom(int n, double size, NumericVector prob) { 
    NumericVector v(n);            
    for (int i=0; i<n; i++) {v[i] = as<double>(rbinom(1, size, prob[i]));} 
    return(v); }")
r <- runif(1e6)
all.equal({set.seed(42); rbinom(length(r), 1, r)}, 
          {set.seed(42); cpprbinom(length(r), 1, r)})
#TRUE

但问题是(再次引用Dirk),

  

我建议在花费大量精力之前先检查一下   你是否可能比R函数rbinom做得更好。那   R函数在C代码中被矢量化,你不太可能做到   使用Rcpp要快得多,除非你想使用随机变量   在另一个C ++函数中。

它实际上速度较慢(我机器上的x3),所以至少这样天真的实现并没有帮助:

library(microbenchmark)
microbenchmark(rbinom(length(r), 1, r), cpprbinom(length(r), 1, r))

Unit: milliseconds
                       expr       min        lq      mean    median        uq       max neval
    rbinom(length(r), 1, r)  55.50856  56.09292  56.49456  56.45297  56.65897  59.42524   100
 cpprbinom(length(r), 1, r) 117.63761 153.37599 154.94164 154.29623 155.37247 225.56535   100

编辑:根据Romain的评论,这里是一个高级版本,速度更快!

cppFunction(plugins=c("cpp11"), "NumericVector cpprbinom2(int n, double size, NumericVector prob) { 
    NumericVector v = no_init(n);
    std::transform( prob.begin(), prob.end(), v.begin(), [=](double p){ return R::rbinom(size, p); }); 
    return(v);}")
r <- runif(1e6)
all.equal({set.seed(42); rbinom(length(r), 1, r)}, 
          {set.seed(42); cpprbinom(length(r), 1, r)}, 
          {set.seed(42); cpprbinom2(length(r), 1, r)})
#TRUE
microbenchmark(rbinom(length(r), 1, r), cpprbinom(length(r), 1, r), cpprbinom2(length(r), 1, r))

Unit: milliseconds
                        expr       min        lq      mean    median        uq       max neval
     rbinom(length(r), 1, r)  55.26412  56.00314  56.57814  56.28616  56.59561  60.01861   100
  cpprbinom(length(r), 1, r) 113.72513 115.94758 122.81545 117.24708 119.95134 168.47246   100
 cpprbinom2(length(r), 1, r)  36.67589  37.12182  38.95318  37.37436  37.97719  84.73516   100

答案 1 :(得分:4)

不是一般解决方案,但我注意到您在调用size时将rbinom参数设置为1。如果情况总是如此,您可以绘制length(x)统一值,然后与x进行比较。例如:

 set.seed(123)
 #create the values
 x<-runif(1000000)
 system.time(res<-rbinom(length(x),1 ,x))   
 # user  system elapsed 
 #0.068   0.000   0.070
 system.time(res2<-as.integer(runif(length(x))<x))   
 # user  system elapsed 
 #0.044   0.000   0.046

不是一个巨大的收获,但如果从C ++调用runif,也许可以节省一些时间,避免一些开销。

相关问题