加速R中大数据帧的处理

Question

上下文

我一直在尝试实现本文最近提出的算法.给定大量的文本(语料库)的,该算法应该返回特性Ñ -grams(即,序列Ñ语料库的话).用户可以决定适当的n,并且在我尝试使用n = 2-6时,就像在原始论文中一样.换句话说,使用该算法,我想提取表征语料库的2到6克.

我能够实现基于哪个特征n -gram被识别来计算得分的部分,但是一直在努力消除非特征性的.

数据

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

> 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.为此,该算法执行以下操作.

1. 双字母组
   • 它保留了那些得分高于前三个字与谜语相匹配的三元组的双胞胎.
2. 3-5克
   • 对于n = {3,4,5}的每个n -gram ,它看一下
     • 与n -gram和n的前n-1个字匹配的n-1克
     • 的n + 1个克,其第一Ñ字匹配Ñ -gram.
   • 该算法仅在其得分高于n-1克和上述n + 1克的得分时才保留n -gram .
3. 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)和4克,其第三个字匹配的trigram(0 001狗步行者 ;得分= 10.916028).

问题和失败的尝试

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

1. 该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]]))
   

2. 指针方法.
   上述问题是(垂直)长数据帧上的大量迭代.为了缓解这个问题,我想我可以使用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秒来处理token.df[[2]]下面的前100行,它可能需要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中),而不是自己迭代所有内容.事实上,如果只是merge在基数R中使用,我就不会感到惊讶,然后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的列.