Bigramy
W trakcie kilku poprzednich zajêæ korzystali¶my czêsto z funkcji unnest_tokens(), aby rozbiæ zwarty tekst na poszczególne tokeny -- w tym przypadku pojedyncze s³owa. Jest to bezpo¶rednie zastosowanie znanego modelu bag-of-words, czyli przypadku, gdy traktujemy pojedyncze s³owa jako wrzucone do torby i przemieszane ze sob±.
Tak jak poprzednio, wykorzystamy zbiór trzech ksi±¿ek Juliusza Verne'a:
# PRZYK£AD 5.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, unionlibrary(tidytext)
library(magrittr)
library(ggplot2)## Registered S3 methods overwritten by 'ggplot2':
## method from
## [.quosures rlang
## c.quosures rlang
## print.quosures rlangg <- gutenberg_works()
v <- gutenberg_download(c(83, 103, 1268))## Determining mirror for Project Gutenberg from http://www.gutenberg.org/robot/harvest## Using mirror http://aleph.gutenberg.orgbooks <- g[g$gutenberg_id %in% c(83, 103, 1268),c("gutenberg_id","title")]
v %<>% left_join(books) %>%
mutate(gutenberg_id = NULL)## Joining, by = "gutenberg_id"Wykonujemy podobne operacje, jak na poprzednich zajêciach, tzn. zliczamy poszczególne s³owa w ka¿dej z trzech ksi±¿ek i dodatkowo dok³adamy ca³kowita liczbê s³ów
# PRZYK£AD 5.2
verne_bigrams <- v %>%
unnest_tokens(bigram, text, token = "ngrams", n = 2)
verne_bigrams## # A tibble: 350,189 x 2
## title bigram
## <chr> <chr>
## 1 Around the World in Eighty Days around the
## 2 Around the World in Eighty Days the world
## 3 Around the World in Eighty Days world in
## 4 Around the World in Eighty Days in eighty
## 5 Around the World in Eighty Days eighty days
## 6 Around the World in Eighty Days days contents
## 7 Around the World in Eighty Days contents chapter
## 8 Around the World in Eighty Days chapter i
## 9 Around the World in Eighty Days i in
## 10 Around the World in Eighty Days in which
## # ... with 350,179 more rowsZliczanie i filtrowanie bi- i n-gramów
Podobnie jak w przypadku unigramów mo¿emy korzystaæ z funkcji pakietu dplyr do zliczania poszczególnych tokenów.
# PRZYK£AD 5.3
verne_bigrams %>%
count(bigram, sort = TRUE)## # A tibble: 140,387 x 2
## bigram n
## <chr> <int>
## 1 of the 4492
## 2 in the 1732
## 3 to the 1610
## 4 on the 1304
## 5 it was 1145
## 6 and the 987
## 7 at the 798
## 8 by the 756
## 9 from the 708
## 10 that the 628
## # ... with 140,377 more rowsOczywi¶cie, nie jest ¿adnym zaskoczeniem to, co przed chwila zaobserwowali¶my -- najczê¶ciej wystêpuj± typowe zbitki s³ów sk³adaj±ce siê na funkcyjne wyra¿enia w jêzyku angielskim. Aby siê pozbyæ tych wyra¿eñ, mogliby¶my wyszukaæ poszczególne s³owa za pomoc± wyra¿eñ regularnych, korzystaj±c ze zbioru stop_words. £atwiej jednak dokonaæ rozbicia posczególnych wyra¿eñ na dwa s³owa za pomoc± funkcji separate() z pakietu tidyr. Funkcja ta rozk³ada dan± kolumnê korzystaj±c z podanego wzorca (w naszym przypadku to po prostu spacja). Nastêpnie w ka¿dej kolumnie usuwamy s³owa kluczowe i je zliczamy.
# PRZYK£AD 5.4
library(tidyr)##
## Attaching package: 'tidyr'## The following object is masked from 'package:magrittr':
##
## extractbigrams_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)
bigram_counts <- bigrams_flt %>%
count(word1, word2, sort = TRUE)
bigram_counts## # A tibble: 27,353 x 3
## word1 word2 n
## <chr> <chr> <int>
## 1 cyrus harding 534
## 2 granite house 329
## 3 gideon spilett 292
## 4 phileas fogg 241
## 5 michel ardan 200
## 6 lincoln island 174
## 7 gun club 109
## 8 replied barbicane 86
## 9 replied pencroft 78
## 10 prospect heights 76
## # ... with 27,343 more rowsJak widac typowe znacz±ce po³aczenia to nazwy w³asne (imiê + nazwisko) lub lokazlizacje. Gdyby¶my z jakich¶ powodów chcieli dokonaæ powtórnego "zlepienia" poszczególnych s³ów mo¿emy wykorzystaæ do tego funkcjê unite() z tidyr.
# PRZYK£AD 5.5
bigrams_uni <- bigrams_flt %>%
unite(bigram, word1, word2, sep = " ")
bigrams_uni## # A tibble: 37,035 x 2
## title bigram
## <chr> <chr>
## 1 Around the World in Eighty Days eighty days
## 2 Around the World in Eighty Days days contents
## 3 Around the World in Eighty Days contents chapter
## 4 Around the World in Eighty Days phileas fogg
## 5 Around the World in Eighty Days passepartout accept
## 6 Around the World in Eighty Days ideal iii
## 7 Around the World in Eighty Days conversation takes
## 8 Around the World in Eighty Days cost phileas
## 9 Around the World in Eighty Days phileas fogg
## 10 Around the World in Eighty Days fogg dear
## # ... with 37,025 more rowsRzecz jasna, stosuj±c podobn± procedurê rozk³adania na poszczególne s³owa i usuwania s³ów kluczowych, mo¿emy równie¿ otrzymaæ n-gramy z \(n > 2\), np. trigramy:
# PRZYK£AD 5.6
v %>%
unnest_tokens(trigram, text, token = "ngrams", n = 3) %>%
separate(trigram, c("word1", "word2", "word3"), sep = " ") %>%
filter(!word1 %in% stop_words$word,
!word2 %in% stop_words$word,
!word3 %in% stop_words$word) %>%
count(word1, word2, word3, sort = TRUE)## # A tibble: 9,197 x 4
## word1 word2 word3 n
## <chr> <chr> <chr> <int>
## 1 replied cyrus harding 42
## 2 exclaimed michel ardan 26
## 3 replied gideon spilett 22
## 4 answered cyrus harding 19
## 5 replied michel ardan 17
## 6 twenty thousand pounds 17
## 7 harding gideon spilett 13
## 8 gideon spilett herbert 12
## 9 observed gideon spilett 12
## 10 sir francis cromarty 12
## # ... with 9,187 more rowsAnaliza n-gramów
Korzystaj±c z uzyskanego przez nas formatu bigramów ³atwo jest wykonaæ proste zadania eksploracyjne, np. we wszystkich ksi±¿kach rzeczownik "wyspa" i sprawdziæ jakie okre¶lenia s± do niego przypisane:
# PRZYK£AD 5.7
bigrams_flt %>%
filter(word2 == "island") %>%
count(title, word1, sort = TRUE)## # A tibble: 23 x 3
## title word1 n
## <chr> <chr> <int>
## 1 The Mysterious Island lincoln 174
## 2 The Mysterious Island tabor 75
## 3 The Mysterious Island desert 5
## 4 The Mysterious Island norfolk 4
## 5 Around the World in Eighty Days rock 2
## 6 The Mysterious Island unknown 2
## 7 Around the World in Eighty Days fire 1
## 8 Around the World in Eighty Days noble 1
## 9 Around the World in Eighty Days uninhabited 1
## 10 From the Earth to the Moon; and, Round the Moon melville 1
## # ... with 13 more rowsBigram mo¿emy traktowaæ podobnie jak unigramy, tzn np. policzyæ dla niego transformacjê TF-IDF
# PRZYK£AD 5.8
bigram_tf_idf <- bigrams_uni %>%
count(title, bigram) %>%
bind_tf_idf(bigram, title, n) %>%
arrange(desc(tf_idf))
bigram_tf_idf## # A tibble: 28,069 x 6
## title bigram n tf idf tf_idf
## <chr> <chr> <int> <dbl> <dbl> <dbl>
## 1 Around the World in Eighty Days phileas fogg 241 0.0319 1.10 0.0350
## 2 The Mysterious Island cyrus hardi... 534 0.0283 1.10 0.0311
## 3 From the Earth to the Moon; an... michel ardan 200 0.0188 1.10 0.0207
## 4 The Mysterious Island granite hou... 329 0.0174 1.10 0.0192
## 5 The Mysterious Island gideon spil... 292 0.0155 1.10 0.0170
## 6 From the Earth to the Moon; an... gun club 109 0.0103 1.10 0.0113
## 7 The Mysterious Island lincoln isl... 174 0.00923 1.10 0.0101
## 8 Around the World in Eighty Days hong kong 63 0.00833 1.10 0.00915
## 9 From the Earth to the Moon; an... replied bar... 86 0.00810 1.10 0.00890
## 10 Around the World in Eighty Days sir francis 53 0.00701 1.10 0.00770
## # ... with 28,059 more rowsPodobnie, korzystaj±c z pakietu ggplot2 mamy szanse przedstawiæ porównanie pomiêdzy poszczególnymi rozpatrywanymi przez nas ksi±¿kami.
# PRZYK£AD 5.9
library(ggplot2)
theme_set(theme_bw())
bigram_tf_idf %>%
group_by(title) %>%
top_n(10) %>%
ungroup() %>%
mutate(bigram = reorder(bigram, tf_idf)) %>%
ggplot() +
geom_col(aes(bigram, tf_idf, fill = title)) +
coord_flip() +
facet_wrap(~title, nrow = 2, scales = "free") +
theme(legend.position = "bottom")## Selecting by tf_idf
Grafy
Czasem bardzo wygodn± metod± wizualizacji po³±czen s³ów s± sieci. W ogólnym ujêciu sieæ z³o¿ona to uk³ad w którym wyró¿niamy wêz³y, bêd±ce reprezentacj± jakich¶ bytów (cz³owiek, strona WWW, zwi±zek chemiczny) oraz po³±czeñ, które oddaj± relacje pomiêdzy nimi (znajomo¶æ, hiperlink, reakcja).
# PRZYK£AD 5.10
library(igraph)##
## Attaching package: 'igraph'## The following object is masked from 'package:tidyr':
##
## crossing## The following objects are masked from 'package:dplyr':
##
## as_data_frame, groups, union## The following objects are masked from 'package:stats':
##
## decompose, spectrum## The following object is masked from 'package:base':
##
## unionbigram_graph <- bigram_counts %>%
filter(n > 20) %>%
graph_from_data_frame()
bigram_graph## IGRAPH bb58ffa DN-- 74 55 --
## + attr: name (v/c), n (e/n)
## + edges from bb58ffa (vertex names):
## [1] cyrus ->harding granite ->house gideon ->spilett
## [4] phileas ->fogg michel ->ardan lincoln ->island
## [7] gun ->club replied ->barbicane replied ->pencroft
## [10] prospect ->heights tabor ->island hong ->kong
## [13] mount ->franklin captain ->nemo hundred ->feet
## [16] sir ->francis captain ->harding thousand ->pounds
## [19] half ->past cried ->pencroft exclaimed->michel
## [22] replied ->herbert replied ->cyrus san ->francisco
## + ... omitted several edgesPakiet igraph przeci±¿a funkcjê plot() tak, ¿e mo¿lwie jest wykre¶lenie relacji w postaci grafu:
# PRZYK£AD 5.10
plot.graph <- function(g) {
plot(g, vertex.size = 0, edge.arrow.size = 0.75)
}
plot.graph(bigram_graph)