Question

我正在模拟类似Jim Berger's applet的内容。

模拟的工作方式如下：我将从空分布 N（0,1）或替代分布<生成大小为x的样本n strong> N（theta，1）。我将假设null的先验概率是某个比例prop（因此替代的先验是1-prop）并且替代中的theta的分布是 N（0,2）（我可以改变所有这些参数，但这只是为了开始）。

我希望从上面描述的模拟场景中得到大量的pvalues（在0.049和0.05之间的2000 pvalues，在模拟中这相当于z stats arround 1.96和1.97），并且看到有多少来自零，有多少来自另类。

到目前为止，我提出了这样的解决方案：

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函数，并且可能接近最佳速度。你可以测试＆＃34;下界＆＃34;在你自己的机器上进行多次绘制：

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“sugars”把这个任务变得非常简单 - 因为这是我第一次使用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并行化：

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

现在模拟只需8秒钟。

在R-中模拟我怎样才能让它更快？

2 个答案: