0

次のようなデータ フレームがあります。

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 と %do% を使用したこの関数はかなりうまく機能しますが、反復回数が多く (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% またはその他の巧妙なトリックを正しく実装することにより、コードを変更してより高速に実行する方法についてアドバイスがある人はいますか?

4

1 に答える 1

0

関数を少し書き直しました。を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)
于 2016-08-02T16:38:01.967 に答える