आर

Question

में एनजीआरएम टोकन की सूची से प्रभावी ढंग से स्टॉपवर्ड को कैसे हटाएं, यह कुछ ऐसा करने का बेहतर तरीका है जो मैं पहले से ही अक्षम कर सकता हूं: "स्टॉप शब्द" का उपयोग करके एन-ग्राम टोकन की एक श्रृंखला फ़िल्टर करें ताकि एन-ग्राम ट्रिगर हटाने में किसी भी स्टॉप शब्द शब्द की घटना।

मुझे एक ऐसा समाधान होना पसंद है जो यूनिग्राम और एन-ग्राम दोनों के लिए काम करता है, हालांकि यह दो संस्करणों के साथ ठीक होगा, एक "निश्चित" ध्वज वाला और एक "रेगेक्स" ध्वज वाला होगा। मैं प्रश्न के दो पहलुओं को एक साथ रख रहा हूं क्योंकि किसी के पास ऐसा समाधान हो सकता है जो एक अलग दृष्टिकोण की कोशिश करता है जो निश्चित और नियमित अभिव्यक्ति स्टॉपवर्ड पैटर्न दोनों को संबोधित करता है।

प्रारूप:

• टोकन चरित्र वैक्टर, जो unigrams, या एन-ग्राम एक _ (अंडरस्कोर) चरित्र से श्रेणीबद्ध किया जा सकता है की एक सूची है।

• स्टॉपवर्ड एक चरित्र वेक्टर हैं। अभी मैं इसे एक निश्चित स्ट्रिंग होने के लिए संतुष्ट हूं, लेकिन नियमित अभिव्यक्ति स्वरूपित स्टॉपवर्ड का उपयोग करके इसे लागू करने में सक्षम होने के लिए यह एक अच्छा बोनस होगा।

वांछित आउटपुट: इनपुट मिलान टोकन लेकिन एक रोक शब्द मिलान किसी भी घटक टोकन के माध्यम से वर्णों की एक सूची से हटाया जा रहा है। (यह एक unigram मैच, या शर्तों जो एन-ग्राम शामिल हैं में से एक के लिए एक मैच का मतलब है।)

उदाहरण, परीक्षण डाटा, और काम कर कोड और मानक पर निर्माण करने के लिए:

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

को जोड़ रहे हैं यह वास्तव में एक जवाब नहीं है - एक टिप्पणी के और अधिक के सभी संयोजनों के माध्यम से जा के rawr की टिप्पणी का जवाब stopwords। 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 

stopwords

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

parallel पैकेज का उपयोग करके आपकी सूची में कई स्तर हैं, तो हम lapply पर सुधार कर सकते हैं।

कई स्तरों

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 

आपकी सूची में स्तरों की संख्या बढ़ने के साथ ही प्रदर्शन में सुधार होगा।

Answer 3

आप अपने रेगुलर एक्सप्रेशन, simlifying पर विचार migth^और $ भूमि के ऊपर

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