performance - R: 「group by」操作の高速化

Question

中央に巨大な集計と結合のステップがあるシミュレーションがあります。私は、plyr の ddply() 関数を使用して、このプロセスのプロトタイプを作成しました。これは、私のニーズの大部分でうまく機能します。しかし、10K のシミュレーションを実行する必要があるため、この集約ステップを高速化する必要があります。すでにシミュレーションを並行してスケーリングしていますが、この 1 ステップが速ければ、必要なノードの数を大幅に減らすことができます。

これが私がやろうとしていることの合理的な単純化です：

library(Hmisc)

# Set up some example data
year <-    sample(1970:2008, 1e6, rep=T)
state <-   sample(1:50, 1e6, rep=T)
group1 <-  sample(1:6, 1e6, rep=T)
group2 <-  sample(1:3, 1e6, rep=T)
myFact <-  rnorm(100, 15, 1e6)
weights <- rnorm(1e6)
myDF <- data.frame(year, state, group1, group2, myFact, weights)

# this is the step I want to make faster
system.time(aggregateDF <- ddply(myDF, c("year", "state", "group1", "group2"),
                     function(df) wtd.mean(df$myFact, weights=df$weights)
                                 )
           )

すべてのヒントや提案を歓迎します!

score 37 · Accepted Answer

通常の R データフレームの代わりに、サブセット化したときに元のデータフレームへのポインターを返す不変のデータフレームを使用でき、はるかに高速になります。

idf <- idata.frame(myDF)
system.time(aggregateDF <- ddply(idf, c("year", "state", "group1", "group2"),
   function(df) wtd.mean(df$myFact, weights=df$weights)))

#    user  system elapsed 
# 18.032   0.416  19.250

この状況に合わせてカスタマイズされた plyr 関数を書くとしたら、次のようにします。

system.time({
  ids <- id(myDF[c("year", "state", "group1", "group2")], drop = TRUE)
  data <- as.matrix(myDF[c("myFact", "weights")])
  indices <- plyr:::split_indices(seq_len(nrow(data)), ids, n = attr(ids, "n"))

  fun <- function(rows) {
    weighted.mean(data[rows, 1], data[rows, 2])
  }
  values <- vapply(indices, fun, numeric(1))

  labels <- myDF[match(seq_len(attr(ids, "n")), ids), 
    c("year", "state", "group1", "group2")]
  aggregateDF <- cbind(labels, values)
})

# user  system elapsed 
# 2.04    0.29    2.33

データのコピーを回避し、計算時に各計算に必要なサブセットのみを抽出するため、非常に高速です。行列のサブセット化はデータフレームのサブセット化よりもはるかに高速であるため、データを行列形式に切り替えると、速度がさらに向上します。

score 28 · Accepted Answer

さらに 2 倍のスピードアップとより簡潔なコード:

library(data.table)
dtb <- data.table(myDF, key="year,state,group1,group2")
system.time( 
  res <- dtb[, weighted.mean(myFact, weights), by=list(year, state, group1, group2)] 
)
#   user  system elapsed 
#  0.950   0.050   1.007

初投稿です、よろしくお願いします(;_;)

data.tablev1.9.2 から、関数setDTがエクスポートされ、参照によってdata.frame変換されます(用語に合わせて、すべての関数は参照によってオブジェクトを変更します)。これは、不要なコピーがないことを意味し、したがって高速です。タイミングを計ることはできますが、怠慢になります。data.table data.tableset*

require(data.table)
system.time({
  setDT(myDF)
  res <- myDF[, weighted.mean(myFact, weights), 
             by=list(year, state, group1, group2)] 
})
#   user  system elapsed 
#  0.970   0.024   1.015

data.table(.)これは、作成に使用される上記の OP のソリューションで 1.264 秒とは対照的dtbです。

score 10 · Accepted Answer

ベースRでプロファイリングします

g <- with(myDF, paste(year, state, group1, group2))
x <- with(myDF, c(tapply(weights * myFact, g, sum) / tapply(weights, g, sum)))
aggregateDF <- myDF[match(names(x), g), c("year", "state", "group1", "group2")]
aggregateDF$V1 <- x

私のマシンでは、元のコードの 67 秒と比較して 5 秒かかります。

EDIT関数で別のスピードアップを見つけましたrowsum：

g <- with(myDF, paste(year, state, group1, group2))
X <- with(myDF, rowsum(data.frame(a=weights*myFact, b=weights), g))
x <- X$a/X$b
aggregateDF2 <- myDF[match(rownames(X), g), c("year", "state", "group1", "group2")]
aggregateDF2$V1 <- x

3秒かかります！

score 7 · Accepted Answer

plyr の最新バージョンを使用していますか (注: これはまだすべての CRAN ミラーに反映されていません)。もしそうなら、これを並行して実行することができます。

以下は llply の例ですが、同じことが ddply にも当てはまります。

  x <- seq_len(20)
  wait <- function(i) Sys.sleep(0.1)
  system.time(llply(x, wait))
  #  user  system elapsed 
  # 0.007   0.005   2.005 

  library(doMC)
  registerDoMC(2) 
  system.time(llply(x, wait, .parallel = TRUE))
  #  user  system elapsed 
  # 0.020   0.011   1.038

編集：

他のループアプローチはもっと悪いので、おそらく (a) C/C++ コードか、(b) やり方をより根本的に再考する必要があります。by()私の経験では非常に遅いため、使用しようとさえしませんでした。

groups <- unique(myDF[,c("year", "state", "group1", "group2")])
system.time(
aggregateDF <- do.call("rbind", lapply(1:nrow(groups), function(i) {
   df.tmp <- myDF[myDF$year==groups[i,"year"] & myDF$state==groups[i,"state"] & myDF$group1==groups[i,"group1"] & myDF$group2==groups[i,"group2"],]
   cbind(groups[i,], wtd.mean(df.tmp$myFact, weights=df.tmp$weights))
}))
)

aggregateDF <- data.frame()
system.time(
for(i in 1:nrow(groups)) {
   df.tmp <- myDF[myDF$year==groups[i,"year"] & myDF$state==groups[i,"state"] & myDF$group1==groups[i,"group1"] & myDF$group2==groups[i,"group2"],]
   aggregateDF <- rbind(aggregateDF, data.frame(cbind(groups[i,], wtd.mean(df.tmp$myFact, weights=df.tmp$weights))))
}
)

score 5 · Accepted Answer

適用される関数に複数のベクトル引数がある場合、私は通常、tapply でインデックスベクトルを使用します。

system.time(tapply(1:nrow(myDF), myDF[c('year', 'state', 'group1', 'group2')], function(s) weighted.mean(myDF$myFact[s], myDF$weights[s])))
# user  system elapsed 
# 1.36    0.08    1.44

同等であるが混乱を隠す単純なラッパーを使用します。

tmapply(list(myDF$myFact, myDF$weights), myDF[c('year', 'state', 'group1', 'group2')], weighted.mean)

以下のコメントに tmapply を含めるように編集しました。

tmapply = function(XS, INDEX, FUN, ..., simplify=T) {
  FUN = match.fun(FUN)
  if (!is.list(XS))
    XS = list(XS)
  tapply(1:length(XS[[1L]]), INDEX, function(s, ...)
    do.call(FUN, c(lapply(XS, `[`, s), list(...))), ..., simplify=simplify)
}

performance - R: 「group by」操作の高速化

5 に答える 5

Related

Reference