编辑:新包 text2vec 非常好,很好地解决了这个问题(以及许多其他问题)。
CRAN 上的 text2vec github 小插图上的 text2vec,说明了 ngram 标记化
我在 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 函数都在这个数据集上阻塞,所以我从 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 Timings vs 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