R中真正快速的词ngram向量化
Posted
技术标签:
【中文标题】R中真正快速的词ngram向量化【英文标题】：Really fast word ngram vectorization in R 【发布时间】：2015-10-12 18:13:57 【问题描述】：edit：新的包 text2vec 非常好，并且很好地解决了这个问题（以及许多其他问题）。
text2vec on CRAN text2vec on github vignette that illustrates ngram tokenization
我在 R 中有一个相当大的文本数据集，我已将其作为字符向量导入：
#Takes about 15 seconds
system.time(
set.seed(1)
samplefun <- function(n, x, collapse)
paste(sample(x, n, replace=TRUE), collapse=collapse)
words <- sapply(rpois(10000, 3) + 1, samplefun, letters, '')
sents1 <- sapply(rpois(1000000, 5) + 1, samplefun, words, ' ')
)
我可以将此字符数据转换为词袋表示，如下所示：
library(stringi)
library(Matrix)
tokens <- stri_split_fixed(sents1, ' ')
token_vector <- unlist(tokens)
bagofwords <- unique(token_vector)
n.ids <- sapply(tokens, length)
i <- rep(seq_along(n.ids), n.ids)
j <- match(token_vector, bagofwords)
M <- sparseMatrix(i=i, j=j, x=1L)
colnames(M) <- bagofwords
所以 R 可以在大约 3 秒内将 1,000,000 百万个短句向量化为词袋表示（不错！）：
> M[1:3, 1:7]
10 x 7 sparse Matrix of class "dgCMatrix"
fqt hqhkl sls lzo xrnh zkuqc mqh
[1,] 1 1 1 1 . . .
[2,] . . . . 1 1 1
[3,] . . . . . . .
我可以将这个稀疏矩阵放入glmnet 或irlba，并对文本数据进行一些非常棒的定量分析。万岁！
现在我想将此分析扩展到 ngram 袋矩阵，而不是词袋矩阵。到目前为止，我发现最快的方法如下（我可以在 CRAN 上找到的所有 ngram 函数都被这个数据集阻塞，所以I got a little help from SO）：
find_ngrams <- function(dat, n, verbose=FALSE)
library(pbapply)
stopifnot(is.list(dat))
stopifnot(is.numeric(n))
stopifnot(n>0)
if(n == 1) return(dat)
pblapply(dat, function(y)
if(length(y)<=1) return(y)
c(y, unlist(lapply(2:n, function(n_i)
if(n_i > length(y)) return(NULL)
do.call(paste, unname(as.data.frame(embed(rev(y), n_i), stringsAsFactors=FALSE)), quote=FALSE)
)))
)
text_to_ngrams <- function(sents, n=2)
library(stringi)
library(Matrix)
tokens <- stri_split_fixed(sents, ' ')
tokens <- find_ngrams(tokens, n=n, verbose=TRUE)
token_vector <- unlist(tokens)
bagofwords <- unique(token_vector)
n.ids <- sapply(tokens, length)
i <- rep(seq_along(n.ids), n.ids)
j <- match(token_vector, bagofwords)
M <- sparseMatrix(i=i, j=j, x=1L)
colnames(M) <- bagofwords
return(M)
test1 <- text_to_ngrams(sents1)
这大约需要 150 秒（对于纯 r 函数来说还不错），但我想更快地扩展到更大的数据集。
R 中是否有任何 非常快 函数用于文本的 n-gram 矢量化？理想情况下，我正在寻找一个 Rcpp 函数，该函数将字符向量作为输入，并返回文档 x ngrams 的稀疏矩阵作为输出，但也很乐意获得一些自己编写 Rcpp 函数的指导。
即使是更快版本的 find_ngrams 函数也会有所帮助，因为这是主要瓶颈。 R 在标记化方面出奇地快。
编辑 1 这是另一个示例数据集：
sents2 <- sapply(rpois(100000, 500) + 1, samplefun, words, ' ')
在这种情况下，创建词袋矩阵的函数大约需要 30 秒，而创建 ngram 矩阵的函数大约需要 500 秒。同样，R 中现有的 n-gram 矢量化器似乎在这个数据集上卡住了（尽管我很想被证明是错误的！）
编辑 2 计时与 tau：
zach_t1 <- system.time(zach_ng1 <- text_to_ngrams(sents1))
tau_t1 <- system.time(tau_ng1 <- tau::textcnt(as.list(sents1), n = 2L, method = "string", recursive = TRUE))
tau_t1 / zach_t1 #1.598655
zach_t2 <- system.time(zach_ng2 <- text_to_ngrams(sents2))
tau_t2 <- system.time(tau_ng2 <- tau::textcnt(as.list(sents2), n = 2L, method = "string", recursive = TRUE))
tau_t2 / zach_t2 #1.9295619
【问题讨论】：
嗯，您是否考虑过tau::textcnt(as.list(sents), n = 2L, method = "string", recursive = TRUE) 而不是find_ngrams？花费一半的时间，但只提供二元组 (n=2)。
我没有尝试过，并且会。如果对两个数据集都比我上面的代码更快，那么 Bigrams 会起作用。
@lukeA 在两个数据集上 tau::textct 在我的系统上慢了 50%。我将用时间和示例代码更新我的问题，请在您的系统上尝试并比较结果。
stringdist::qgrams 确实非常快速的字符 qgram。作者目前正在研究支持词（ints）。
@Zach 奇怪。现在我得到了tau_t1 / zach_t1 = 649.48 / 675.82。差别不大了。
【参考方案1】：
这是使用tokenizers 的开发版本进行的测试，您可以使用devtools::install_github("ropensci/tokenizers") 获得。
使用上面sents1、sents2和find_ngrams()的定义：
library(stringi)
library(magrittr)
library(tokenizers)
library(microbenchmark)
library(pbapply)
set.seed(198)
sents1_sample <- sample(sents1, 1000)
sents2_sample <- sample(sents2, 1000)
test_sents1 <- microbenchmark(
find_ngrams(stri_split_fixed(sents1_sample, ' '), n = 2),
tokenize_ngrams(sents1_sample, n = 2),
times = 25)
test_sents1
结果：
Unit: milliseconds
expr min lq mean
find_ngrams(stri_split_fixed(sents1_sample, " "), n = 2) 79.855282 83.292816 102.564965
tokenize_ngrams(sents1_sample, n = 2) 4.048635 5.147252 5.472604
median uq max neval cld
93.622532 109.398341 226.568870 25 b
5.479414 5.805586 6.595556 25 a
在 sents2 上测试
test_sents2 <- microbenchmark(
find_ngrams(stri_split_fixed(sents2_sample, ' '), n = 2),
tokenize_ngrams(sents2_sample, n = 2),
times = 25)
test_sents2
结果：
Unit: milliseconds
expr min lq mean
find_ngrams(stri_split_fixed(sents2_sample, " "), n = 2) 509.4257 521.7575 562.9227
tokenize_ngrams(sents2_sample, n = 2) 288.6050 295.3262 306.6635
median uq max neval cld
529.4479 554.6749 844.6353 25 b
306.4858 310.6952 332.5479 25 a
直接检查时间
timing <- system.time(find_ngrams(stri_split_fixed(sents1, ' '), n = 2))
timing
user system elapsed
90.499 0.506 91.309
timing_tokenizers <- system.time(tokenize_ngrams(sents1, n = 2))
timing_tokenizers
user system elapsed
6.940 0.022 6.964
timing <- system.time(find_ngrams(stri_split_fixed(sents2, ' '), n = 2))
timing
user system elapsed
138.957 3.131 142.581
timing_tokenizers <- system.time(tokenize_ngrams(sents2, n = 2))
timing_tokenizers
user system elapsed
65.22 1.57 66.91
很大程度上取决于被标记的文本，但这似乎表明加速了 2 倍到 20 倍。
【讨论】：
【参考方案2】：这是一个非常有趣的问题，我在 quanteda 包中花了很多时间来解决这个问题。它涉及我将评论的三个方面，尽管只有第三个方面真正解决了您的问题。但是前两点解释了为什么我只关注 ngram 创建功能，因为——正如你所指出的——这就是可以提高速度的地方。
标记化。在这里，您在空格字符上使用string::str_split_fixed()，这是最快的，但不是最好的标记化方法。我们在quanteda::tokenize(x, what = "fastest word") 中的实现几乎完全相同。这不是最好的，因为 stringi 可以更智能地实现空白分隔符。 （甚至字符类\\s 也更智能，但速度稍慢——这被实现为what = "fasterword"）。不过，您的问题与标记化无关，所以这一点只是上下文。
将文档特征矩阵制表。这里我们也使用 Matrix 包，对文档和特征（我称之为特征，而不是术语）进行索引，并像上面代码中那样直接创建一个稀疏矩阵。但是您使用match() 比我们通过data.table 使用的匹配/合并方法快得多。我将重新编码quanteda::dfm() 函数，因为您的方法更优雅、更快。真的，真的很高兴看到这个！
ngram 创建。在这里，我认为我实际上可以在性能方面提供帮助。我们通过quanteda::tokenize() 的参数在quanteda 中实现这一点，称为grams = c(1)，其中值可以是任何整数集。例如，我们对 unigrams 和 bigrams 的匹配是ngrams = 1:2。您可以检查https://github.com/kbenoit/quanteda/blob/master/R/tokenize.R 的代码，请参阅内部函数ngram()。我在下面复制了这个并制作了一个包装器，以便我们可以直接将其与您的 find_ngrams() 函数进行比较。
代码：
# wrapper
find_ngrams2 <- function(x, ngrams = 1, concatenator = " ")
if (sum(1:length(ngrams)) == sum(ngrams))
result <- lapply(x, ngram, n = length(ngrams), concatenator = concatenator, include.all = TRUE)
else
result <- lapply(x, function(x)
xnew <- c()
for (n in ngrams)
xnew <- c(xnew, ngram(x, n, concatenator = concatenator, include.all = FALSE))
xnew
)
result
# does the work
ngram <- function(tokens, n = 2, concatenator = "_", include.all = FALSE)
if (length(tokens) < n)
return(NULL)
# start with lower ngrams, or just the specified size if include.all = FALSE
start <- ifelse(include.all,
1,
ifelse(length(tokens) < n, 1, n))
# set max size of ngram at max length of tokens
end <- ifelse(length(tokens) < n, length(tokens), n)
all_ngrams <- c()
# outer loop for all ngrams down to 1
for (width in start:end)
new_ngrams <- tokens[1:(length(tokens) - width + 1)]
# inner loop for ngrams of width > 1
if (width > 1)
for (i in 1:(width - 1))
new_ngrams <- paste(new_ngrams,
tokens[(i + 1):(length(tokens) - width + 1 + i)],
sep = concatenator)
# paste onto previous results and continue
all_ngrams <- c(all_ngrams, new_ngrams)
all_ngrams
这是一个简单文本的比较：
txt <- c("The quick brown fox named Seamus jumps over the lazy dog.",
"The dog brings a newspaper from a boy named Seamus.")
tokens <- tokenize(toLower(txt), removePunct = TRUE)
tokens
# [[1]]
# [1] "the" "quick" "brown" "fox" "named" "seamus" "jumps" "over" "the" "lazy" "dog"
#
# [[2]]
# [1] "the" "dog" "brings" "a" "newspaper" "from" "a" "boy" "named" "seamus"
#
# attr(,"class")
# [1] "tokenizedTexts" "list"
microbenchmark::microbenchmark(zach_ng <- find_ngrams(tokens, 2),
ken_ng <- find_ngrams2(tokens, 1:2))
# Unit: microseconds
# expr min lq mean median uq max neval
# zach_ng <- find_ngrams(tokens, 2) 288.823 326.0925 433.5831 360.1815 542.9585 897.469 100
# ken_ng <- find_ngrams2(tokens, 1:2) 74.216 87.5150 130.0471 100.4610 146.3005 464.794 100
str(zach_ng)
# List of 2
# $ : chr [1:21] "the" "quick" "brown" "fox" ...
# $ : chr [1:19] "the" "dog" "brings" "a" ...
str(ken_ng)
# List of 2
# $ : chr [1:21] "the" "quick" "brown" "fox" ...
# $ : chr [1:19] "the" "dog" "brings" "a" ...
对于非常大的模拟文本，比较如下：
tokens <- stri_split_fixed(sents1, ' ')
zach_ng1_t1 <- system.time(zach_ng1 <- find_ngrams(tokens, 2))
ken_ng1_t1 <- system.time(ken_ng1 <- find_ngrams2(tokens, 1:2))
zach_ng1_t1
# user system elapsed
# 230.176 5.243 246.389
ken_ng1_t1
# user system elapsed
# 58.264 1.405 62.889
已经有了改进，如果可以进一步改进，我会很高兴。我还应该能够在 quanteda 中实现更快的dfm() 方法，这样您就可以通过以下方式获得您想要的：
dfm(sents1, ngrams = 1:2, what = "fastestword",
toLower = FALSE, removePunct = FALSE, removeNumbers = FALSE, removeTwitter = TRUE))
（这已经可行，但比您的整体结果要慢，因为您创建最终稀疏矩阵对象的方式更快 - 但我会尽快更改。）
【讨论】：
很高兴我们能互相帮助！ 我也是。 Quanteda 的 GitHub 版本现在使用本文中的方法合并了 tokenize() 和 dfm() 中的更改。现在应该按照我在答案末尾所描述的方式为您快速工作。很快就会处理你剩下的 GitHub 问题。谢谢！ 比较 Zach 的回答，他的风格仍然比 quanteda 快得多。怎么会？我认为在你的改变之后，这应该已经解决了，@Ken Benoit @ambodiquanteda::ngrams() 在这篇文章之后发生了一些变化，所以我会尽快审查并回复您。
@KenBenoit Thanx。我真的很想使用 quanteda，因为我喜欢 API，但由于我的文本文件很大，所以我将其还原并暂时使用 Zach 的解决方案。以上是关于R中真正快速的词ngram向量化的主要内容，如果未能解决你的问题，请参考以下文章