ネストされたのforeachとdopar - データフレーム

Question

の各行をブートストラップ私は次のようになり、データフレームを持っている：

maindata <- data.frame(cbind(num=c(79,61,62,57), 
         denom=c(162356,170189,164634,162006), 
         group=c(1,2,3,4))) 

私の意図は、それぞれの行を選択し、ブートストラップリサンプリングを行い、95％信頼区間のための分位を見つけることです元のデータフレームと同じ数の行と2列のデータフレームにCIを出力する。ネストされたforeachのと％と、この機能はかなりうまく％作品をやるが、より多くの行を持つより多くの反復（例えば1000）と、データフレームに遅いです：私は％でこれを行う方法を把握しようとしている

boots = function(data, boots, seed=1234){ 
    if (!missing(seed)) 
    set.seed(seed) 
    pct <- NULL 
    ci.pct <- list() 
    foreach(j=1:nrow(data)) %do% { 
    datast1 <- c(rep(1, data[j,]$num), 
        rep(0, data[j,]$denom)) 
     foreach(i=1:boots, .combine='c') %do% { 
      index  <- sample(1:length(datast1), size=length(datast1), replace=TRUE) 
      sampledata <- datast1[index] 
      pct[i]  <- mean(sampledata) 
     } 
     ci.pct[[j]] <- cbind(quantile(pct, prob=c(0.025))*100000, 
           quantile(pct, prob=c(0.975))*100000) 
     } 
     ci.pcts <- do.call("rbind", ci.pct) 
     return(ci.pcts) 
    } 
    boots(data=maindata, boots=5, seed=1234) 

並列処理のためのdoparの％が、かなりそれを把握することはできません。

bootsd = function(data, boots, seed=1234){ 
    if (!missing(seed)) 
    set.seed(seed) 
    pct <- NULL 
    ci.pct <- list() 
    foreach(j=1:nrow(data)) %do% { 
    datast1 <- c(rep(1, data[j,]$num), 
        rep(0, data[j,]$denom)) 
     foreach(i=1:boots, .combine='c') %dopar% { 
      index  <- sample(1:length(datast1), size=length(datast1), replace=TRUE) 
      sampledata <- datast1[index] 
      pct[i]  <- mean(sampledata) 
     } 
     ci.pct[[j]] <- cbind(quantile(pct, prob=c(0.025))*100000, 
           quantile(pct, prob=c(0.975))*100000) 
     } 
     ci.pcts <- do.call("rbind", ci.pct) 
     return(ci.pcts) 
    } 
bootsd(data=maindata, boots=5, seed=1234) 

誰もが正しく％のdopar％または他のいくつかの巧妙なトリックを実装することで、それはより速く実行するために取得するためにコードを変更する方法についてのアドバイスがありますか？

Answer 1

私はあなたの機能を少し書き直しました。関数としてforeachが表示され、ループから結果が返されます。これは%dopar%で動作します。唯一の問題は種に従わないということです。それぞれの実行で異なる結果が返されます。おそらく、必要ならばdoRNGパッケージを見なければならないでしょう。

bootsd = function(data, boots, seed = 1234){ 
    if (!missing(seed)) set.seed(seed) 
    ci.pct <- foreach(j = 1:nrow(data)) %do% { 
    datast1 <- c(rep(1, data[j, "num"]), 
       rep(0, data[j, "denom"])) 
    pct <- foreach(i = 1:boots, .combine = 'c') %dopar% { 
     index <- sample(1:length(datast1), size = length(datast1), replace = T) 
     sampledata <- datast1[index] 
     mean(sampledata) 
    } 
    cbind(quantile(pct, prob=c(0.025))*100000, 
      quantile(pct, prob=c(0.975))*100000) 
    } 
    ci.pcts <- do.call("rbind", ci.pct) 
    return(ci.pcts) 
} 

bootsd(data = maindata, boots = 5, seed = 1234)