r - 加快R中大型数据帧的处理

Question

语境

我一直在尝试实现this paper最近提出的算法。给定大量文本(语料库)，该算法应返回语料库的特征性n元语法(即n个单词的序列)。用户可以决定合适的n，此刻我正尝试像原始论文中的那样n = 2-6。换句话说，使用该算法，我想提取出2到6克的语料库。

我能够实现根据识别出特征性n-gram来计算分数的部分，但是一直在努力消除非特征性n-gram。

数据

我有一个名为token.df的列表，其中包含五个数据帧，包括出现在语料库中的所有n-gram。每个数据帧对应于n克中的每个n。例如，token.df[[2]]按字母顺序包括所有二元组(2克)及其分数(以下称为mi)。

> head(token.df[[2]])
w1    w2      mi
_      eos  17.219346
_   global   7.141789
_     what   8.590394
0        0   2.076421
0       00   5.732846
0      000   3.426785

在这里，二元组0 0(尽管它们不是完全这样的单词)的得分为2.076421。由于数据帧包括出现在语料库中的所有n-gram，因此它们每个都有超过一百万行。

> sapply(token.df, nrow)
[[1]]
NULL

[[2]]
[1] 1006059  # number of unique bigrams in the corpus

[[3]]
[1] 2684027  # number of unique trigrams in the corpus

[[4]]
[1] 3635026  # number of unique 4-grams in the corpus

[[5]]
[1] 3965120  # number of unique 5-grams in the corpus

[[6]]
[1] 4055048  # number of unique 6-grams in the corpus

任务

我想确定要保留的n-gram和要丢弃的n-gram。为此，该算法执行以下操作。

bigrams

它保留分数高于其前两个单词与二元组匹配的三字母组的二元组。

3-5克

对于每个n = {3，4，5}的n元语法，它看起来是

与n-gram和

的前n-1个单词匹配的n-1克

前n个单词与n-gram匹配的n + 1克。

仅当其分数高于上面确定的n-1克和n + 1克的分数时，算法才会保留n-gram。

6克

它保留得分高于与6克前五个单词匹配的5克得分的6克。

例子

> token.df[[2]][15, ]
 w1  w2       mi
  0 001 10.56292
> token.df[[3]][33:38, ]
 w1  w2       w3        mi
  0 001     also  3.223091
  0 001 although  5.288097
  0 001      and  2.295903
  0 001      but  4.331710
  0 001 compared  6.270625
  0 001      dog 11.002312
> token.df[[4]][46:48, ]
 w1  w2            w3      w4        mi
  0 001      compared      to  5.527626
  0 001           dog walkers 10.916028
  0 001 environmental concern 10.371769

在此，不保留二元组0 001，因为前两个单词与二元组(0 001狗)相匹配的三字母组之一的得分高于二元组(11.002312> 10.56292)。之所以保留三字组0 001狗，是因为它的分数(11.002312)高于与三字组的前两个单词相匹配的二元组(0 001;分数= 10.56292)和与前三字匹配的四元组的分数高。 Trigram(0 001个walk狗；得分= 10.916028)。

问题和失败的尝试

我想知道的是实现上述目标的有效方法。例如，为了确定保留哪些二元组，我需要为 token.df[[2]]的每一行找出 token.df[[3]]中的哪些行的前两个单词与所关注的二元组相同。但是，由于行数很大，因此下面的迭代方法需要花费很长时间才能运行。他们专注于二元组的情况，因为任务比3-5克的情况看起来更简单。

for循环方法。
由于下面的代码在每次迭代时遍历token.df[[3]]的所有行，因此估计需要几个月的时间才能运行。尽管稍微好一点，但by()的情况与此类似。

# for loop
retain <- numeric(nrow(token.df[[2]]))
for (i in 1:nrow(token.df[[2]])) {
    mis <- token.df[[3]]$mi[token.df[[2]][i, ]$w1 == token.df[[3]][ , 1] & token.df[[2]][i, ]$w2 == token.df[[3]][ , 2]]
    retain[i] <- ifelse(token.df[[2]]$mi[i] > max(mis), TRUE, FALSE)
}

# by
mis <- by(token.df[[2]], 1:nrow(token.df[[2]]), function(x) token.df[[3]]$mi[x$w1 == token.df[[3]]$w1 & x$w2 == token.df[[3]]$w2])
retain <- sapply(seq(mis), function(i) token.df[[2]]$mi[i] > max(mis[[i]]))

指针方法。
上面的问题是在(垂直)长数据帧上的大量迭代。为了缓解这个问题，我认为我可以利用以下事实:在每个数据帧中按字母顺序对n-gram进行排序，并使用一种指针来指示从哪一行开始查找。但是，这种方法也需要很长时间才能运行(至少需要几天)。

retain <- numeric(nrow(token.df[[2]]))
nrow <- nrow(token.df[[3]]) # number of rows of the trigram data frame
pos <- 1 # pointer
for (i in seq(nrow(token.df[[2]]))) {
    j <- 1
    target.rows <- numeric(10)
    while (TRUE) {
        if (pos == nrow + 1 || !all(token.df[[2]][i, 1:2] == token.df[[3]][pos, 1:2])) break
        target.rows[j] <- pos
        pos <- pos + 1
        if (j %% 10 == 0) target.rows <- c(target.rows, numeric(10))
        j <- j + 1
    }
    target.rows <- target.rows[target.rows != 0]
    retain[i] <- ifelse(token.df[[2]]$mi[i] > max(token.df[[3]]$mi[target.rows]), TRUE, FALSE)
}

有没有办法在合理的时间内(例如过夜)执行此任务？既然迭代方法徒劳无功，我想知道是否可以进行任何矢量化。但是我愿意采取任何手段来加快这一进程。

数据具有树形结构，其中一个二元组被分为一个或多个三元组，每个三元组又被分为一个或多个四元组，依此类推。我不确定如何最好地处理此类数据。

可重现的例子

我曾考虑过要存放一部分我正在使用的真实数据，但是减少数据将破坏整个问题。我认为人们不想为此下载整个250MB的数据集，也没有权利上传它。以下是随机数据集，该数据集仍小于我正在使用的数据集，但有助于解决该问题。使用上面的代码(指针方法)，我的计算机花了4-5秒钟来处理下面的前100列 token.df[[2]]，大概要花12个小时才能处理所有的双字母组。

token.df <- list()
types <- combn(LETTERS, 4, paste, collapse = "")
set.seed(1)
data <- data.frame(matrix(sample(types, 6 * 1E6, replace = TRUE), ncol = 6), stringsAsFactors = FALSE)
colnames(data) <- paste0("w", 1:6)
data <- data[order(data$w1, data$w2, data$w3, data$w4, data$w5, data$w6), ]
set.seed(1)
for (n in 2:6) token.df[[n]] <- cbind(data[ , 1:n], mi = runif(1E6))

任何加快代码速度的想法都受到高度赞赏。

Answer 1

对于所有二元组，以下内容在我的计算机上运行不到7秒:

library(dplyr)
res <- inner_join(token.df[[2]],token.df[[3]],by = c('w1','w2'))
res <- group_by(res,w1,w2)
bigrams <- filter(summarise(res,keep = all(mi.y < mi.x)),keep)

这里的 dplyr 没有什么特别的。当然，可以使用 data.table 或直接在SQL中完成同样快速(或更快)的解决方案。您只需要切换为使用联接(就像在SQL中一样)，而不是自己遍历所有内容。实际上，如果仅在base R中使用 merge，然后 aggregate不会比您现在做的快几个数量级，我不会感到惊讶。 (但是您确实应该使用 data.table ， dplyr 或直接在SQL数据库中进行此操作)。

确实，这是:

library(data.table)
dt2 <- setkey(data.table(token.df[[2]]),w1,w2)
dt3 <- setkey(data.table(token.df[[3]]),w1,w2)
dt_tmp <- dt3[dt2,allow.cartesian = TRUE][,list(k = all(mi < mi.1)),by = c('w1','w2')][(k)]

甚至更快(〜2倍)。老实说，我什至不能确定我会挤走所有包装中的所有速度。

(来自Rick的编辑。尝试作为评论，但语法被弄乱了)
如果使用 data.table，这应该更快一些，因为 data.table具有 by-without-by功能(有关更多信息，请参见 ?data.table):

 dt_tmp <- dt3[dt2,list(k = all(mi < i.mi)), allow.cartesian = TRUE][(k)]

请注意，在加入 data.tables时，您可以在列名之前添加 i.，以指示使用 i=参数中的data.table中的列。