在R中，转换for循环以申请效率

Question

我正在做一些 NLP 并试图从特定（有限）语料库中找到常见的 2-gram。我已经编写了一个 for 循环来执行我想要的操作，但是在任何实际数据量上运行都需要很长时间。我觉得我应该可以通过 apply 来做到这一点，但我一生都无法弄清楚如何去做。非常感谢任何帮助。

我已将语料库标记化并 ngram 化为以下数据帧（这显然只是一个小子集，例如）。

tk
     word Freq
5477 with  186
1998  for  182
2644   it  179
3482   on  174
5354  was  168

ng
        ngrams Freq   w1   w2 rate
2434    at the   30   at  the    0
16027 with the   29 with  the    0
140     <> But   28   <>  But    0
223      <> He   28   <>   He    0
6885    I have   28    I have    0

我有以下适用于这两个数据帧的 for 循环：

for(i in 1:dim(ng)[1]) {
    tkw1 <- ifelse(length(tk$Freq[tk$word==ng$w1[i]]) > 0, 
                   tk$Freq[tk$word==ng$w1[i]], 0)
    tkw2 <- ifelse(length(tk$Freq[tk$word==ng$w2[i]]) > 0,
                   tk$Freq[tk$word==ng$w2[i]], 0)
    dnm <- tkw1 + tkw2
    dnm <- ifelse(dnm >= 1, dnm, ng$Freq[i])
    ng$rate[i] <- ng$Freq[i] / dnm
}

这个想法是为每一行计算一个“比率”，它基本上是 2-gram 出现的次数除以每个单词单独出现的次数（总和）。 for 循环可以做到这一点，但在大规模使用时速度很慢。

旁注：有一些 ifelse 语句对于调试有时（由于不完善的预处理）2-gram 中的一个单词与 tk 数据帧中的单词不匹配的事实是必要的。

Sooo，有没有办法通过 apply（或者可能是 sapply 或 tapply）来做到这一点？我已经为此工作了好几个小时，但我无法弄清楚。 谢谢！

如果这有帮助，我最近的尝试是：

TGrate <- function(ng, w1, w2, Freq){
    tkw1 <- ifelse(length(tk$Freq[tk$word==w1]) > 0, 
           tk$Freq[tk$word==w1], 0)
    tkw2 <- ifelse(length(tk$Freq[tk$word==w2]) > 0,
           tk$Freq[tk$word==w2], 0)
    dnm <- tkw1 + tkw2
    dnm <- ifelse(dnm >= 1, dnm, Freq)
    rate <- as.numeric(Freq) / as.numeric(dnm)
    rate
}
ng$rate <- apply(ng, 1, TGrate, w1="w1", w2="w2", Freq="Freq")

但这只会产生一堆 NA。

Answer 1

我不知道哪个更快（如果它们比 for 循环更好），但我有两种方法可以解决。他们都得到“dnm”，然后分别计算速率。

第一个是合并：

names(tk)[2] <- 'tkfreq'
ng <- merge(ng,tk,by.x = 'w1',by.y = 'word',all.x = T)
ng <- merge(ng,tk,by.x = 'w2',by.y = 'word',all.x = T)
ng$tkfreq.x[is.na(ng$tkfreq.x)] <- 0
ng$tkfreq.y[is.na(ng$tkfreq.y)] <- 0
ng$dnm <- ng$tkfreq.x + ng$tkfreq.y

第二个是apply：

ng$dnm <- apply(ng,1,function(x){
  sum(tk[tk$word %in% x[c('w1','w2')],'Freq'])
})

他们都以此结束以获得最终费率：

ng$rate <- ng$Freq / ng$dnm
ng[is.infinite(ng$rate),'rate'] <- 1

应用版本简洁，IMO，更容易理解。也就是说，for 循环通常更快。有很多方法可以提取不同的部分并进行矢量化，但最好的解决方案可能取决于您的数据。您可能希望对实际匹配的那些进行子集化，或者您可能希望对 apply 函数进行并行处理。祝你好运！

Answer 2

好吧，我不能说应用示例，但是：您的循环看起来如此缓慢的原因是您在每次迭代中都写入 data.frame。

Data.frames 是非原始对象，具有修改时复制语义。把它放在人身上：每次调整 data.frame 时，你实际上在做的是为“新”data.frame 寻找内存，在该空间中创建一个副本，将旧名称分配给副本，然后删除旧对象。

不出所料，当这是在循环中完成时 - 即可能数千、数万或数百万次 - 速度非常慢。一个答案是使用像 data.table 或 plyr 这样的包，它们有很好的方法来迭代 data.frames 的子集，但第一个尝试的策略应该是调查你是否真的需要每个都写入 data.frame迭代。在这种情况下，您不会：您正在为单个字段生成单个值。那么为什么不写入一个在修改时具有不同行为的向量，然后将该向量添加到最后的 data.frame 中呢？

#Create a vector to hold the output. If we make sure it's the length of the
#actual output, it never has to be copied when modified.
holding <- numeric(nrow(ng))

for(i in 1:dim(ng)[1]) {
    tkw1 <- ifelse(length(tk$Freq[tk$word==ng$w1[i]]) > 0, 
               tk$Freq[tk$word==ng$w1[i]], 0)
    tkw2 <- ifelse(length(tk$Freq[tk$word==ng$w2[i]]) > 0,
               tk$Freq[tk$word==ng$w2[i]], 0)
    dnm <- tkw1 + tkw2
    dnm <- ifelse(dnm >= 1, dnm, ng$Freq[i])

    #Write to the vector
    holding[i] <- ng$Freq[i] / dnm
}

#And now add the vector to the df
ng$rate <- holding

这应该会加快速度。不过，要注意的另一件重要事情是如何在循环中引用 data.frames 中的元素。正如Hadley notes（请参阅“从数据帧中提取单个值”部分），由于缺乏语言优化，您可以通过访问相同值的不同方式获得惊人的不同性能成本。