在R-中模擬我怎樣才能讓它更快？

Question

我正在模擬Jim Berger的小程序 。

模擬的工作方式如下：我將從零分布N（0,1）或替代分布N（theta，1）生成大小為n的樣本x 。 我將假設零的先驗概率是某個比例prop （因此替代的先驗是1-prop ）並且替代中的theta的分布是N（0,2） （我可以改變所有這些參數） ，但這只是為了開始）。

我希望從上面描述的模擬場景中得到大量的pvalues，它們在一定的范圍內（比如2000個pvalues介於0.049和0.05之間，在模擬中這相當於z stats arround 1.96和1.97），看看有多少來了來自null，有多少來自替代品。

到目前為止，我提出了這樣的解決方案：

berger <- function(prop, n){
  z=0
  while(z<=1.96|z>=1.97){
    u <- runif(1)
    if(u<prop){
      H0 <- TRUE
      x<-rnorm(n, 0, 1)
    }else{
      H0 <- FALSE
      theta <- rnorm(1, 0, 2)
      x <- rnorm(n, theta, 1)
    }
    z <- sqrt(n)*abs(mean(x))
  }
  return(H0)
}

results<-replicate(2000, berger(0.1, 100))
sum(results)/length(results) ## approximately 25%

大約需要3.5分鍾。 有可能加快這個速度嗎？ 怎么樣？ 歡迎每一個答案，包括與C的整合。

更新 ：並行化可以加快一點點速度。 但是，我在Julia中嘗試了相同的代碼，沒有任何並行化只需要14秒（下面的代碼）。

更新2 ：使用Rcpp和並行化可以將模擬減少到8秒。 看到新的答案。

function berger(prop, n)
       z = 0 
       h0 = 0
       while z<1.96 || z > 1.97

              u = rand()

              if u < prop
                     h0 = true;
                     x = randn(n)             
              else
                     h0 = false
                     theta = randn()*2
                     x = randn(n) + theta
              end

              z = sqrt(n)*abs(mean(x))
       end

       h0
end

results = [0]

for i in 1:2000
       push!(results, berger(0.1, 100))
end

sum(results)/length(results)

Answer 1

可能有一些方法可以使這個功能更快一些（例如通過並行化），但是你不會得到數量級的差異（ 編輯 ： 在R中 ）。 關鍵問題是你正在從正態分布中獲得大約4億次抽獎。

這是通過返回運行的平均數的函數while你的函數有：

f<-function(prop,n){
  i<-0
  z<-0
  while(z<=1.96|z>=1.97){
    i<-i+1
    u <- runif(1)
    if(u<prop){
      H0 <- TRUE
      x<-rnorm(n, 0, 1)
    }else{
      H0 <- FALSE
      theta <- rnorm(1, 0, 2)
      x <- rnorm(n, theta, 1)
    }
    z <- sqrt(n)*abs(mean(x))
  }
  return(i)
}

現在我們可以計算出你的函數運行的次數：

set.seed(1)
runs<-replicate(200,f(prop=0.1, n=100))
mean(runs) # 2034
sd(runs) # 2121

因此，要計算正態分布的繪制數量：

# number of replicates
# times normal distributions per replicate
# draws from each distribution
2000*mean(runs)*100
# 406,853,000 normal distribution draws

rnorm函數調用已編譯的C函數，並且可能接近最佳速度。 您可以測試在自己的機器上進行多次繪制的“下限”：

system.time(rnorm(406853000))
# My machine:
#   user  system elapsed 
#  53.78    2.39   56.62 

相比之下，你的功能大約慢了四倍：

system.time(replicate(2000,berger(prop=0.1,n=100)))
#    user  system elapsed 
#  210.40    0.03  211.12 

所以，當你考慮它時，你的函數真的不是那么慢，特別是當你考慮到每次調用rnorm時都會有開銷。 如果提高此功能的速度非常關鍵，並且有幾個內核，則可以在R中輕松並行化：

library(parallel)
mclapply(1:2000,function(x) berger(prop=0.1,n=100))

除此之外，您可以在C中編寫一個超級優化的函數並節省幾分鍾，但它可能不值得。

Answer 2

使用Rcpp來提高速度實際上很簡單。 結合Rcpp與parellelization，我能夠將時間減少到8秒。

.cpp文件是這樣的（使用Rcpp“糖”使這個任務變得非常簡單 - 因為這是我第一次使用Rcpp，也許這個代碼不是最優的，但是它完成了工作！）：

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]


int RcppBerger(double prop, int n) {

  double z=0,theta=0, u=0;
  int h = 0;
  NumericVector x;
    while (z<1.96 || z > 1.97){
      u = R::runif(0, 1);
      if(u < prop){
        h = 1;
        x = rnorm(n);
        }else{
          h = 0;
          theta = R::rnorm(0, 2);
          x = rnorm(n, theta, 1);
          }
          z = sqrt(n)*mean(x);
          if(z<0){z = -1*z;};
    }
  return h;
}

然后，在沒有並行化的情況下，您可以只使用sourceCpp函數，並且RcppBerger將在工作區中可用：

library(Rcpp)
sourceCpp("RcppBerger.cpp")
results<-replicate(2000, RcppBerger(0.1, 100))
sum(results)/length(results) ## approximately 25%

這已經將時間從3.5分鍾縮短到40秒左右。 之后我們可以並行化。

在Windows中，這有點棘手，似乎你必須先創建一個包。 但是Rcpp提供了一個很好的功能來做Rcpp.package.skeleton 。 只需將源文件放入其中，它將創建所有必要的文檔和文件夾：

Rcpp.package.skeleton("RcppBerger", cpp_files = "RcppBerger.cpp")

然后，在安裝包之后，您可以與foreach和doParallel並行doParallel ：

library(foreach)
library(doParallel)
library(RcppBerger)
registerDoParallel(cores=8)
results<- foreach(1:2000, .packages="RcppBerger") %dopar% RcppBerger(0.1, 100)

現在模擬只需8秒鍾。