是否有一种有效的并行化mapply方法？

Question

我有很多行,每行都计算出非线性函数的uniroot.我有一个四核Ubuntu机器,它已经两天没有停止运行我的代码了.毫不奇怪,我正在寻找加快速度的方法;-)

经过一些研究,我注意到目前只使用了一个核心,并且可以进行并行化.深入挖掘,我得出的结论(可能是错误的？)包装foreach并不是真正意义上的问题,因为产生了太多的开销(例如,参见SO).multicore对于Unix机器来说,一个很好的替代方案.特别是,在pvec检查帮助页面后,该功能似乎是最有效的功能.

但是,如果我理解正确,此函数只需要一个向量并相应地将其拆分.我需要一个可以并行化的函数,但需要多个向量(或者data.frame代替),就像mapply函数一样.我错过了什么吗？

这是我想要做的一个小例子:(请注意,我plyr在这里包含一个示例,因为它可以替代基本mapply函数,并且它有一个并行化选项.但是,它在我的实现和内部调用较慢,它调用foreach并行化,所以我认为它无济于事.这是正确的吗？)

library(plyr)
library(foreach)
n <- 10000
df <- data.frame(P   = rnorm(n, mean=100, sd=10),
                 B0  = rnorm(n, mean=40,  sd=5),
                 CF1 = rnorm(n, mean=30,  sd=10),
                 CF2 = rnorm(n, mean=30,  sd=5),
                 CF3 = rnorm(n, mean=90,  sd=8))

get_uniroot <- function(P, B0, CF1, CF2, CF3) {

  uniroot(function(x) {-P + B0 + CF1/x + CF2/x^2 + CF3/x^3}, 
          lower = 1,
          upper = 10,
          tol   = 0.00001)$root

}

system.time(x1 <- mapply(get_uniroot, df$P, df$B0, df$CF1, df$CF2, df$CF3))
   #user  system elapsed 
   #0.91    0.00    0.90 
system.time(x2 <- mdply(df, get_uniroot))
   #user  system elapsed 
   #5.85    0.00    5.85
system.time(x3 <- foreach(P=df$P, B0=df$B0, CF1=df$CF1, CF2=df$CF2, CF3=df$CF3, .combine = "c") %do% {
    get_uniroot(P, B0, CF1, CF2, CF3)})
   #user  system elapsed 
  # 10.30    0.00   10.36
all.equal(x1, x2$V1) #TRUE
all.equal(x1, x3)    #TRUE

此外,我试图从上面的SO链接实现Ryan Thompson的函数chunkapply(只是摆脱了doMC部分,因为我无法安装它.他的例子虽然在调整他的功能之后仍然有效.)但是没有得到它上班.但是,由于它使用foreach,我认为上面提到的相同论点适用,所以我没有尝试太长时间.

#chunkapply(get_uniroot, list(P=df$P, B0=df$B0, CF1=df$CF1, CF2=df$CF2, CF3=df$CF3))
#Error in { : task 1 failed - "invalid function value in 'zeroin'"

PS:我知道我可以增加tol以减少找到uniroot所需的步骤数.但是,我已经tol尽可能地设置了.

Answer 1

我将使用parallelR 2.14中内置的包并使用矩阵.你可以简单地使用mclapply这样:

dfm <- as.matrix(df)
result <- mclapply(seq_len(nrow(dfm)),
          function(x) do.call(get_uniroot,as.list(dfm[x,])),
          mc.cores=4L
          )
unlist(result)

这基本上是做同样的mapply,但是以并行的方式.

但...

请注意,并行化总是需要一些开销.正如我在您链接到的问题中所解释的那样,如果您的内部函数计算的时间明显长于所涉及的开销,那么并行只会得到回报.在您的情况下,您的uniroot功能非常快.然后,您可以考虑在更大的块中剪切数据框,并将mapply和mclapply结合起来.一种可能的方法是:

ncores <- 4
id <- floor(
        quantile(0:nrow(df),
                 1-(0:ncores)/ncores
        )
      )
idm <- embed(id,2)

mapply_uniroot <- function(id){
  tmp <- df[(id[1]+1):id[2],]
  mapply(get_uniroot, tmp$P, tmp$B0, tmp$CF1, tmp$CF2, tmp$CF3)
}
result <-mclapply(nrow(idm):1,
                  function(x) mapply_uniroot(idm[x,]),
                  mc.cores=ncores)
final <- unlist(result)

这可能需要一些调整,但它基本上会破坏你的df与核心一样多的位,并在每个核心上运行mapply.为了证明这一点:

> x1 <- mapply(get_uniroot, df$P, df$B0, df$CF1, df$CF2, df$CF3)
> all.equal(final,x1)
[1] TRUE