library(tidyverse)
library(rvest)
library(tidytext)
library(irlba)
library(widyr)
library(stopwords)Тематическое разнообразие сказок Б. Шергина
Введение
В этой серии мы с вами продолжим наблюдать за попытками исследования самых известных сказок Б.В. Шергина. В прошлом эпизоде мы искали поморский компонет в языке сказок, а теперь попробуем посмотреть, есть ли в этих сказках общий лейт-мотив (общая идея), который привел к их популярности (== мультипликации), или они безумно уникальны сами по себе и в этом их сила. В этой серии вас ждет захватывающее приключение с косяками в мир определения тематического разнообразия с помощью LSA и векторного представления слов. Кроме того, мы попробуем определить есть ли сходство между сказками, используя косинусную близость.
Гипотезы
- Как мы помним, тема, в нашем случае, сказки может определяться контекстами, т.е. суммой слов. Мы ожидаем, что тема каждой сказки будет описана некоторым количеством слов.
- Определить общность тем, или же уникальность, нам поможет косинусное сходство между документами. В том случае, если документы (== сказки) уникальны по тематике, то углы между векторами слов будут большими, и сказки окажутся удалены друг от друга. Если же они сходны между собой, то углы будут небольшими, и сказки окажутся близко друг к другу.
Воплощение в коде. Проверка гипотез.
Подготовка данных
Для начала подгрузим все нужные библиотеки.
Мы будем использовать тот же датасет, что и в прошлый раз. Но, ввиду того, что его не получилось сохранить в формате Rdata, мы проделаем его формирование еще раз. Что тут у нас происходит: сохраняем ссылку, откуда брали данные; читаем html; забираем ссылки на главы и создаем тиббл с названиями сказок и ссылками; создаем функцию, которая заберет тексты сказок; объединяем таблицы; токенизируем текст сказок; убираем стоп-слова и упорядочиваем; переименовываем столбец для удобства.
Http <- "https://peskarlib.ru/b-shergin/"
html_2 <- read_html(Http)
Сказки <- html_2 |>
html_elements(".h2-link")
lib <- tibble(
title = Сказки |>
html_text2(),
href = Сказки |>
html_attr("href"))
Ссылки_сказки <- lib |>
mutate(link = paste0("https://peskarlib.ru", href)) |>
select(-href)
https <- Ссылки_сказки |>
pull(link)
pick_up_the_text <- function(url) {
read_html(url) |>
html_elements(".cl-sst") |>
html_text2() |>
paste(collapse= " ")
}
texts <- map(https, pick_up_the_text)
texts <- texts |>
flatten_chr() |>
as_tibble()
Сказки_Шергина <- Ссылки_сказки |>
bind_cols(texts) |>
select(-link)
Сказки_Шергина <- Сказки_Шергина |>
mutate(id = paste0("doc", row_number()))
Сказки_Шергина_слова <- Сказки_Шергина |>
unnest_tokens("word", "value")
stopwords_ru <- c(
stopwords("ru", source = "snowball"),
stopwords("ru", source = "marimo"),
stopwords("ru", source = "nltk"))
stopwords_ru <- sort(unique(stopwords_ru))
idx <- which(stopwords_ru == "жизнь" | stopwords_ru == "человек")
stopwords_ru <- stopwords_ru[-idx]
stopwords_ru <- c(stopwords_ru, "коль", "скоро", "ко", "во", "это", "ладно", "твоего", "обо", "эко", "дак", "што")
Чистые_сказки <- Сказки_Шергина_слова |>
anti_join(tibble(word = stopwords_ru))
Clean_tales <- Чистые_сказки |>
rename(token = word) # Датасет подготовлен!
Clean_tales# A tibble: 12,654 × 3
title id token
<chr> <chr> <chr>
1 Дивный гудочек doc1 отца
2 Дивный гудочек doc1 матери
3 Дивный гудочек doc1 сынок
4 Дивный гудочек doc1 романушко
5 Дивный гудочек doc1 дочка
6 Дивный гудочек doc1 девка
7 Дивный гудочек doc1 восьмуха
8 Дивный гудочек doc1 романушко
9 Дивный гудочек doc1 желанное
10 Дивный гудочек doc1 дитятко
# ℹ 12,644 more rowsВыявление тем
Для начала, осуществим векторное представление слов на основе PMI. Для этого вычислим меру ассоциации PMI и PPMI, а затем выполним сингулярное разложение.
slide_windows <- function(tbl, window_size) {
skipgrams <- slider::slide(
tbl,
~.x,
.after = window_size - 1,
.step = 1,
.complete = TRUE
)
safe_mutate <- safely(mutate)
out <- map2(skipgrams,
1:length(skipgrams),
~ safe_mutate(.x, window_id = .y))
out %>%
transpose() %>%
pluck("result") %>%
compact() %>%
bind_rows()
} # Используем скользящие окна
nested_tales <- Clean_tales |>
nest(tokens = c(token))
tales_windows <- nested_tales |>
mutate(tokens = map(tokens, slide_windows, 8L)) %>%
unnest(tokens) %>%
unite(window_id, id, window_id)
#Подсчитываем меру ассоциации:
tales_pmi <- tales_windows |>
pairwise_pmi(token, window_id)
tales_ppmi <- tales_pmi |>
mutate(ppmi = case_when(pmi < 0 ~ 0,
.default = pmi))
#Делаем SVD:
word_emb <- tales_ppmi |>
widely_svd(item1, item2, ppmi,
weight_d = FALSE, nv = 50) |>
rename(word = item1)Векторное представление слов получено, теперь мы можем посмотреть на тематику сказок Б.В.Шергина. Для этого, проделаем визуализацию 9 главных компонент (по 10 слов).
word_emb |>
filter(dimension < 10) |>
group_by(dimension) |>
top_n(10, abs(value)) |>
ungroup() |>
mutate(word = reorder_within(word, value, dimension)) |>
ggplot(aes(word, value, fill = dimension)) +
geom_col(alpha = 0.9, show.legend = FALSE) +
facet_wrap(~dimension, scales = "free_y", ncol = 3) +
scale_x_reordered() +
coord_flip() +
labs(
x = NULL,
y = "Value",
title = "Тематическое разнообразие сказок Б.Шергина",
subtitle = "Топ-10 слов"
) +
scale_fill_viridis_c()
Определение сходства/уникальности сказок
Чтобы посчитать степень сходства сказок, мы используем, как упоминалось выше, косинусное сходство. Для этого,откатимся немного назад, и проделаем сингулярное разложение на tf-idf. Здесь мы подсчитаем, собственно tf-idf. Затем представим наши данные в разряженном формате и выполним сингулярное разложение с пакетом irlba. Почему используется именно этот способ, с тем что теперь нам нужна матрица не левых, а правых сингулярных векторов, которая хранит информацию о документах.
#Вычисляем tf-idf:
tales_counts <- Clean_tales |>
count(token, id)
tales_tf_idf <- tales_counts |>
bind_tf_idf(token, id, n) |>
arrange(tf_idf) |>
select(-n, -tf, -idf)
tales_tf_idf# A tibble: 9,606 × 3
token id tf_idf
<chr> <chr> <dbl>
1 видит doc1 0
2 видит doc10 0
3 видит doc2 0
4 видит doc3 0
5 видит doc4 0
6 видит doc5 0
7 видит doc6 0
8 видит doc7 0
9 видит doc8 0
10 видит doc9 0
# ℹ 9,596 more rowsmatrix <- tales_tf_idf |>
cast_sparse(token, id, tf_idf)
#Получаем матрицу правых сингулярных векторов:
SVD<- irlba::irlba(matrix, 9)
rownames(SVD$v) <- colnames(matrix)
colnames(SVD$v) <- paste0("dim", 1:9)
tales_emb <- SVD$v |>
as.data.frame() |>
rownames_to_column("doc") |>
as_tibble()
#Приводим данные в длинный формат:
tales_emb_long <- tales_emb |>
pivot_longer(-doc, names_to = "dimension", values_to = "value") |>
mutate(dimension = as.numeric(str_remove(dimension, "dim")))Теперь, когда данные приведены в нужный нам формат, мы считаем косинусную близость наших сказок. Для этого применяем функцию nearest_neighbours.
nearest_neighbors <- function(df, feat, doc=F) {
inner_f <- function() {
widely(
~ {
y <- .[rep(feat, nrow(.)), ]
res <- rowSums(. * y) /
(sqrt(rowSums(. ^ 2)) * sqrt(sum(.[feat, ] ^ 2)))
matrix(res, ncol = 1, dimnames = list(x = names(res)))
},
sort = TRUE
)}
if (doc) {
df |> inner_f()(doc, dimension, value) }
else {
df |> inner_f()(word, dimension, value)
} |>
select(-item2)
}
#Пример работы:
nearest_neighbors(tales_emb_long, "doc4", doc = TRUE)# A tibble: 10 × 3
item1 item2 value
<chr> <int> <dbl>
1 doc4 1 1
2 doc3 1 0.870
3 doc9 1 0.320
4 doc6 1 0.0629
5 doc8 1 0.0520
6 doc1 1 0.00362
7 doc5 1 -0.0202
8 doc10 1 -0.0641
9 doc7 1 -0.0914
10 doc2 1 -0.0941 Результаты
Тематическое разнообразие, безусловно, присутсвует в сказках Б.Шергина, однако, есть сказки, которые не очень сильно, но схожи между собой. Например, сказка “Золоченые лбы” очень близка к сказкам “Мартынко” и “Пронька Грезной”, “Волшебное кольцо”. Совершенно особняком, стоит сказка “Шиш Московский”. Это может быть вызвано тем, что она относится к отдельному циклу сказок про Шиша (Черемисинова 2017).
References
Черемисинова, ЛИ. 2017. “" ПИСАТЕЛЬ-СКАЗИТЕЛЬ": К ВОПРОСУ о ПОЭТИКЕ СКАЗОК БВ ШЕРГИНА.” In Проблемы Филологического Образования, 168–75.