r - 有没有一种有效的方法来并行化mapply？

Question

我有很多行，每行我都会计算一个非线性函数的单根。我有一台四核Ubuntu计算机，现在已经两天没有停止运行我的代码了。毫不奇怪，我正在寻找加快速度的方法;-)

经过一番研究，我注意到当前仅使用一个内核，而并行化是要做的事情。深入研究，我得出结论(也许是错误的？)，因为产生了过多的开销，所以foreach包并不是真正针对我的问题的意思(例如，参见SO)。一个不错的替代方法似乎是Unix计算机的multicore。特别是，在我检查了帮助页面之后，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来减少找到单根目录所需的步骤数。但是，我已经将 tol设置得尽可能大。

Answer 1

我将使用R 2.14中内置的parallel包并使用矩阵。然后，您可以像这样简单地使用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