Cómo eliminar las palabras clave de manera eficiente de una lista de tokens ngram en R

performance n-gram

Question

A continuación, se solicita una mejor manera de hacer algo que ya puedo hacer de manera ineficiente: filtre una serie de tokens de n-gramas con "palabras de parada" para que la aparición de cualquier término de palabra de parada en una n-gram desencadene la eliminación.

Me gustaría mucho tener una solución que funcione tanto para unigramas como para n-gramas, aunque estaría bien tener dos versiones, una con una bandera "fija" y otra con una bandera de "regex". Estoy poniendo los dos aspectos de la pregunta juntos, ya que alguien puede tener una solución que pruebe un enfoque diferente que aborde los patrones de palabras de parada de expresión regular y fija.

Formatos:

• los tokens son una lista de vectores de caracteres, que pueden ser unigramas, o n-gramos concatenados por un carácter _ (subrayado).

• Las palabras clave son un vector de caracteres. En este momento estoy contento de permitir que esto sea una cadena fija, pero sería una buena ventaja poder implementar esto usando palabras clave con formato de expresiones regulares también.

Salida deseada: una lista de caracteres que coinciden con los tokens de entrada pero con cualquier componente que coincida con una palabra de parada que se está eliminando. (Esto significa una coincidencia de unigram o una coincidencia con uno de los términos que comprende el n-gramo).

Ejemplos, datos de prueba, código de trabajo y puntos de referencia para desarrollar:

tokens1 <- list(text1 = c("this", "is", "a", "test", "text", "with", "a", "few", "words"), 
                text2 = c("some", "more", "words", "in", "this", "test", "text"))
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"))
tokens3 <- list(text1 = c("this_is_a", "is_a_test", "a_test_text", "test_text_with", "text_with_a", "with_a_few", "a_few_words"),
                text2 = c("some_more_words", "more_words_in", "words_in_this", "in_this_text", "this_text_text"))
stopwords <- c("is", "a", "in", "this")

# remove any single token that matches a stopword
removeTokensOP1 <- function(w, stopwords) {
    lapply(w, function(x) x[-which(x %in% stopwords)])
}

# remove any word pair where a single word contains a stopword
removeTokensOP2 <- function(w, stopwords) {
    matchPattern <- paste0("(^|_)", paste(stopwords, collapse = "(_|$)|(^|_)"), "(_|$)")
    lapply(w, function(x) x[-grep(matchPattern, x)])
}

removeTokensOP1(tokens1, stopwords)
## $text1
## [1] "test"  "text"  "with"  "few"   "words"
## 
## $text2
## [1] "some"  "more"  "words" "test"  "text" 

removeTokensOP2(tokens1, stopwords)
## $text1
## [1] "test"  "text"  "with"  "few"   "words"
## 
## $text2
## [1] "some"  "more"  "words" "test"  "text" 

removeTokensOP2(tokens2, stopwords)
## $text1
## [1] "test_text" "text_with" "few_words"
## 
## $text2
## [1] "some_more"  "more_words" "text_text" 

removeTokensOP2(tokens3, stopwords)
## $text1
## [1] "test_text_with"
## 
## $text2
## [1] "some_more_words"

# performance benchmarks for answers to build on
require(microbenchmark)
microbenchmark(OP1_1 = removeTokensOP1(tokens1, stopwords),
               OP2_1 = removeTokensOP2(tokens1, stopwords),
               OP2_2 = removeTokensOP2(tokens2, stopwords),
               OP2_3 = removeTokensOP2(tokens3, stopwords),
               unit = "relative")
## Unit: relative
## expr      min       lq     mean   median       uq      max neval
## OP1_1 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000   100
## OP2_1 5.119066 3.812845 3.438076 3.714492 3.547187 2.838351   100
## OP2_2 5.230429 3.903135 3.509935 3.790143 3.631305 2.510629   100
## OP2_3 5.204924 3.884746 3.578178 3.753979 3.553729 8.240244   100

Answer 1

Esto no es realmente una respuesta, sino más bien un comentario para responder al comentario de rawr de revisar todas las combinaciones de palabras clave. Con una lista de stopwords más stopwords , el uso de algo así como %in% no parece sufrir ese problema de dimensionalidad.

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

Para las palabras

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

Answer 2

Podemos mejorar el lapply si tiene muchos niveles en su lista usando el paquete parallel .

Crear muchos niveles

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]])

Hacemos esto porque el paquete paralelo tiene una gran cantidad de gastos generales que configurar, por lo que el aumento del número de iteraciones en microbenchmark continuará incurriendo en ese costo. Al aumentar el tamaño de la lista, verá la verdadera mejora.

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

A medida que aumente el número de niveles en su lista, el rendimiento mejorará.

Answer 3

Usted podría considerar la posibilidad de simplificar sus expresiones regulares, ^ y $ se están sumando a la sobrecarga

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