Eksploracja tekstu i wyszukiwanie informacji w mediach społeczno¶ciowych

LABORATORIUM 6

Słownikowa analiza sentymentu

Analiza sentymentu (sentiment analysis - SA) jest jednym z najistotniejszych działów text miningu. Jak sama nazwa wskazuje, zajmuje się ocen± zawarto¶ci emocjonalnej, która można uzyskać analizuj±c dan± próbkę tekstu. Ogólnie można pwoiedzieć, że dwoma głównymi podej¶ciami w SA s± metody bez nadzory oraz pod nadzorem. Pierwsza gama metod wykorzystuje najczę¶ciej uprzednio stworzone leksykony emocjonalne i opieraj±c się na nich ocenia sentument w tek¶cie. Druga to typowe podje¶cie typu data mining - na zbiorze ucz±cym trenujemy okre¶lony algorytm, aby póĽniej stosować go do innych danych. Na dzisiejszych zajęciach zajmiemy się pierwsz± metod± (w najprostszym wydaniu).

Wykorzystamy zbiór czterach ksi±żek Juliusza Verne'a:

# PRZYKŁAD 6.1

library(gutenbergr)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(magrittr)
library(tidytext)
library(tidyr)
## 
## Attaching package: 'tidyr'
## The following object is masked from 'package:magrittr':
## 
##     extract
library(ggplot2)

 g <- gutenberg_works()
 
 id <- c(83, 103, 164, 1268)
 verne <- gutenberg_download(id)
## Determining mirror for Project Gutenberg from http://www.gutenberg.org/robot/harvest
## Using mirror http://aleph.gutenberg.org
 books <- g[g$gutenberg_id %in% id, c("gutenberg_id","title")]
 
 verne %<>% left_join(books) %>%
    mutate(gutenberg_id = NULL)
## Joining, by = "gutenberg_id"

I tak jak poprzednio, rozbijamy zbiory na poszczególne tokeny - czyli słowa.

# PRZYKŁAD 6.2

verne_books <- verne %>%
  group_by(title) %>%
  mutate(linenumber = row_number()) %>%
  ungroup() %>%
  unnest_tokens(word, text)

Słownik tidytext

Teraz, oczywi¶cie, kluczow± spraw± jest zdobycie jakiego¶ słownika, który powi±że nam poszczególne słowa z zawartymi w nich emocjami. Bibioteka tidytext udostępnia zbiór danych sentiments, będ±cy de facto zbiorem aż czterech oddzielnych leksykonów: NRC, Bing, Finn Arup Nielsen i Loughran. Każdy z nich w inny sposób opisuje emocje: drugi podaje warto¶ci numeryczne z zakresu \([-5; 5]\), trzy pozostałe korzystaj± z opisowego okre¶lenia sentymentu. Do każdego słownika mozna dostać się za pomoc± wrappera get_sentiments(). Poniżej wypiszemy emocje, które zwraca slownik NRC.

# PRZYKŁAD 6.3

sentiments
## # A tibble: 27,314 x 4
##    word        sentiment lexicon score
##    <chr>       <chr>     <chr>   <int>
##  1 abacus      trust     nrc        NA
##  2 abandon     fear      nrc        NA
##  3 abandon     negative  nrc        NA
##  4 abandon     sadness   nrc        NA
##  5 abandoned   anger     nrc        NA
##  6 abandoned   fear      nrc        NA
##  7 abandoned   negative  nrc        NA
##  8 abandoned   sadness   nrc        NA
##  9 abandonment anger     nrc        NA
## 10 abandonment fear      nrc        NA
## # ... with 27,304 more rows
nrc <- get_sentiments("nrc")

table(nrc$sentiment)
## 
##        anger anticipation      disgust         fear          joy 
##         1247          839         1058         1476          689 
##     negative     positive      sadness     surprise        trust 
##         3324         2312         1191          534         1231

Korzystaj±c z takiego zbioru możemy np. okre¶lić jakie słowa w wybranych ksi±żkach odpowiadaj± za negatywny lub pozytywny sentyment

# PRZYKŁAD 6.4

pos_neg <- verne_books %>%
  inner_join(nrc) %>%
  filter(sentiment %in% c("positive", "negative")) %>%
  group_by(sentiment) %>%
  count(word, sort = T) %>%
  top_n(10, n) %>%
  ungroup() %>%
  mutate(word = reorder(word, n))
## Joining, by = "word"
ggplot(pos_neg) + geom_col(aes(word, n, fill = sentiment)) + 
  coord_flip() + 
  facet_wrap( ~ sentiment, scales = "free")

W podobny sposób okre¶limy emocje inne niż tylko negatywny/pozytywny.

# PRZYKŁAD 6.5

nrc_class <- verne_books %>%
  filter(title == books[["title"]][2]) %>%
  inner_join(nrc) %>%
  filter(!(sentiment %in% c("positive", "negative"))) %>%
  group_by(sentiment) %>%
  count(word, sort = T) %>%
  top_n(10, n) %>%
  ungroup() %>%
  mutate(word = reorder(word, n))
## Joining, by = "word"
ggplot(nrc_class) + geom_col(aes(word, n, fill = sentiment), show.legend = FALSE) + 
  coord_flip() + 
  facet_wrap(~sentiment, nrow = 3, scales = "free")

Emocje w sekcjach tekstu

Poprzednio wyznaczali¶my warto¶ci emocji w całych tekstach, ale oczywi¶cie tekst nie zawsze jest zwarta i jednolit± jednostk±. St±d sens ma rozłożenie ksi±żki na poszczególne fragmenty, i badania jak zmienia się sentyment w trakcie jak toczy się fabuła. Tym razem wykorzystamy słownik bing oraz funkcję spread(), która, jak sama nazwa wskazuje, rozrzuca warto¶ci po kolumnach.

# PRZYKŁAD 6.6

verne_senti_bing <- verne_books %>%
  inner_join(get_sentiments("bing")) %>%
  count(title, index = linenumber %/% 80, sentiment) 
## Joining, by = "word"
verne_senti_bing
## # A tibble: 1,393 x 4
##    title                           index sentiment     n
##    <chr>                           <dbl> <chr>     <int>
##  1 Around the World in Eighty Days     0 negative      7
##  2 Around the World in Eighty Days     0 positive     15
##  3 Around the World in Eighty Days     1 negative      8
##  4 Around the World in Eighty Days     1 positive     19
##  5 Around the World in Eighty Days     2 negative     12
##  6 Around the World in Eighty Days     2 positive     25
##  7 Around the World in Eighty Days     3 negative      9
##  8 Around the World in Eighty Days     3 positive     31
##  9 Around the World in Eighty Days     4 negative     16
## 10 Around the World in Eighty Days     4 positive     36
## # ... with 1,383 more rows
verne_senti_bing %<>%
  spread(sentiment, n, fill = 0) 

verne_senti_bing
## # A tibble: 697 x 4
##    title                           index negative positive
##    <chr>                           <dbl>    <dbl>    <dbl>
##  1 Around the World in Eighty Days     0        7       15
##  2 Around the World in Eighty Days     1        8       19
##  3 Around the World in Eighty Days     2       12       25
##  4 Around the World in Eighty Days     3        9       31
##  5 Around the World in Eighty Days     4       16       36
##  6 Around the World in Eighty Days     5        6       24
##  7 Around the World in Eighty Days     6       13       22
##  8 Around the World in Eighty Days     7       15       13
##  9 Around the World in Eighty Days     8        9       18
## 10 Around the World in Eighty Days     9       18       26
## # ... with 687 more rows
verne_senti_bing %<>%
  mutate(sentiment = positive - negative)

ggplot(verne_senti_bing, aes(index, sentiment, fill = title)) +
  geom_col(show.legend = FALSE) +
  facet_wrap( ~ title, ncol = 2, scales = "free_x")

Słowniki dostępne w pakiecie tidytext nie s±, rzecz jasna, jedynymi dostępnymi materiałami zwi±zanymi z sentymentem. W 2013 roku została opublikowana interesuj±ca praca przez Amy Warriner i współpracowników, w której zawarto warto¶ci walencji, pobudzenia i dominancji prawie 14000 angielskich słów. Jak zostało wspomniane na Wykładzie 5, walencja i pobudzenie do dwie często wykorzystywane składowe emocji, pierwsza mówi o nacechowaniu emocji (negatywna, pozytywna), druga o intensywno¶ci. We wspomnianej pracy dla obu zmiennych pojawiaj± się warto¶ci w skali \([1; 9]\). Zbiór ma kilkadziesi±t kolumn, ale nas interesuje jedynie ¶rednia walencja i pobudzenie poszczególnych słów:

# PRZYKŁAD 6.7

emo <- as_tibble(read.csv("http://www.fizyka.pw.edu.pl/~julas/TEXT/lab/Ratings_Warriner_et_al.csv", stringsAsFactors = F))
emo
## # A tibble: 13,915 x 65
##        X Word  V.Mean.Sum V.SD.Sum V.Rat.Sum A.Mean.Sum A.SD.Sum A.Rat.Sum
##    <int> <chr>      <dbl>    <dbl>     <int>      <dbl>    <dbl>     <int>
##  1     1 aard.       6.26     2.21        19       2.41     1.4         22
##  2     2 abal.       5.3      1.59        20       2.65     1.9         20
##  3     3 aban.       2.84     1.54        19       3.73     2.43        22
##  4     4 aban.       2.63     1.74        19       4.95     2.64        21
##  5     5 abbey       5.85     1.69        20       2.2      1.7         20
##  6     6 abdo.       5.43     1.75        21       3.68     2.23        22
##  7     7 abdo.       4.48     1.59        23       3.5      1.82        22
##  8     8 abdu.       2.42     1.61        19       5.9      2.57        20
##  9     9 abdu.       2.05     1.31        19       5.33     2.2         21
## 10    10 abide       5.52     1.75        21       3.26     2.22        23
## # ... with 13,905 more rows, and 57 more variables: D.Mean.Sum <dbl>,
## #   D.SD.Sum <dbl>, D.Rat.Sum <int>, V.Mean.M <dbl>, V.SD.M <dbl>,
## #   V.Rat.M <int>, V.Mean.F <dbl>, V.SD.F <dbl>, V.Rat.F <int>,
## #   A.Mean.M <dbl>, A.SD.M <dbl>, A.Rat.M <int>, A.Mean.F <dbl>,
## #   A.SD.F <dbl>, A.Rat.F <int>, D.Mean.M <dbl>, D.SD.M <dbl>,
## #   D.Rat.M <int>, D.Mean.F <dbl>, D.SD.F <dbl>, D.Rat.F <int>,
## #   V.Mean.Y <dbl>, V.SD.Y <dbl>, V.Rat.Y <int>, V.Mean.O <dbl>,
## #   V.SD.O <dbl>, V.Rat.O <int>, A.Mean.Y <dbl>, A.SD.Y <dbl>,
## #   A.Rat.Y <int>, A.Mean.O <dbl>, A.SD.O <dbl>, A.Rat.O <int>,
## #   D.Mean.Y <dbl>, D.SD.Y <dbl>, D.Rat.Y <int>, D.Mean.O <dbl>,
## #   D.SD.O <dbl>, D.Rat.O <int>, V.Mean.L <dbl>, V.SD.L <dbl>,
## #   V.Rat.L <int>, V.Mean.H <dbl>, V.SD.H <dbl>, V.Rat.H <int>,
## #   A.Mean.L <dbl>, A.SD.L <dbl>, A.Rat.L <int>, A.Mean.H <dbl>,
## #   A.SD.H <dbl>, A.Rat.H <int>, D.Mean.L <dbl>, D.SD.L <dbl>,
## #   D.Rat.L <int>, D.Mean.H <dbl>, D.SD.H <dbl>, D.Rat.H <int>
emo <- emo %>% 
  select(word = Word, valence = V.Mean.Sum, arousal = A.Mean.Sum)
emo
## # A tibble: 13,915 x 3
##    word        valence arousal
##    <chr>         <dbl>   <dbl>
##  1 aardvark       6.26    2.41
##  2 abalone        5.3     2.65
##  3 abandon        2.84    3.73
##  4 abandonment    2.63    4.95
##  5 abbey          5.85    2.2 
##  6 abdomen        5.43    3.68
##  7 abdominal      4.48    3.5 
##  8 abduct         2.42    5.9 
##  9 abduction      2.05    5.33
## 10 abide          5.52    3.26
## # ... with 13,905 more rows

Maj±c już wczytany zbiór, możemy pokusić się o stworzenie podobnego wykresu, co poprzednio, tyle, że korzystaj±c z innych danych.

# PRZYKŁAD 6.8

verne_senti_warriner <- verne_books %>%
  inner_join(emo) %>%
  group_by(title, index = linenumber %/% 80) %>%
  summarise(valence = mean(valence))
## Joining, by = "word"
ggplot(verne_senti_warriner, aes(index, valence, color = title)) +
  geom_point(show.legend = FALSE) + 
  geom_line(show.legend = FALSE) +
  facet_wrap( ~ title, ncol = 2, scales = "free_x")

Emocjonalny wordcloud

Chmury słów (wordclouds) s± bardzo często wykorzystywanym narzędziem do wizualizacji istotno¶ci (np. liczby) słów w danym dokumencie. Tym wygodniejsze jest ubranie tej metody w możliwo¶ć wy¶wietlania w różny sposób słów pozytywnych i negatywnych. Wkorzystamy tu funkcję acast() z pakietu reshape2, która po prostu w zgrabny sposób transformuje zliczenia słów jako pozytywnych i negatywnych, a następnie "nagniemy" funkcję comparison.cloud(), która w swoim zamy¶le ma porównywać słowa z różnych dokumentów.

# PRZYKŁAD 6.9

library(reshape2)
## 
## Attaching package: 'reshape2'
## The following object is masked from 'package:tidyr':
## 
##     smiths
library(wordcloud)
## Loading required package: RColorBrewer
verne_books %>%
  inner_join(get_sentiments("bing")) %>%
  count(word, sentiment, sort = TRUE) %>%
  acast(word ~ sentiment, value.var = "n", fill = 0) %>%
  comparison.cloud(colors = c("red", "darkgreen"),
                   max.words = 100)
## Joining, by = "word"

Model Russela

Zgodnie z Wykładem 5, emocje opisane za pomoc± walencji i pobudzenia tworz± tzw. model kołowy Russela. Korzystaj±c z dostępnych danych można sprawdzić, na ile ten model faktycznie jest adekwatny do rzeczywisto¶ci. Na pocz±tek sprawdĽmy jak wygl±daj± we współrzędnych walencja-pobudzenie słowa ze słownika NRC.

# PRZYKŁAD 6.10

sent <- nrc %>% 
  filter(!(sentiment %in% c("negative", "positive")))

sent_comb <- inner_join(sent, emo)
## Joining, by = "word"
ggplot(sent_comb, aes(x = valence, y = arousal)) +
  geom_point(size = 1)

Jak widać, ciężko jest uzyskac duzy rozrzut pobudzenia dla obiektywnych warto¶ci walencji. Ciekawe może okazać się wypisanie najbardziej skrajnych słów.

# PRZYKŁAD 6.11

ggplot(sent_comb %>% filter(abs(arousal - 5) > 1.5 & abs(valence - 5) > 1.5), aes(x = valence, y = arousal)) +
  geom_point(size = 0) + 
  geom_text(aes(label = word), size = 4)

Dla nas istotne jest to, że możemy bezpo¶rednio powi±zać poszczególne emocje (strach, rado¶ć etc) i warto¶ciami walencji \(v\) i pobudzenia \(a\). W tym celu histogramujemy ile słów o konkretnej emocji znajduje się w okre¶lonym punkcie \(v\), \(a\).

# PRZYKŁAD 6.12
ggplot(sent_comb) + 
  geom_bin2d(aes(x = valence, y = arousal)) + 
  facet_wrap(~sentiment)

Wreszcie, po dokonaniu u¶rednienia możemy porównać otrzymane pozycje emocji z modelem Russela.

# PRZYKŁAD 6.13

sent_comb_sum <- sent_comb %>% 
  group_by(sentiment) %>% 
  summarise(valence = mean(valence), arousal = mean(arousal))

ggplot(sent_comb_sum, aes(x = valence, y = arousal)) +
  geom_point(size = 0) + geom_text(aes(label = sentiment))