Question

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

我已经将这些语料库进行了标记化处理，并将语料库输入到以下数据框中（这显然只是一小部分，例如）。

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
}

这个想法是计算一个＆＃34;率＆＃34;对于每一行，基本上是2克出现的次数，除以每个单独出现的次数（总和）。 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

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

Data.frames是非原始对象，具有copy-on-modify语义。把它放在人类身上：每当你调整一个data.frame时，你实际做的就是为＆＃34; new＆＃34; 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（参见＆＃34;从数据框中提取单个值＆＃34;），由于缺乏语言优化，您可以通过访问相同值的不同方式获得惊人不同的性能成本。

Answer 2

我不知道哪个更快（如果它们甚至比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

第二个是申请：

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函数上进行并行处理。祝你好运！

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

2 个答案: