上下文

Question

上下文

我一直在努力实现最近在this paper中提出的算法。给定大量文本（语料库），该算法应该返回语料库的特征 n - 格式（即， n 词的序列）。用户可以决定适当的 n ，目前我正在尝试 n = 2-6，就像在原始论文中一样。换句话说，使用该算法，我想提取表征语料库的2到6克。

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

数据

我有一个名为token.df的列表，其中包含五个数据框，包括出现在语料库中的所有 n - 图表。每个数据帧对应于 n -grams中的每个 n 。例如，token.df[[2]]按字母顺序包括所有bigrams（2-gram）及其分数（以下称为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

这里，bigram 0 0 （虽然它们不是那么说的话）得分为2.076421。由于数据框包含出现在语料库中的所有 n - 图表，因此它们每行都有超过一百万行。

> 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 -grams以及丢弃哪些 n -grams。为此，该算法执行以下操作。

双字母组
- 它保留了那些得分高于前两个词与双字母组合的三元组的双字母组。
3-5克
- 对于每个 n -gram，其中 n = {3,4,5}，它看着
  - 与 n -gram和
  - n + 1 克，其第一个 n 字匹配 n -gram。
- 只有当分数高于 n-1 克和 n + 1 n -gram >上面确定的克。
6克
- 它保留了6克，其得分高于与6克中前5个字匹配的5克。

实施例

> 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 dog ）得分高于二元组（11.002312> 10.56292）。保留trigram 0 001 dog ，因为它的得分（11.002312）高于与三元组的前两个单词匹配的二元组的得分（ 0 001 ;得分= 10.56292 ）和前三个词匹配三元组的4克（ 0 001 dog walkers ;得分= 10.916028）。

问题和尝试失败

我想知道的是实现上述目标的有效方法。例如，为了确定要保留哪些bigrams，我需要找出token.df[[2]]中token.df[[3]]的每一行中哪些行的前两个词与所关注的二元组相同。但是，由于行数很大，我的迭代接近下面需要很长时间才能运行。他们专注于bigrams的情况，因为任务看起来比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 -grams在每个数据框中按字母顺序排序的事实，并使用一种指示在哪一行开始查看的指针。但是，这种方法也需要很长时间才能运行（至少几天）。

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)
}

有没有办法在合理的时间内完成这项任务（例如，隔夜）？既然迭代方法已经徒劳无功，我想知道是否有任何矢量化。但我愿意采取任何措施来加快这一进程。

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

可重复的示例

我考虑过提供我正在使用的部分实际数据，但是减少数据会破坏问题的重点。我假设人们不想为此只下载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中），而不是自己迭代所有内容。事实上，如果只是在基数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特定的列。

加速R中大数据帧的处理

上下文

数据

任务

实施例

问题和尝试失败

可重复的示例

1 个答案: