从foreach循环赋值

我想并行化一个循环，就像

td        <- data.frame(cbind(c(rep(1,4),2,rep(1,5)),rep(1:10,2)))
names(td) <- c("val","id")

res <- rep(NA,NROW(td))
for(i in levels(interaction(td$id))){
res[td$id==i] <- mean(td$val[td$id!=i])
}  

---

td如果使用data.table而不是循环的并行化，您的性能增益将提高几个数量级：

library(data.table)
DT <- data.table(td)

DT[, means := mean(DT[-.I, val]), by = id]

identical(DT$means, res)
#[1] TRUE

为了并行高效地执行这些计算，您需要使用组块，因为单个平均值计算不需要太多时间。使用
foreach
时，我经常使用
itertools
包中的函数进行分块。在本例中，我使用
isplitVector
函数为每个工人生成一个任务。结果是向量，因此只需将它们相加即可组合，这就是为什么必须将
r
向量初始化为零向量的原因

vadd <- function(a, ...) {
  for (v in list(...))
    a <- a + v
  a
}

res <- foreach(ids=isplitVector(unique(td$id), chunks=workers),
               .combine='vadd',
               .multicombine=TRUE,
               .inorder=FALSE) %dopar% {
  r <- rep(0, NROW(td))
  for (i in ids)
    r[td$id == i] <- mean(td$val[td$id != i])
  r
}

我之所以包括这一点，是因为性能非常依赖于数据。使用不同的随机种子甚至可以获得不同的性能结果

以下是使用Xeon CPU X5650和12 GB RAM的Linux设备的一些基准测试结果：


：359秒
：208秒
：104秒

因此，对于至少一个数据集，并行执行此计算是值得的。这不是一个完美的加速，但也不是太糟糕。为了在您自己的机器上运行这些基准测试，或者使用不同的数据集，您可以通过上面的链接从pastebin下载它们

更新

在完成这些基准测试之后，我对使用
data.table
和
foreach
来获得更快的版本很感兴趣。这就是我的想法（来自Matthew Dowle的建议）：

cmean加上一些代数，我认为内部的
DT[]
可以避免：
DT[，意思是2:=（n*valbar sum（val））/（n-.n），by=id]
。。。where
n@Frank我在中演示了这种方法。嗨！史蒂夫的一篇帖子也是正确的，但由于某种原因它消失了。所以我检查你的答案是否正确。谢谢你的帮助+1但我认为在计时中包含从
data.frame
到
data.table
的转换是不合适的，就像您在中所做的那样。当我们使用
data.table
时，我们首先从
data.table
开始。另外，
mean（DT[-.I，val]）
可以是
mean（val[-.I]）
，这通过节省对
[.data.table
@MatthewDowle我倾向于同意。我有另一个版本的基准测试不包括这种转换，但对于这个特殊的情况，它没有太大的区别。使用微基准测试，转换只需要大约42毫秒。仔细看，我现在意识到
意味着（val[-.I]）
不会是一样的。但是
平均值（DT$val[-.I]）
如何呢？同样的想法：避免
[.data.table
的开销，甚至
平均值（DT[[val]][-.I]）
比
平均值（DT[-.I，val]）快8倍
。你的全尺寸
n
和
m
让我的上网本窒息，所以对你看到的东西非常感兴趣。
library(foreach)
res2 <- foreach(i=levels(interaction(td$id)), .combine=rbind) %do% {
  data.frame(level = i, means = mean(td$val[td$id!=i]))}

res2 <- merge(res2, td, by.x = "level", by.y = "id", sort = FALSE)

#    level    means val
# 1      1 1.111111   1
# 2      1 1.111111   1
# 3      2 1.111111   1
# 4      2 1.111111   1
# 5      3 1.111111   1
# 6      3 1.111111   1
# 7      4 1.111111   1
# 8      4 1.111111   1
# 9      5 1.000000   2
# 10     5 1.000000   2
# 11     6 1.111111   1
# 12     6 1.111111   1
# 13     7 1.111111   1
# 14     7 1.111111   1
# 15     8 1.111111   1
# 16     8 1.111111   1
# 17     9 1.111111   1
# 18     9 1.111111   1
# 19    10 1.111111   1
# 20    10 1.111111   1

vadd <- function(a, ...) {
  for (v in list(...))
    a <- a + v
  a
}

res <- foreach(ids=isplitVector(unique(td$id), chunks=workers),
               .combine='vadd',
               .multicombine=TRUE,
               .inorder=FALSE) %dopar% {
  r <- rep(0, NROW(td))
  for (i in ids)
    r[td$id == i] <- mean(td$val[td$id != i])
  r
}

set.seed(107)
n <- 1000000
m <- 10000
td <- data.frame(val=rnorm(n), id=sample(m, n, replace=TRUE))

cmean <- function(v, mine) if (mine) mean(v) else 0
nuniq <- length(unique(td$id))
res <- foreach(grps=isplitIndices(nuniq, chunks=workers),
               .combine='vadd',
               .multicombine=TRUE,
               .inorder=FALSE,
               .packages='data.table') %dopar% {
  td[, means := cmean(td$val[-.I], .GRP %in% grps), by=id]
  td$means
}