R中真正快速的单词ngram矢量化 [英] Really fast word ngram vectorization in R

问题描述

新包 text2vec 非常好，并且很好地解决了这个问题(以及许多其他问题).

edit: The new package text2vec is excellent, and solves this problem (and many others) really well.

CRAN 上的 text2vecgithub 上的 text2vec说明 ngram 标记化的小插图

我在 R 中有一个非常大的文本数据集，我已将其作为字符向量导入:

I have a pretty large text dataset in R, which I've imported as a character vector:

#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, ' ')
})

我可以将这个字符数据转换为词袋表示，如下所示:

I can convert this character data to a bag-of-words representation as follows:

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 百万个短句向量化为词袋表示(还不错！):

So R can vectorize 1,000,000 million short sentences into a bag-of-words representation in about 3 seconds (not bad!):

> 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 并对文本数据进行一些非常棒的定量分析.万岁！

I can throw this sparse matrix into glmnet or irlba and do some pretty awesome quantitative analysis of textual data. Hooray!

现在我想将此分析扩展到 ngrams 袋矩阵，而不是词袋矩阵.到目前为止，我发现的最快方法如下(我在 CRAN 上找到的所有 ngram 函数都在这个数据集上窒息，所以 我得到了 SO 的一些帮助):

Now I'd like to extend this analysis to a bag-of-ngrams matrix, rather than a bag-of-words matrix. So far, the fastest way I've found to do this is as follows (all of the ngram functions I could find on CRAN choked on this dataset, so 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 函数来说还不错)，但我想加快速度并扩展到更大的数据集.

This takes about 150 seconds (not bad for a pure r function), but I'd like to go faster and extend to bigger datasets.

在 R 中是否有任何非常快的函数用于文本的 n-gram 向量化?理想情况下，我正在寻找一个带有字符的 Rcpp 函数向量作为输入，并返回文档 x ngrams 的稀疏矩阵作为输出，但也很乐意为自己编写 Rcpp 函数提供一些指导.

Are there any really fast functions in R for n-gram vectorization of text? Ideally I'm looking for an Rcpp function that takes a character vector as input, and returns a sparse matrix of documents x ngrams as output, but would also be happy to have some guidance writing the Rcpp function myself.

即使是 find_ngrams 函数的更快版本也会有所帮助，因为这是主要瓶颈.R 在标记化方面出奇地快.

Even a faster version of the find_ngrams function would be helpful, as that's the main bottleneck. R is surprisingly fast at tokenization.

编辑 1这是另一个示例数据集:

Edit 1 Here's another example dataset:

sents2 <- sapply(rpois(100000, 500) + 1, samplefun, words, ' ')

在这种情况下，我创建词袋矩阵的函数大约需要 30 秒，而我创建词袋矩阵的函数大约需要 500 秒.同样，R 中现有的 n-gram 向量化器似乎在这个数据集上窒息(尽管我很想被证明是错误的！)

In this case, my functions for creating a bag-of-words matrix take about 30 seconds and my functions for creating a bag-of-ngrams matrix take about 500 seconds. Again, existing n-gram vectorizers in R seem to choke on this dataset (though I'd love to be proven wrong!)

编辑 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

推荐答案

这是一个非常有趣的问题，我在 quanteda 包中花了很多时间来解决这个问题.它涉及我将评论的三个方面，尽管只有第三个方面真正解决了您的问题.但是前两点解释了为什么我只关注 ngram 创建功能，因为 - 正如您所指出的 - 这是可以提高速度的地方.

This is a really interesting problem, and one that I have spent a lot of time grappling with in the quanteda package. It involves three aspects that I will comment on, although it's only the third that really addresses your question. But the first two points explain why I have only focused on the ngram creation function, since -- as you point out -- that is where the speed improvement can be made.

1. 分词.这里您在空格字符上使用了 string::str_split_fixed()，这是最快的，但不是分词的最佳方法.我们在 quanteda::tokenize(x, what = "fastest word") 中实现的几乎完全相同.这不是最好的，因为 stringi 可以对空白分隔符进行更智能的实现.(即使字符类 \\s 更智能，但速度稍慢——这被实现为 what = "fasterword").不过，您的问题与标记化无关，因此这一点只是上下文.

1. Tokenization. Here you are using string::str_split_fixed() on the space character, which is the fastest, but not the best method for tokenizing. We implemented this almost exactly the same was in quanteda::tokenize(x, what = "fastest word"). It's not the best because stringi can do much smarter implementations of whitespace delimiters. (Even the character class \\s is smarter, but slightly slower -- this is implemented as what = "fasterword"). Your question was not about tokenization though, so this point is just context.

制表文档特征矩阵.这里我们也使用了 Matrix 包，对文档和特征(我称之为特征，而不是术语)进行索引，并像上面的代码一样直接创建一个稀疏矩阵.但是您对 match() 的使用比我们通过 data.table 使用的匹配/合并方法要快得多.我将重新编码 quanteda::dfm() 函数，因为您的方法更优雅、更快.真的，真的很高兴看到这个！

Tabulating the document-feature matrix. Here we also use the Matrix package, and index the documents and features (I call them features, not terms), and create a sparse matrix directly as you do in the code above. But your use of match() is a lot faster than the match/merge methods we were using through data.table. I am going to recode the quanteda::dfm() function since your method is more elegant and faster. Really, really glad I saw this!

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() 函数进行比较.

ngram creation. Here I think I can actually help in terms of performance. We implement this in quanteda through an argument to quanteda::tokenize(), called grams = c(1) where the value can be any integer set. Our match for unigrams and bigrams would be ngrams = 1:2, for instance. You can examine the code at https://github.com/kbenoit/quanteda/blob/master/R/tokenize.R, see the internal function ngram(). I've reproduced this below and made a wrapper so that we can directly compare it to your find_ngrams() function.

代码:

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

这是一个简单文本的比较:

Here is the comparison for a simple text:

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" ...

对于非常大的模拟文本，比较如下:

For your really large, simulated text, here is the comparison:

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() 方法，以便您可以通过以下方式获得所需的内容:

Already an improvement, I'd be delighted if this could be improved further. I also should be able to implement the faster dfm() method into quanteda so that you can get what you want simply through:

dfm(sents1, ngrams = 1:2, what = "fastestword",
    toLower = FALSE, removePunct = FALSE, removeNumbers = FALSE, removeTwitter = TRUE)) 

(这已经有效，但比你的整体结果慢，因为你创建最终稀疏矩阵对象的方式更快——但我很快就会改变这一点.)

(That already works but is slower than your overall result, because the way you create the final sparse matrix object is faster - but I will change this soon.)

这篇关于R中真正快速的单词ngram矢量化的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！