mapplyを効率的に並列化する方法はありますか？

Question

私は多くの行を持ち、すべての行で私は非線形関数のunirootを計算します。私は今、2日間コードを実行していないクアッドコアのUbuntuマシンを持っています。驚くことではないが、私は物事をスピードアップする方法を探している;-)

いくつかの研究の後で、私はただ1つのコアだけが現在使用されており、並列化が行うことに気づいた。もっと深く掘り下げて、あまりにも多くのオーバーヘッドが発生するので、パッケージforeachが本当に私の問題ではないと結論付けました（おそらく間違っていますか？）（例えば、SO参照）。良い選択肢は、Unixマシンの場合はmulticoreと思われます。特に、pvecの機能は、ヘルプページを確認した後に最も効率的な機能と思われます。

しかし、私が正しく理解すると、この関数はと1つだけベクトルをとり、それに応じて分割します。私はparallizedすることができる関数が必要ですが、mapplyのようにベクトル（またはdata.frame）の代わりに複数のベクトルが必要です。そこに私が逃したものはありますか？

ここに私がしたいことの小さな例があります（関数の代わりに使うことができるので、ここにはplyrの例が含まれていますが、並列化オプションがあります。実装と内部では、それを並列化する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のリンクからchunkapplyライアン・トンプソンの機能を実装しようとした（だけ処分しましたdoMCの部分は、私はそれをインストールすることができなかったので、彼の機能を調整した後でも、彼の例は動作します）、 しかしdidnそれを働かせないでください。しかし、それは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：私はちょうどunirootを見つけるために必要なステップの数を減らすためにtolを高めることができることを知っています。しかし、私はすでにtolを可能な限り大きく設定しています。

Answer 1

私はparallelパッケージを使用してR 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 

Answer 2

をこれはまさにベストプラクティスの提案ではなく、かなりのスピードアップは、「ベクトル化」ファッションのすべてのパラメータのためのルートを特定することにより得ることができます。約1.3Sそれぞれに別々unirootの適用のための対、例えば、

bisect <- 
    function(f, interval, ..., lower=min(interval), upper=max(interval), 
      f.lower=f(lower, ...), f.upper=f(upper, ...), maxiter=20) 
{ 
    nrow <- length(f.lower) 
    bounds <- matrix(c(lower, upper), nrow, 2, byrow=TRUE) 
    for (i in seq_len(maxiter)) { 
     ## move lower or upper bound to mid-point, preserving opposite signs 
     mid <- rowSums(bounds)/2 
     updt <- ifelse(f(mid, ...) > 0, 0L, nrow) + seq_len(nrow) 
     bounds[updt] <- mid 
    } 
    rowSums(bounds)/2 
} 

、次いで

> system.time(x2 <- with(df, { 
+  f <- function(x, PB0, CF1, CF2, CF3) 
+   PB0 + CF1/x + CF2/x^2 + CF3/x^3 
+  bisect(f, c(1, 10), PB0, CF1, CF2, CF3) 
+ })) 
    user system elapsed 
    0.180 0.000 0.181 
> range(x1 - x2) 
[1] -6.282406e-06 6.658593e-06 

。これはまた、PとB0を前もって単一の値に結合しました。これは、それらが方程式を入力する方法であるからです。

最終値の範囲は+/- diff(interval) * (.5^maxiter)程度です。より洗練された実装では、二等分線を線形補間または二次補間に置き換えることができます（?unirootで引用されているように）。しかし、均一な効率的な収束（およびすべての場合においてエラー処理）は手配するのが難しくなります。

Answer 3

これは古いトピックですが、現在はparallel::mcmapplyのドキュメントはhereです。オプションにmc.coresを設定することを忘れないでください。私は通常OSの操作のために1CPUを無料にするためにmc.cores=parallel::detectCores()-1を使用します。

x4 <- mcmapply(get_uniroot, df$P, df$B0, df$CF1, df$CF2, df$CF3,mc.cores=parallel::detectCores()-1)