Действительно быстрая векторизация слова ngram в R

Это действительно интересная проблема, на решение которой я потратил много времени в пакете Quanteda. Он включает в себя три аспекта, которые я прокомментирую, хотя только третий действительно касается вашего вопроса. Но первые два пункта объясняют, почему я сосредоточился только на функции создания ngram, поскольку, как вы указываете, именно здесь можно добиться повышения скорости.

1. Токенизация. Здесь вы используете string::str_split_fixed() для символа пробела, что является самым быстрым, но не лучшим методом для токенизации. Мы реализовали это почти точно так же, как было в quanteda::tokenize(x, what = "fastest word"). Это не лучший вариант, потому что stringi может гораздо лучше реализовать разделители пробелов. (Даже класс символов \\s умнее, но немного медленнее — это реализовано как what = "fasterword"). Ваш вопрос не касался токенизации, так что это просто контекст.

2. Сведение таблицы характеристик документа. Здесь мы также используем пакет Matrix и индексируем документы и функции (я называю их функциями, а не терминами) и создаем разреженную матрицу напрямую, как вы это делаете в приведенном выше коде. Но ваше использование match() намного быстрее, чем методы сопоставления/слияния, которые мы использовали через data.table. Я собираюсь перекодировать функцию quanteda::dfm(), так как ваш метод элегантнее и быстрее. Реально, очень рад, что увидел это!

3. создание ngram. Здесь я думаю, что действительно могу помочь с точки зрения производительности. Мы реализуем это в Quanteda с помощью аргумента quanteda::tokenize(), называемого grams = c(1), где значением может быть любое целочисленное множество. Наше совпадение для униграмм и биграмм будет, например, 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 

Уже улучшение, я был бы рад, если бы это можно было улучшить дальше. Я также должен иметь возможность реализовать более быстрый метод dfm() в Quanteda, чтобы вы могли получить то, что хотите, просто с помощью:

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

(Это уже работает, но медленнее, чем ваш общий результат, потому что способ, которым вы создаете окончательный объект разреженной матрицы, быстрее, но я скоро изменю это.)

Вот тест с использованием разрабатываемой версии токенизаторов, которую вы можете получить с помощью 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 

Тестирование на sends2

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

Многое будет зависеть от токенизированных текстов, но это, похоже, указывает на ускорение от 2x до 20x.