R text mining: группировка похожих слов с использованием stemDocuments в пакете tm - PullRequest
Новая
       100

R text mining: группировка похожих слов с использованием stemDocuments в пакете tm

0 голосов
/ 16 апреля 2020

Я занимаюсь анализом текста около 30000 твитов. Теперь проблема в том, чтобы сделать результаты более надежными. Я хочу преобразовать «синонимы» в похожие слова, например. некоторые пользователи используют слова «девушка», некоторые используют «девочки», некоторые используют «гал». Точно так же «дать», «дал» означает только одно. то же самое для "приходи, приходи". некоторые пользователи используют краткие формы, такие как "плз", "плс" и т. д. 1010 *. Кроме того, "stemdocument" из пакета tm не работает должным образом. Он преобразует танец в дан c , table to tabl ..... есть ли какой-нибудь другой хороший пакет для определения? Я хочу заменить все эти слова только одним подобным словом, чтобы посчитать правильную частоту этих данных. Так что мой анализ настроений будет более надежным Ниже приведен воспроизводимый код (я не могу включить все кадры данных 30000X1 здесь), отредактированный после комментариев ken: 

 content<-c("n.n.t.t.t.t.t.t.girl.do.it.to.me.t.t.n.t.t.t.t.t.t.n.n.t.t.t.t.t.t.n.n.t.t.t.t.t.t.t.n.n.t.t.t.t.t.t.t.n.t.n.t.t.n.t.t.t.n.t.t.t.tajinkx.said..n.t.t.t.n.t.t.n.t.n.t.n.t.t.n.t.t.n.t.t.n.t.t.tok.guyz...srry.to.sound.dumb.toilets.i.dnt.drink.while.m.just.searching.for.fun..nso.is.going.to.bar.good.for.me.i.dnt.knw.what.washroom.all.happens.there.inside...so.would.like.if.someone.gals.helps.me.thankuu..n.t.t.n.t.t.t.tClick.to.expand....n.t.nBhai.tu.plz.rehne.de.....n.n.t.n.n.t.t.n.t.t.t.n.t.t.n.n.t.t.n.t.n.n.t.t.t.t.t.t.t.t..n.t.t.t.t.t.t.t.t.n.toilet.is.not .t.t.t.t.t.t.t.n.n.t.t.t.t.t.t.n.n.t.t.t.t.t.t.n.t.n.n.t.t.n.t.t.t.n.t.t.n.n.t.t.n.t.n.n.n.t.n.n.n.t.n.n.t.t.n.t.t.t.n.t.t.n.n.t.t.n.t.n.n.t.t.t.t.t..................................................................................................................................................                                                                                       \n\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\n\t\t\t\t\t\t\n\n\t\t\t\t\t\t\t\n\n\t\t\t\t\t\t\t\n\t\n\t\t\n\t\t\t\n\t\t\t\tajinkx said:\n\t\t\t\n\t\t\n\t\n\t\n\t\t\n\t\t\n\t\t\n\t\t\tok guyz...srry to sound dumb!i dnt drink while m just searching for fun!\nso is going to bar good for me?i dnt knw what all happens there inside...so would like if someone helps me.thankuu!\n\t\t\n\t\t\t\tClick to expand...\n\t\nBhai,tu plz rehne de....\n\n\t\n\n\t\t\n\t\t\t\n\t\t\n\n\t\t\n\t\n\n\t\t\t\t\t\t\t\t \n\t\t\t\t\t\t\t\t\n\t\t\t\t\t\t\t\n\n\t\t\t\t\t\t\n\n\t\t\t\t\t\t\n\t\n\n\t\t\n\t\t\t\n\t\t\n\n\t\t\n\t\n\n\n\t\n\n\n\t\n\n\t\t\n\t\t\t\n\t\t\n\n\t\t\n\t\n\n\t\t\t\t\t\n\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\n\t\t\t\t\t\t\n\n\t\t\t\t\t\t\t\n\n\t\t\t\t\t\t\t is this da bar which u guys r talking about???\nSent from my SM-N900 using Tapatalk\n\n\t\n\n\t\t\n\t\t\t\n\t\t\n\n\t\t\n\t\n\n\t\t\t\t\t\t\t\t \n\t\t\t\t\t\t\t\t\n\t\t\t\t\t\t\t\n\n\t\t\t\t\t\t\n\n\t\t\t\t\t\t\n\t\n\n\t")  


    np<-600;postop<-1200;fr<-"yes"#input from GUI

    #wbpage<-function (np,postop,fr){
    #load("data_mpdb.Rdata")
    #content<-as.data.frame(raw_dat[np:postop,],stringsAsFactors = FALSE)
    #last<-rbind(tail(content,1),head(content,1));colnames(last)<-#c("stopdate","startdate")
    message("Initializing part-1")
    #---------------------data cleaning-----------------------------------------------------
    #replied post
    content2<-as.data.frame(content$txt,stringsAsFactors = FALSE);colnames(content2)<-c("txt")
        content2 <- as.data.frame(gsub("(said:).*?(click to expand\\.{3})", " ", content$txt),stringsAsFactors = FALSE);
        content2<-as.data.frame(lapply(content$txt, gsub, pattern = '(said:).*?(click to expand\\.{3})', replacement ="\\1 \\2", perl=TRUE),stringsAsFactors = FALSE);
        content2<- as.data.frame(t(as.matrix(content2)));colnames(content2)<-c("txt");rownames(content2)<-NULL
    #----------------ken's addition: lemmitization---------------------------
    sp <- spacy_parse(as.character(content2$txt), lemma = TRUE)    
    sp$token <- ifelse(!grepl("^\\-[A-Z]+\\-$", sp$lemma), sp$lemma, sp$token)    
    # define equivalencies for please variants
    dict <- dictionary(list(
      please = c("please", "pls", "plz"),
      girl = c("girl", "gal"),
      toilet=c("toilet","shit","shitty","washroom")
    ))    
    toks <- as.tokens(sp) %>%
      tokens(remove_punct = TRUE)
    toks
    new_stopwords<-c("said","one","click","expand","sent","using","attachment",
                     "tapatalk","will","can","hai","forum","like","just",
                     "get","know","also","now","bro","bhai","back","wat",
                     "ur","naa","nai","sala","email","urself","arnd","sim",
                     "pl","kayko","ho","gmail","sm","ll","g7102","iphone","yeah","time","asked","went","want","look","call","sit",
                     "even","first","place","left","visit","guy","around","started","came","dont","got","took","see","take","see","come")

    toks <- tokens_remove(toks, c(stopwords("en"), new_stopwords))
#--------I have to make toks to be same as content2 so that i can use it in # 
 further corpus buildin---------------------------        

    #the data- punctuation, digits, stopwords, whitespace, and lowercase.
    docs <- Corpus(VectorSource(content2$txt));#mname<-Corpus(VectorSource(content2$name))
    message("Initializing part-1.2")
    docs <- tm_map(docs, content_transformer(tolower));#mname<-tm_map(mname,content_transformer(tolower))
    docs <- tm_map(docs, removePunctuation,preserve_intra_word_contractions=TRUE,preserve_intra_word_dashes=TRUE);#mname <- tm_map(mname, removePunctuation)
    message("Initializing part-1.3")
    docs <- tm_map(docs, removeWords, c(stopwords("english"),new_stopwords))
    docs <- tm_map(docs, stripWhitespace);#mname <- tm_map(mname, stripWhitespace)
    message("Initializing part-1.4")
    docs <- tm_map(docs, removeWords,new_stopwords)
    #------------------------Text stemming------------------------------------------
        #docs <- tm_map(docs, stemDocument,language="english")

    #-------------sentiment analysis--------------------------------------------------
    message("Initializing part-2")
    n <- 4
    rnorm(10000, 0,1)
    #incProgress(1/n, detail = paste("Finished section 1"))

    docs_df <- data.frame(matrix(unlist(docs),nrow=length(docs), byrow=F),stringsAsFactors=FALSE)
    docs_df<-docs_df[-c(2)];content2$editedtxt<-docs_df;

    #----------------fr|fr:----------------------------------------------
    if (fr=="yes"){
    frlogic<-grepl("fr\\s|fr:", docs_df$X1);docs_df<-as.data.frame(docs_df[frlogic=="TRUE",],stringsAsFactors = FALSE);
    docs_df[order(nchar(as.character(docs_df)),decreasing = FALSE),]
    }

    colnames(docs_df)<-c("txt")
    d<-get_nrc_sentiment(as.character(docs_df))
    td<-data.frame(t(d))
    td_new <- data.frame(rowSums(td))
    #Transformation and cleaning
    names(td_new)[1] <-"count"
    td_new <- cbind("sentiment"=rownames(td_new), td_new)
    rownames(td_new) <- NULL
    td_new2<-td_new[1:8,]
    sentimentplot<-qplot(sentiment, data=td_new2, weight=count, geom="bar",fill=sentiment)+ggtitle("sentiments")
    sentimentplot

прямо сейчас я получаю сообщение об ошибке Поиск исполняемого файла python с установленным spaCy .. . Ошибка в set_spacy_python_option (python_executable, virtualenv, condaenv,: в системе PATH

не найдено python Также 

I have to make toks to be same as content2 so that i can use it in # 
 further corpus building for furhter analysis.

ожидает вашего ответа. Спасибо.

1 Ответ

0 голосов
/ 18 апреля 2020

Этот код не воспроизводится, так как у нас нет ввода content2. Но вот пример, который вы можете использовать.

То, что вы называете «преобразованием синонимов» для вариантов, таких как «дать» и «дал» или «девушка» против «девочек», - это не просто вопрос определения, это вопрос лемматизации (например, дано-дано). Для лемматизации нужна функциональность, отсутствующая в пакете tm .

Я рекомендую попробовать spacyr для лемматизации и quanteda для остальных , Вот как. Мы начнем с некоторого текста, а затем проанализируем его, используя spacy_parse(). 

txt <- c(
  "The girl and the girls gave all they had to give.",
  "Pls say plz, please, gal."
)
new_stopwords <- c(
  "yeah", "time", "asked", "went", "want", "look", "call",
  "sit", "even", "first", "place", "left", "visit", "guy",
  "around", "started", "came", "dont", "got", "took", "see",
  "take", "see", "come"
)


library("spacyr")
sp <- spacy_parse(txt, lemma = TRUE)
## Found 'spacy_condaenv'. spacyr will use this environment
## successfully initialized (spaCy Version: 2.2.3, language model: en_core_web_sm)
## (python options: type = "condaenv", value = "spacy_condaenv")
sp
##    doc_id sentence_id token_id  token  lemma   pos entity
## 1   text1           1        1    The    the   DET       
## 2   text1           1        2   girl   girl  NOUN       
## 3   text1           1        3    and    and CCONJ       
## 4   text1           1        4    the    the   DET       
## 5   text1           1        5  girls   girl  NOUN       
## 6   text1           1        6   gave   give  VERB       
## 7   text1           1        7    all    all   DET       
## 8   text1           1        8   they -PRON-  PRON       
## 9   text1           1        9    had   have   AUX       
## 10  text1           1       10     to     to  PART       
## 11  text1           1       11   give   give  VERB       
## 12  text1           1       12      .      . PUNCT       
## 13  text2           1        1    Pls    pls  INTJ       
## 14  text2           1        2    say    say  VERB       
## 15  text2           1        3    plz    plz  INTJ       
## 16  text2           1        4      ,      , PUNCT       
## 17  text2           1        5 please please  INTJ       
## 18  text2           1        6      ,      , PUNCT       
## 19  text2           1        7    gal    gal PROPN       
## 20  text2           1        8      .      . PUNCT

Мы собираемся преобразовать это в quanteda токены, но сначала давайте заменим токен его леммой (если это не часть речевого идентификатора, например "-PRON -"). 

# replace the token with its lemma (unless it's "-PRON-" for instance)
sp$token <- ifelse(!grepl("^\\-[A-Z]+\\-$", sp$lemma), sp$lemma, sp$token)

Для ваших вариантов сленга нам нужно определить эквивалентности вручную, что мы можем сделать с помощью quanteda"словарь". 

library("quanteda", warn.conflicts = FALSE)
## Package version: 2.0.1
## Parallel computing: 2 of 8 threads used.
## See https://quanteda.io for tutorials and examples.

# define equivalencies for please variants
dict <- dictionary(list(
  please = c("please", "pls", "plz"),
  girl = c("girl", "gal")
))

Мы воспользуемся этим через минуту. Сначала давайте создадим объект токенов из проанализированного вывода spacyr и удалим знаки препинания. 

toks <- as.tokens(sp) %>%
  tokens(remove_punct = TRUE)
toks
## Tokens consisting of 2 documents.
## text1 :
##  [1] "the"  "girl" "and"  "the"  "girl" "give" "all"  "they" "have" "to"  
## [11] "give"
## 
## text2 :
## [1] "pls"    "say"    "plz"    "please" "gal"

Удаление стоп-слов легко с помощью функции tokens_remove(). 

# now remove stopwords
toks <- tokens_remove(toks, c(stopwords("en"), new_stopwords))
toks
## Tokens consisting of 2 documents.
## text1 :
## [1] "girl" "girl" "give" "give"
## 
## text2 :
## [1] "pls"    "say"    "plz"    "please" "gal"

А теперь чтобы сделать варианты «девушка» и «пожалуйста» эквивалентными, мы используем tokens_lookup(): 

toks <- tokens_lookup(toks, dictionary = dict, exclusive = FALSE, capkeys = FALSE)
toks
## Tokens consisting of 2 documents.
## text1 :
## [1] "girl" "girl" "give" "give"
## 
## text2 :
## [1] "please" "say"    "please" "please" "girl"

. Для анализа настроений вы можете применить словарь настроений, используя tokens_lookup() снова, и создать dfm (document- особенность матрицы) из этого. (Примечание: «сказать» на самом деле не является отрицательным словом, но я использую его как таковой для примера здесь.) 

sentdict <- dictionary(list(
    positive = c("nice", "good", "please", "give"),
    negative = c("bad", "say")
))
tokens_lookup(toks, dictionary = sentdict) %>%
    dfm()
## Document-feature matrix of: 2 documents, 2 features (25.0% sparse).
##        features
## docs    positive negative
##   text1        2        0
##   text2        3        1
...