R：加快“小组化”的行动
我有一个模拟，有一个巨大的总和，结合步骤正确的中间。 我使用plyr的ddply（）函数对这个过程进行了原型devise，这对于我的需求来说非常有用。 但是我需要这个聚合步骤，因为我必须运行10K模拟。 我已经并行扩展了模拟，但如果这一步更快，我可以大大减less我需要的节点数量。
这是我想要做的合理的简化：
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) ) ) 所有的提示或build议表示赞赏！
而不是正常的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
它的速度非常快，因为它避免了复制数据，只是在计算时才提取每个计算所需的子集。 将数据切换到matrixforms给出了另一种速度提升，因为matrix子集化比dataframe子集化要快得多。
进一步的2x加速和更简洁的代码：
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.table v1.9.2开始， setDT函数被导出， 通过引用将data.frame转换为data.table （与data.table说法一致 – 所有set*函数都通过引用修改对象）。 这意味着，不需要复制，因此速度很快。 你可以计时，但是会疏忽的。
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
这与上面OP解决scheme的1.264秒相反， data.table(.)用于创builddtb 。
我会与基地Rconfiguration文件
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
在我的机器上，它需要5秒比原来的代码67秒。
编辑只是发现了用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秒！
你是否使用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
编辑：
那么，其他循环方法更糟，所以这可能需要（一）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)))) } )
当应用的函数具有多个向量参数时，我通常使用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) }
