for 循环的速度

Question

使用这里的数据集：

https://www.dropbox.com/s/gyimxbz5f3v0uq3/kfg.RData?dl=0

并执行以下代码：

matrix(nrow=1600,ncol=8) -> ctw
for(k in 1:8){
  for(i in 1:1600){
    which(kfg[,9]==i) -> aj
    if(length(aj)!=0){
      sample(kfg[aj,11],prob=kfg[aj,k],size=1) -> ctw[i,k]
    }
    ctw[i,k]
  }
}

是可行的，但真正的集合超过 80 万行，而且需要很长时间。 在data.table或其他包中有没有办法更快地做到这一点？ 执行which()步骤非常慢。

Answer 1

我不得不修改你的原始代码来检查非零概率。 我还从内部循环的最后一行中删除了语句ctw[i,k] ，因为它没有效果。 你的代码是

matrix(nrow=1600,ncol=8) -> ctw
for(k in 1:8){
    for(i in 1:1600){
        which(kfg[,9]==i) -> aj
        if ((length(aj)!=0) && any(kfg[aj, k] > 0)) {
            sample(kfg[aj,11],prob=kfg[aj,k],size=1) -> ctw[i,k]
        }
    }
}
ctw

我颠倒了循环的顺序，以便kfg[,9] == i只计算一次而不是 8 次。 我还使用tabulate()在循环外测试了length(aj) != 0 。 我修改后的代码是

matrix(nrow=1600,ncol=8) -> ctw
which(tabulate(kfg[, 9], 1600) != 0) -> ii
for(i in ii) {
    kfg[,9] == i -> aj
    for(k in 1:8)
        if (any(kfg[aj, k] > 0))
            sample(kfg[aj,11], 1, prob=kfg[aj,k]) -> ctw[i,k]
}
ctw

对于您的示例数据，这大约快 5 倍。

提取样本值向量kfg[,11] == kfg[[11]]一次，并使用概率矩阵as.matrix(kfg[, 1:8])工作要as.matrix(kfg[, 1:8]) ，而不是一个数据框。 对于示例数据，将第 9 列上的拆分提升到循环外的速度略快，并通过在循环外进行矢量化计算来识别相关索引来避免 k 循环内的条件

nrow <- 1600
matrix(nrow=nrow,ncol=8) -> ctw
x <- kfg[[11]]
pr <- as.matrix(kfg[,1:8])
ajs <- split(seq_len(nrow(kfg)), factor(kfg[[9]], levels=seq_len(nrow)))
ii <- seq_along(ajs)[lengths(ajs) > 0]
for(i in ii) {
    aj <- ajs[[i]]
    kk <- which(colSums(pr[aj,, drop=FALSE]) > 0)
    for(k in kk)
        sample(x[aj], 1, prob=pr[aj,k]) -> ctw[i,k]
}
ctw

这些导致进一步的 5 倍加速，因此比原始速度快 25 倍。

为了测量速度，我将上述每个都包含在一个函数中，例如，

f0 <- function() {
    matrix(nrow=1600,ncol=8) -> ctw
    for(k in 1:8){
        for(i in 1:1600){
            which(kfg[,9]==i) -> aj
            if ((length(aj)!=0) && any(kfg[aj, k] > 0)) {
                sample(kfg[aj,11],prob=kfg[aj,k],size=1) -> ctw[i,k]
            }
        }
     }
    ctw
}

并使用了微基准测试包

> library(microbenchmark)
> microbenchmark(f0(), f1(), f2(), times=10)
Unit: milliseconds
 expr       min        lq      mean    median        uq       max neval cld
 f0() 466.12527 483.43954 484.34258 483.74805 484.21627 521.19957    10   c
 f1()  92.77415  94.79052  94.99273  95.10352  95.45368  96.10641    10  b 
 f2()  17.33708  17.83257  17.87095  17.87205  18.01723  18.16400    10 a  

f1()和f2()应该是相同的，但它们不是

> set.seed(123); res1 <- f1(); set.seed(123); res2 <- f2()
> all.equal(res1, res2)
[1] "'is.NA' value mismatch: 12096 in current 12133 in target"

调查，这是因为第 9 列中的值是数字，但被处理，例如， kfg[, 9] == i就好像它们是整数一样。 例如，

> kfg[[9]][(kfg[[9]] > 28 & kfg[[9]] <= 29)]
[1] 29 29 29
> kfg[[9]][(kfg[[9]] > 28 & kfg[[9]] <= 29)] == 29
[1] FALSE FALSE FALSE

也许意图是

kfg[[9]] = round(kfg[[9]])

有了这个变化，我们有

> all.equal(res1, res2)
[1] TRUE
> identical(res1, res2)
[1] TRUE