POS
Parts of Speech (POS) tagging, czyli po polsku po prostu "oznaczanie częsci mowy", jak sama nazwa wskazuje, polega na określeniu do jakich części mowy (rzeczownik, czasownik, przymiotnik etc) należą poszczególne słowa znalezione w dokumencie. Jak można się łatwo domyslić, jest dość istotna operacja, szczególnie w kontekście np. pozycjonowania produktów (np. zależy nam na tym, aby poznać przymiotniki, które odnoszą się do danej marki etc.)
Biblioteka tidytext jest wyposażona w bardzo wygodną ramkę danych parts_of_speech, która zbiera ponad 200.000 wyrazów z przypisanymi im częściami mowy:
# PRZYKŁAD 8.1
library(tidytext)
parts_of_speech## # A tibble: 208,259 x 2
## word pos
## <chr> <chr>
## 1 3-d Adjective
## 2 3-d Noun
## 3 4-f Noun
## 4 4-h'er Noun
## 5 4-h Adjective
## 6 a' Adjective
## 7 a-1 Noun
## 8 a-axis Noun
## 9 a-bomb Noun
## 10 a-frame Noun
## # ... with 208,249 more rowsDe facto, wzmiankowanych słów jest kilkanaście tysięcy mniej, ze wzgledu na fakt, że niektóre mają przypisane więcej niż jedna część mowy
# PRZYKŁAD 8.2
library(dplyr)
parts_of_speech %>%
count(word, sort = T)## # A tibble: 191,984 x 2
## word n
## <chr> <int>
## 1 pop 7
## 2 bar 6
## 3 broadcast 6
## 4 clear 6
## 5 close 6
## 6 collect 6
## 7 dash 6
## 8 double 6
## 9 fore 6
## 10 foul 6
## # ... with 191,974 more rowsOczywiście, bardzo interesującą kwestią jest to, które części mowy przeważają w tym słowniku -- da nam to pewien punkt odniesienia, gdy będziemy badać takie rozkłady w konkretnych pozycjach literaturowych.
# PRZYKŁAD 8.3
library(ggplot2)
pos <- parts_of_speech %>%
count(pos, sort = T) %>%
mutate(nn = n / sum(n))
pos## # A tibble: 14 x 3
## pos n nn
## <chr> <int> <dbl>
## 1 Noun 104542 0.502
## 2 Adjective 47719 0.229
## 3 Verb (transitive) 15723 0.0755
## 4 Adverb 13234 0.0635
## 5 Verb (usu participle) 11402 0.0547
## 6 Plural 7764 0.0373
## 7 Verb (intransitive) 4626 0.0222
## 8 <NA> 2274 0.0109
## 9 Interjection 395 0.00190
## 10 Preposition 159 0.000763
## 11 Noun Phrase 115 0.000552
## 12 Pronoun 113 0.000543
## 13 Definite Article 103 0.000495
## 14 Conjunction 90 0.000432ggplot(pos) +
geom_bar(aes(x = reorder(pos, -nn), nn, fill = reorder(pos, nn)), stat="identity") +
coord_flip() + theme(legend.position = "none") +
labs(y = "fraction", x = "POS")
Podobny wykres można, rzecz jasna, otrzymać dla okreslonego zbioru (tu książka Verne'a):
# PRZYKŁAD 8.4
library(gutenbergr)
verne <- gutenberg_download(83)
verne_book <- verne %>%
unnest_tokens(word, text) %>%
left_join(parts_of_speech) %>%
count(pos, sort = T) %>%
mutate(nn = n / sum(n))
verne_book## # A tibble: 13 x 3
## pos n nn
## <chr> <int> <dbl>
## 1 Noun 47974 0.260
## 2 Adverb 26255 0.142
## 3 Definite Article 18882 0.102
## 4 Verb (usu participle) 18801 0.102
## 5 Preposition 16692 0.0904
## 6 Adjective 13321 0.0722
## 7 <NA> 10082 0.0546
## 8 Pronoun 8475 0.0459
## 9 Verb (transitive) 8443 0.0457
## 10 Conjunction 7305 0.0396
## 11 Verb (intransitive) 4955 0.0268
## 12 Interjection 2575 0.0139
## 13 Plural 864 0.00468ggplot(verne_book) +
geom_bar(aes(x = reorder(pos, -nn), nn, fill = reorder(pos, nn)), stat="identity") +
coord_flip() + theme(legend.position = "none") +
labs(y = "fraction", x = "POS")
W takich przypadkach aż się prosi o proównanie "z tłem" - zrobimy to w trochę bardziej wysublimowany sposób:
# PRZYKŁAD 8.5
verne_join <- verne_book %>%
full_join(pos, by = c("pos"))
verne_join## # A tibble: 14 x 5
## pos n.x nn.x n.y nn.y
## <chr> <int> <dbl> <int> <dbl>
## 1 Noun 47974 0.260 104542 0.502
## 2 Adverb 26255 0.142 13234 0.0635
## 3 Definite Article 18882 0.102 103 0.000495
## 4 Verb (usu participle) 18801 0.102 11402 0.0547
## 5 Preposition 16692 0.0904 159 0.000763
## 6 Adjective 13321 0.0722 47719 0.229
## 7 <NA> 10082 0.0546 2274 0.0109
## 8 Pronoun 8475 0.0459 113 0.000543
## 9 Verb (transitive) 8443 0.0457 15723 0.0755
## 10 Conjunction 7305 0.0396 90 0.000432
## 11 Verb (intransitive) 4955 0.0268 4626 0.0222
## 12 Interjection 2575 0.0139 395 0.00190
## 13 Plural 864 0.00468 7764 0.0373
## 14 Noun Phrase NA NA 115 0.000552theme_set(theme_bw())
verne_join %>%
mutate(diff = log10(nn.x / nn.y)) %>%
ggplot() + geom_bar(aes(x = reorder(pos, diff), diff, fill = diff > 0), color = "grey", stat="identity") +
scale_fill_manual(values = c("blue", "red")) +
coord_flip() +
theme(legend.position = "none") +
labs(title="Cos", x = "POS", y = expression(paste(log[10]," ",bgroup("(",frac(n[Verne],n[POS]),")"))))## Warning: Removed 1 rows containing missing values (position_stack).
POS dla bigramów
Podobne rozważania można przeprowadzić w przypadku bigramów. W tym wypadku zwykle wybieramy pewien konkretny rzeczownik, a następnie sprawdzamy wszystkie słowa znajdujące się po jego lewej stronie. Poniżej kod tworzący bigramy dla 5 ksiązek Verne'a (podobny do tego, który wykorzystywaliśmy na zajęciach z \(n\)-gramów):
# PRZYKŁAD 8.6
library(tidytext)
library(tidyr)
g <- gutenberg_works()
ind <- c(16457, 18857, 1268, 2488, 2083)
v <- gutenberg_download(ind)
books <- g[g$gutenberg_id %in% ind,c("gutenberg_id","title")]
verne <- v %>% left_join(books) %>%
mutate(gutenberg_id = NULL)
verne_bigrams <- verne %>%
unnest_tokens(bigram, text, token = "ngrams", n = 2)
bigrams_sep <- verne_bigrams %>%
separate(bigram, c("word1", "word2"), sep = " ")
bigrams_flt <- bigrams_sep %>%
filter(!word1 %in% stop_words$word) %>%
filter(!word2 %in% stop_words$word)
bigrams_flt## # A tibble: 80,682 x 3
## title word1 word2
## <chr> <chr> <chr>
## 1 A Journey to the Centre of the Earth jules verne
## 2 A Journey to the Centre of the Earth verne redactor's
## 3 A Journey to the Centre of the Earth redactor's note
## 4 A Journey to the Centre of the Earth note journey
## 5 A Journey to the Centre of the Earth michaluk numbering
## 6 A Journey to the Centre of the Earth jules verne
## 7 A Journey to the Centre of the Earth farran 1871
## 8 A Journey to the Centre of the Earth portions added
## 9 A Journey to the Centre of the Earth names changed
## 10 A Journey to the Centre of the Earth reprinted version
## # ... with 80,672 more rowsTeraz możemy się już skupić na wyświetleniu najczęściej występujących przymiotników związanych z wyrazem "land"
# PRZYKŁAD 8.7
bigrams_flt %>%
filter(word2 == "land") %>%
left_join(parts_of_speech, by = c("word1" = "word")) %>%
filter(pos == "Adjective") %>%
count(title, word1) %>%
group_by(title) %>%
top_n(10) %>%
ungroup() %>%
mutate(word1 = reorder(word1, n), n) %>%
ggplot() +
geom_bar(aes(x = reorder(word1, n), n), stat="identity") +
coord_flip() +
facet_wrap(~title)
Oczywiście, najciekawszą opcją jest wykorzystanie dodatkowo informacji związanej z sentymentem opracowywanych słów. W tym celu łączymy poprawiamy trochę kod, łącząc nasz zbiór ze słownikiem NRC
# PRZYKŁAD 8.8
nrc <- get_sentiments("nrc")
bigrams_flt %>%
filter(word2 == "land") %>%
left_join(parts_of_speech, by = c("word1" = "word")) %>%
filter(pos == "Adjective") %>%
count(title, word1) %>%
inner_join(nrc, by = c("word1" = "word")) %>%
filter(sentiment %in% c("positive", "negative")) %>%
group_by(title) %>%
top_n(10) %>%
ungroup() %>%
mutate(word1 = reorder(word1, n)) %>%
ggplot() +
geom_bar(aes(x = word1, n, fill = sentiment), stat="identity") +
coord_flip() +
facet_wrap(~title)
Wordnet
Dość ciekawą metodą oceny sentymentu jest użycie tzw "słowosieci" (Wordnet). Potrzebna nam będzie biblioteka wordnet, jak również sciągnięcie ze strony [https://wordnet.princeton.edu/download/current-version] bazy danych, czyli de facto samego słownika. Następnie, po załadowaniu biblioteki, należy za pomocą funkcji setDict() wskazać katalog, przechowujący pliki słownika.
# PRZYKŁAD 8.9
rm(list = ls())
library(wordnet)## Warning in initDict(): cannot find WordNet 'dict' directory: please set the
## environment variable WNHOME to its parentlibrary(magrittr)
library(igraph)
setDict("/home/julas/wordnet/dict/")
verne <- gutenberg_download(83)
# Dodajemy parts of speech
verne_books <- verne %>%
unnest_tokens(word, text) %>%
left_join(parts_of_speech)
verne_books <- verne %>%
unnest_tokens(word, text) %>%
count(word, sort = T)
verne_books %<>%
left_join(parts_of_speech) %>%
filter(pos == "Adjective")Oczywiście, aby skorzystać z metody, musimy stworzyć na własną rękę sieć synonimów. Aby oprzeć się o jakiekolwiek dane, używamy 400 najczęściej występujących słów (przymiotników) w jednej z książek Verne'a, a następnie korzystamy z funkcji synonyms(), szukając dla każdego słowa synonimu.
# PRZYKŁAD 8.10
N <- 400
syn <- lapply(verne_books$word[1:N], synonyms, pos = "ADJ")
from <- unlist(lapply(1:N, function(i) rep(verne_books$word[i], length(syn[[i]]))))
to <- unlist(syn)
syn1 <- lapply(to, synonyms, pos = "ADJ")
from1 <- unlist(lapply(1:length(to), function(i) rep(to[i], length(syn1[[i]]))))
to1 <- unlist(syn1)
df <- tibble(from = c(from, from1), to = c(to, to1))
df$from <- gsub("\\([ap]\\)", "", df$from)
df$to <- gsub("\\([ap]\\)", "", df$to)
df## # A tibble: 17,155 x 2
## from to
## <chr> <chr>
## 1 in in
## 2 in in
## 3 in in
## 4 on on
## 5 said aforementioned
## 6 said aforesaid
## 7 said said
## 8 then then
## 9 only alone
## 10 only lone
## # ... with 17,145 more rowsPoniżej rynsuek sieci dla słowa "dobry" (dokładniej: dla sąsiedztwa o rozmiarze 2)
# PRZYKŁAD 8.11
g <- graph_from_data_frame(df, directed = F)
g <- simplify(g)
g.good <- make_ego_graph(g, order = 2, nodes = V(g)[V(g)$name == "good"])[[1]]
plot(g.good, vertex.size = 5, vertex.color = "#ffaabb55", vertex.label.dist = 0.75, vertex.label.cex = 0.75, vertex.label.color = "black")
Najważniejsze, z naszego punktu widzenia, jest wykorzystanie Wordnetu do określenia wartości emocjonalnej słowa. Poniższa prosta funkcja liczy odległości pomiędzy danym słowem o wyrazami "good" oraz "bad", a następnie ją normuje (przez odległość pomiędzy "good" i "bad").
# PRZYKŁAD 8.12
norm.eval <- shortest.paths(g, "good", "bad")
check.eval <- function(g, query, norm) {
dplus <- shortest.paths(g, query, "good")
dminus <- shortest.paths(g, query, "bad")
return((dminus - dplus)/norm)
}
colors <- c("red", "blue", "black", "white", "green")
sapply(colors, check.eval, g = g, norm = norm.eval)## red blue black white green
## -0.50 -0.50 -0.50 0.25 0.50