Подсчет слов в тексте на основе лексики

Question

У меня есть такие данные:

library(dplyr)

glimpse(samp)
Observations: 10
Variables: 2
$ text <chr> "@VirginAmerica What @dhepburn said.", "@VirginAmerica plus you've ...
$ airline_sentiment <chr> "neutral", "positive", "neutral", "negative", "negative", "negative...

Я хочу сравнить вхождение слов в текстовой переменной со словами в лексиконе, т. Е. Я хочу посчитать, как часто в тексте появляется определенное слово на основе лексикона.

Лексикон выглядит так

library(lexicon)
hash_sentiment_sentiword[1:5]
             x     y
1:    365 days -0.50
2:    366 days  0.25
3:         3tc -0.25
4:  a fortiori  0.25
5: a good deal  0.25

Я знаю, что есть такие функции, как str_detect. Однако из этого я получаю только значения true / false.

Результат должен быть таким (псевдокод):

   text     x        y      n    
1. word 1   word 1   score  2
2. word 2   word 2   score  1
3. word 3   word 3   score  10
4. word 4   word 4   score  0
5. word 5   word 5   score  0
...

текст: слово текстового столбца из samp; x и y: столбец x и y из hash_sentiment_sentiword; n: частота появления слова x в тексте. Например, слово «удивительный» находится в x и встречается в тексте один раз. Так что для «удивительного» n будет 1. «страна» не в х, а в тексте. Так что п будет 0.

Вот маленький dput():

dput(samp)

structure(list(text = c("@VirginAmerica Thanks!", "@VirginAmerica SFO-PDX schedule is still MIA.", 
"@VirginAmerica So excited for my first cross country flight LAX to MCO I've heard nothing but great things about Virgin America. #29DaysToGo", 
"@VirginAmerica  I flew from NYC to SFO last week and couldn't fully sit in my seat due to two large gentleman on either side of me. HELP!", 
"I <U+2764><U+FE0F> flying @VirginAmerica. <U+263A><U+FE0F><U+0001F44D>", 
"@VirginAmerica you know what would be amazingly awesome? BOS-FLL PLEASE!!!!!!! I want to fly with only you."
), airline_sentiment = c("positive", "negative", "positive", 
"negative", "positive", "positive")), row.names = 15:20, class = "data.frame")

Answer 1

Вот база R решение

# create an array of all the words in samp$text
# optional: use regex to remove punctuation symbols (this can be refined)
textWords <- unlist(strsplit(gsub('[[:punct:]]','',samp$text,perl=TRUE), ' '))
# count occurences of each word and store it as data frame
occurences <- unique(data.frame(text = textWords, 
                                n = as.integer(ave(textWords, textWords, FUN = length)), 
                                stringsAsFactors = FALSE))

# get words of x with scores y
xWordsList <- setNames(strsplit(lexicon::hash_sentiment_sentiword$x, ' '), 
                       lexicon::hash_sentiment_sentiword$y)

# create the result data frame
res <- data.frame(x = unlist(xWordsList), y = rep(names(xWordsList), lengths(xWordsList)))
rm(xWordsList) # removing as object is rather large and not needed anymore

# subset to keep only x elements which are in text
res <- res[res$x %in% textWords,]
# match occurences
res$n <- vapply(1:nrow(res), 
                function (k) occurences$n[occurences$text == res$x[k]], 
                integer(1))
rownames(res) <- 1:nrow(res)

# a glimpse at the result
head(res)
#       x      y n
# 1 great 0.3125 1
# 2    in -0.125 1
# 3 about   0.25 1
# 4    of  0.125 1
# 5    of -0.125 1
# 6    to  0.125 4

Это может быть улучшено (например, через .subset2 или уточнение regex) здесь и там. Также обратите внимание, что я опустил столбец text в res, так как этот столбец по определению идентичен столбцу x.

Answer 2

Один из способов сделать это, и их столько же, сколько пакетов для анализа текста, - использовать tidytext. Я выбрал tidytext, потому что вы используете dplyr, и с этим приятно играть. Я использую inner_join, чтобы присоединиться к лексикону с вашими данными. Измените это на left_join, если вы хотите сохранить слова, которые не совпадают в лексиконе.

library(tidytext)
library(dplyr)
samp %>% 
  unnest_tokens(text, output = "words", token = "tweets") %>% 
  inner_join(lexicon::hash_sentiment_sentiword, by = c("words" = "x")) %>% 
  group_by(words, y) %>% 
  summarise(n = n()) 

# A tibble: 20 x 3
# Groups:   words [?]
   words          y     n
   <chr>      <dbl> <int>
 1 about      0.25      1
 2 amazingly  0.125     1
 3 cross     -0.75      1
 4 due        0.25      1
 5 excited    0         1
 6 first      0.375     1
 7 fly       -0.5       1
 8 fully      0.375     1
 9 help       0.208     1
10 know       0.188     1
11 large     -0.25      1
12 last      -0.208     1
13 lax       -0.375     1
14 on         0.125     1
15 please     0.125     1
16 side      -0.125     1
17 still     -0.107     1
18 thanks     0         1
19 virgin     0.25      1
20 want       0.125     1

дополнительная информация для tidytext: интеллектуальный анализ текста с R

представление задачи крана Программирование на естественном языке

другие пакеты: quanteda, qdap, sentimentr, udpipe