Как эффективно удалить стоп-слова из списка токенов ngram в R

Ответ 1

На самом деле это не ответ - больше комментариев, чтобы ответить на rawr комментарий прохождения всех комбинаций стоп-слов. С более длинным stopwords списком использование чего-то типа %in%, похоже, не вызывает проблемы с размерностью.

library(purrr)
removetokenstst <- function(tokens, stopwords) 
  map2(tokens, 
       lapply(tokens3, function(x) { 
         unlist(lapply(strsplit(x, "_"), function(y) { 
           any(y %in% stopwords) 
         })) 
       }), 
       ~ .x[!.y])

require(microbenchmark)
microbenchmark(OP1_1 = removeTokensOP1(tokens1, morestopwords),
           OP2_1 = removeTokensOP2(tokens1, morestopwords),
           OP2_2 = removeTokensOP2(tokens2, morestopwords),
           OP2_3 = removeTokensOP2(tokens3, morestopwords),
           Ak_3 = removetokenstst(tokens3, stopwords),
           Ak_3msw = removetokenstst(tokens3, morestopwords),
           unit = "relative")

Unit: relative
    expr       min        lq       mean    median        uq      max neval
   OP1_1   1.00000   1.00000   1.000000  1.000000  1.000000  1.00000   100
   OP2_1 278.48260 176.22273  96.462854 79.787932 76.904987 38.31767   100
   OP2_2 280.90242 181.22013  98.545148 81.407928 77.637006 64.94842   100
   OP2_3 279.43728 183.11366 114.879904 81.404236 82.614739 72.04741   100
    Ak_3  15.74301  14.83731   9.340444  7.902213  8.164234 11.27133   100
 Ak_3msw  18.57697  14.45574  12.936594  8.513725  8.997922 24.03969   100

Стоп-слова

morestopwords = c("a", "about", "above", "after", "again", "against", "all", 
"am", "an", "and", "any", "are", "arent", "as", "at", "be", "because", 
"been", "before", "being", "below", "between", "both", "but", 
"by", "cant", "cannot", "could", "couldnt", "did", "didnt", "do", 
"does", "doesnt", "doing", "dont", "down", "during", "each", 
"few", "for", "from", "further", "had", "hadnt", "has", "hasnt", 
"have", "havent", "having", "he", "hed", "hell", "hes", "her", 
"here", "heres", "hers", "herself", "him", "himself", "his", 
"how", "hows", "i", "id", "ill", "im", "ive", "if", "in", "into", 
"is", "isnt", "it", "its", "its", "itself", "lets", "me", "more", 
"most", "mustnt", "my", "myself", "no", "nor", "not", "of", "off", 
"on", "once", "only", "or", "other", "ought", "our", "ours", 
"ourselves", "out", "over", "own", "same", "shant", "she", "shed", 
"shell", "shes", "should", "shouldnt", "so", "some", "such", 
"than", "that", "thats", "the", "their", "theirs", "them", "themselves", 
"then", "there", "theres", "these", "they", "theyd", "theyll", 
"theyre", "theyve", "this", "those", "through", "to", "too", 
"under", "until", "up", "very", "was", "wasnt", "we", "wed", 
"well", "were", "weve", "were", "werent", "what", "whats", "when", 
"whens", "where", "wheres", "which", "while", "who", "whos", 
"whom", "why", "whys", "with", "wont", "would", "wouldnt", "you", 
"youd", "youll", "youre", "youve", "your", "yours", "yourself", 
"yourselves", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", 
"k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", 
"x", "y", "z")

Ответ 2

Мы можем улучшить lapply, если у вас много уровней в вашем списке, используя пакет parallel.

Создать много уровней

tokens2 <- list(text1 = c("this_is", "is_a", "a_test", "test_text", "text_with", "with_a", "a_few", "few_words"), 
                text2 = c("some_more", "more_words", "words_in", "in_this", "this_text", "text_text"))
tokens2 <- lapply(1:500,function(x) sample(tokens2,1)[[1]])

Мы делаем это, потому что параллельный пакет имеет множество накладных расходов для настройки, поэтому простое увеличение количества итераций на microbenchmark будет по-прежнему нести эту стоимость. Увеличивая размер списка, вы видите истинное улучшение.

library(parallel)
#Setup
cl <- detectCores()
cl <- makeCluster(cl)

#Two functions:

#original
removeTokensOP2 <- function(w, stopwords) { 
  matchPattern <- paste0("(^|_)", paste(stopwords, collapse = "(_|$)|(^|_)"), "(_|$)")
  lapply(w, function(x) x[-grep(matchPattern, x)])
}

#new
removeTokensOPP <- function(w, stopwords) {
  matchPattern <- paste0("(^|_)", paste(stopwords, collapse = "(_|$)|(^|_)"), "(_|$)")
  return(w[-grep(matchPattern, w)])
}

#compare

microbenchmark(
  OP2_P = parLapply(cl,tokens2,removeTokensOPP,stopwords),
  OP2_2 = removeTokensOP2(tokens2, stopwords),
  unit = 'relative'
)

Unit: relative
  expr      min       lq     mean   median       uq      max neval
 OP2_P 1.000000 1.000000 1.000000 1.000000 1.000000  1.00000   100
 OP2_2 1.730565 1.653872 1.678781 1.562258 1.471347 10.11306   100

По мере увеличения количества уровней в вашем списке производительность улучшится.

Ответ 3

Вы хотите, чтобы симулировать ваши регулярные выражения, ^ и $добавляют к служебным

remove_short <- function(x, stopwords) {
  stopwords_regexp <- paste0('(^|_)(', paste(stopwords, collapse = '|'), ')(_|$)')
  lapply(x, function(x) x[!grepl(stopwords_regexp, x)])
}
require(microbenchmark)
microbenchmark(OP1_1 = removeTokensOP1(tokens1, stopwords),
               OP2_1 = removeTokensOP2(tokens2, stopwords),
               OP2_2 = remove_short(tokens2, stopwords),
               unit = "relative")
Unit: relative
  expr      min       lq     mean   median       uq      max neval cld
 OP1_1 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000   100 a  
 OP2_1 5.178565 4.768749 4.465138 4.441130 4.262399 4.266905   100   c
 OP2_2 3.452386 3.247279 3.063660 3.068571 2.963794 2.948189   100  b