Корпусный анализ стихотворений А. С. Пушкина

На материале репозитория открытых данных по русской литературе и фольклору

Автор

Денис Брель

Дата публикации

19 декабря 2025 г.

1 Введение

Объектом исследования является Корпус стихотворений А.С. Пушкина. Данные загружены из Репозитория открытых данных по русской литературе и фольклору Института русской литературы (Пушкинского дома) РАН. Датасет содержит тексты стихотворений с сопутствующими метаданными (Вожик, Казакова, и Лисюков 2023).

Загружаем необходимые пакеты, считываем данные и устанавливаем палитры для визуализаций. Также добавляем возможность воспроизведения исследования через set.seed.

Весь скрипт содержится в скрытых блоках. Чтобы раскрыть блок со скриптом, нажмите на кнопку “Код”. В скрипте предусмотрены как стандартные статические визуализации, так и интерактивные. На данной странице визуализации интерактивные – наведите мышь на график, чтобы увидеть дополнительную информацию.

Код
# Загрузка и подключение пакетов
pkgs <- c(
  "tidyverse","readr","stringr","udpipe","tidytext","topicmodels","widyr","igraph",
  "ggrepel","plotly","broom","slam","purrr","RColorBrewer","scales",
  "wordcloud2","knitr","ggwordcloud"
)
for (p in pkgs) if (!requireNamespace(p, quietly = TRUE)) install.packages(p, repos = "https://cloud.r-project.org")
invisible(suppressWarnings(suppressPackageStartupMessages(lapply(pkgs, library, character.only = TRUE))))

set.seed(20251218)

# Чтение данных
texts_dir <- "texts"
metadata_file <- "metadata.tsv"

meta <- readr::read_tsv(metadata_file, locale = readr::locale(encoding = "UTF-8"), show_col_types = FALSE)
if (!("uid" %in% colnames(meta))) stop("metadata.tsv должен содержать колонку 'uid'.")
if (!("title" %in% colnames(meta))) meta <- meta |> mutate(title = uid)

txt_files <- list.files(texts_dir, pattern = "\\.txt$", full.names = TRUE)
read_poem <- function(path) {
  txt <- paste(readLines(path, encoding = "UTF-8", warn = FALSE), collapse = " ")
  txt <- str_replace_all(txt, "<[^>]+>", " ") |> str_replace_all("\\s+", " ") |> str_trim()
  tibble(uid = basename(path) |> str_remove("\\.txt$"), text = txt)
}
texts_tbl <- purrr::map_dfr(txt_files, read_poem)
texts_with_meta <- texts_tbl |> left_join(meta, by = "uid") |> mutate(title = if_else(is.na(title) | str_trim(title) == "", uid, title))

# Палитры
palette_main <- c("#2E5A75","#6C849D","#9FB1C7")
palette_muted <- c("#CFE7F5","#B7D0E6","#9FB1C7","#7E9FBC","#5E7F9A","#3E5F78")
palette_nodes <- colorRampPalette(RColorBrewer::brewer.pal(8, "Set2"))(12)
include_interactive <- TRUE

2 UDPipe-аннотация

Для обработки данных использованы инструменты корпусной лингвистики: тексты переведены в таблицу, объединены с метаданными и аннотированы с помощью UDPipe (модель UD_Russian-Poetry для русскоязычных поэтических текстов). В результате аннотации каждому токену присвоены лемма и часть речи, проведена очистка от пунктуации и «ё→е» с приравниванием регистра. Ключевой этап – лемматизация и нормализация слов (исключены очень короткие леммы). Таким образом получена таблица anno с колонками token, lemma, upos и др.

Код
# UDPipe-аннотация
udpipe_file <- "UD_Russian-Poetry.udpipe"
ud_model <- udpipe::udpipe_load_model(udpipe_file)
anno_raw <- udpipe::udpipe_annotate(ud_model, x = texts_with_meta$text, doc_id = texts_with_meta$uid, trace = 0)
anno <- as_tibble(anno_raw) |>
  mutate(
    lemma = tolower(ifelse(is.na(lemma) | lemma == "", token, lemma)),
    lemma = str_replace_all(lemma, "ё", "е") |> str_replace_all("[^а-яё-]", "") |> str_squish(),
    token_norm = token |> tolower() |> str_replace_all("ё", "е") |> str_replace_all("[^а-яё-]", "") |> str_squish()
  ) |>
  filter(nchar(lemma) > 1, nchar(token_norm) > 1)

3 Частотный анализ лемм

После предобработки проведён частотный анализ лемм. Из-за нерелевантности служебных частей речи (предлоги, частицы и т.п.) они исключены по тегу upos. Итог – подсчёт частот лемм по корпусу: top_lemmas <- anno |> filter(!(upos %in% exclude_freq_upos)) |> count(lemma, sort=TRUE).

Код
# Частотный анализ лемм и визуализация (бар-плот)
exclude_freq_upos <- c("ADP","CCONJ","PART","PRON","DET","SCONJ")
top_lemmas <- anno |> filter(!(upos %in% exclude_freq_upos)) |> count(lemma, sort = TRUE)
top40 <- top_lemmas |> slice_max(n, n = 40)

p_bar <- top40 |> mutate(lemma = forcats::fct_reorder(lemma, n)) |>
  ggplot(aes(x = lemma, y = n)) +
  geom_col(fill = palette_main[1], width = 0.7) +
  coord_flip() +
  theme_minimal(base_size = 12) +
  theme(panel.grid.major.y = element_blank(), panel.grid.minor = element_blank()) +
  labs(title = "Топ-40 лемм (служебные слова исключены)", x = NULL, y = "Частота")
if (include_interactive) try(plotly::ggplotly(p_bar), silent = TRUE)

Среди топ-10 лемм доминируют слова, связанные с понятиями «бытие», «друг», «любовь», «день», «душа» и т.п., что отражает характерные темы пушкинской лирики. Для наглядной иллюстрации строится бар-плот частот (топ-40 лемм) – наиболее употребимые леммы показаны по убыванию частоты. На рис. 1, мы видим наиболее заметные слова формирующие «тематическое ядро» поэзии Пушкина. Такое облако слов отражает распределение частотности лемм: чем крупнее слово, тем выше его частота.

Код
# Облако слов в Viewer (wordcloud2)
wc_df <- top40 |> rename(freq = n) |> select(word = lemma, freq)
wc_colors <- rep(palette_muted, length.out = nrow(wc_df))
wc_widget <- wordcloud2::wordcloud2(wc_df, size = 1.4, color = wc_colors, backgroundColor = "white", minRotation = 0, maxRotation = 0, ellipticity = 0.65, widgetsize = c("97%", 425))
wc_widget

Рис. 1. Облако слов по топ-лешмам корпуса (размер слова пропорционален частоте). Для построения использован wordcloud2, исключены стоп-слова.

4 Анализ биграмм

Кроме одних слов анализируются биграммы – последовательности из двух слов. Мы составили биграммы, отсекая пары, где хотя бы один элемент – служебное слово (предлог, союз, частица). Самые частотные биграммы (например, «мой друг», «милый друг», «что ты») показывают устойчивые коллокации в поэзии. Это выявляет часто встречающиеся сочетания, что интересно с точки зрения стилистики.

Код
# Биграммы (исключая предлоги/союзы/частицы)
top_bigrams_n <- 15
exclude_bigram_upos <- c("ADP","CCONJ","PART")
anno_seq <- anno |> arrange(doc_id, paragraph_id, sentence_id, token_id) |> select(doc_id, token_norm, upos, token_id)
bigrams_from_ann <- anno_seq |> group_by(doc_id) |> mutate(next_token = lead(token_norm), next_upos = lead(upos)) |>
  filter(!is.na(next_token)) |> ungroup() |> transmute(doc_id, token1 = token_norm, token2 = next_token, upos1 = upos, upos2 = next_upos, bigram = paste(token_norm, next_token, sep = " "))
bigrams_filtered <- bigrams_from_ann |> filter(!(upos1 %in% exclude_bigram_upos | upos2 %in% exclude_bigram_upos))
top_bigrams_tbl <- bigrams_filtered |> count(bigram, name = "freq", sort = TRUE)
top_bigrams <- top_bigrams_tbl |> slice_max(freq, n = top_bigrams_n)
bigram freq
мой друг 45
милый друг 34
что ты 31
может быть 28
ль вы 27
последний раз 26
быть может 20
где ты 18
души моей 18
ты мой 17
то что 16
ты как 15
как ты 14
мой милый 14
ты ты 14
тьме ночной 14

5 Сеть со-упоминаний

Далее построена сеть со-упоминаний по топ-50 лемм. Сеть показывает, какие леммы часто встречаются в одних и тех же стихотворениях. Сообщества (communities) отражают условные тематические зоны: любовная лирика, эпическая тематика, природа/бог и т.п. Интерактивность (подсказки при наведении) позволяет быстро найти узловые слова и их характеристики (частота, степень/degree).

Код
# Сеть со-упоминаний (co-occurrence)
top_lemmas_n <- 50
top_edges_keep <- 200
top_nodes <- top_lemmas |> slice_max(n, n = top_lemmas_n) |> pull(lemma)
pairs <- anno |> filter(lemma %in% top_nodes) |> widyr::pairwise_count(item = lemma, feature = doc_id, sort = TRUE, upper = FALSE)
pairs_pruned <- pairs |> slice_max(n, n = top_edges_keep)
g <- igraph::graph_from_data_frame(d = pairs_pruned |> rename(from = item1, to = item2, weight = n), directed = FALSE)
freq_map <- top_lemmas |> filter(lemma %in% V(g)$name) |> select(lemma, n)
V(g)$freq <- as.numeric(ifelse(V(g)$name %in% freq_map$lemma, freq_map$n[match(V(g)$name, freq_map$lemma)], 1))
V(g)$degree <- igraph::degree(g)
comm <- if (ecount(g) > 0) igraph::cluster_louvain(g) else NULL
V(g)$community <- if (!is.null(comm)) as.character(comm$membership) else "1"
layout_mat <- igraph::layout_with_fr(g)
nodes_df <- tibble(name = V(g)$name, x = layout_mat[,1], y = layout_mat[,2], freq = V(g)$freq, degree = V(g)$degree, community = V(g)$community)
edges_df <- pairs_pruned |> rename(from = item1, to = item2, weight = n) |>
  mutate(x = nodes_df$x[match(from, nodes_df$name)], y = nodes_df$y[match(from, nodes_df$name)],
         xend = nodes_df$x[match(to, nodes_df$name)], yend = nodes_df$y[match(to, nodes_df$name)])
ncom <- length(unique(nodes_df$community))
palette_nodes_use <- palette_nodes[1:ncom]

p_net_stat <- ggplot() +
  geom_segment(data = edges_df, aes(x = x, y = y, xend = xend, yend = yend, size = weight), color = "grey80", alpha = 0.55) +
  geom_point(data = nodes_df, aes(x = x, y = y, size = freq, color = community)) +
  ggrepel::geom_text_repel(data = nodes_df, aes(x = x, y = y, label = name), size = 3) +
  scale_color_manual(values = palette_nodes_use) +
  scale_size_continuous(range = c(3,10)) +
  theme_void(base_size = 12) +
  labs(title = paste0("Сеть со-упоминаний — топ ", top_lemmas_n), color = "Сообщество", size = "Частота узла")
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.

if (include_interactive) {
  p_net <- plot_ly()
  for (i in seq_len(nrow(edges_df))) {
    p_net <- add_trace(p_net,
                       x = c(edges_df$x[i], edges_df$xend[i]),
                       y = c(edges_df$y[i], edges_df$yend[i]),
                       mode = "lines", type = "scatter",
                       line = list(width = 0.5 + (edges_df$weight[i] / max(edges_df$weight, na.rm = TRUE)) * 3, color = "rgba(120,120,120,0.6)"),
                       hoverinfo = "none", showlegend = FALSE)
  }
  comms <- sort(unique(nodes_df$community))
  for (i in seq_along(comms)) {
    sub <- nodes_df |> filter(community == comms[i])
    trace_name <- paste0("Сообщество ", comms[i], " — узлов: ", nrow(sub))
    p_net <- add_trace(p_net,
                       x = sub$x, y = sub$y,
                       type = "scatter", mode = "markers",
                       name = trace_name,
                       marker = list(size = 6 + (sub$freq / max(nodes_df$freq, na.rm = TRUE)) * 18, color = palette_nodes_use[i]),
                       hoverinfo = "text",
                       hovertext = paste0("<b>", sub$name, "</b><br>freq: ", sub$freq, "<br>degree: ", sub$degree),
                       showlegend = TRUE)
    p_net <- add_trace(p_net,
                       x = sub$x, y = sub$y,
                       type = "scatter", mode = "text",
                       text = sub$name, textposition = "top center",
                       showlegend = FALSE, hoverinfo = "none")
  }
  p_net <- layout(p_net,
                  title = list(text = paste0("Сеть со-упоминаний (топ ", top_lemmas_n, ")"), x = 0.5),
                  legend = list(orientation = "v", x = 0.82, y = 0.92),
                  annotations = list(
                    list(x = 0.82, y = 0.96, text = "Сообщества (цвет = кластер)", showarrow = FALSE, xref = "paper", yref = "paper",
                         xanchor = "left", yanchor = "bottom", font = list(size = 12, color = "#444444"))
                  ),
                  xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
                  yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
  p_net
}

6 Тематическое моделирование (LDA)

Дальнейший шаг – тематическое моделирование (LDA). Модель LDA (Latent Dirichlet Allocation) позволяет выделить в корпусе темы.

Код
# Тематическое моделирование LDA
lda_k <- 6
exclude_topic_upos <- c("PRON","ADP","CCONJ","PART","DET","SCONJ")
dtm_counts <- anno |> filter(!(upos %in% exclude_freq_upos)) |> count(doc_id, lemma)
dtm <- tidytext::cast_dtm(dtm_counts, document = doc_id, term = lemma, value = n)
dtm <- dtm[slam::row_sums(dtm) > 0, ]
lda_model <- topicmodels::LDA(dtm, k = lda_k, control = list(seed = 20251218))
lda_terms <- broom::tidy(lda_model, matrix = "beta")
term_upos <- anno |> group_by(lemma, upos) |> tally() |> group_by(lemma) |> slice_max(n, n = 1, with_ties = FALSE) |> ungroup() |> select(lemma, upos)
lda_terms_filtered <- lda_terms |> left_join(term_upos, by = c("term" = "lemma")) |> filter(!(upos %in% exclude_topic_upos) | is.na(upos))
top_terms_by_beta <- lda_terms_filtered |> group_by(topic) |> slice_max(beta, n = 12) |> summarise(terms_beta = paste(term, collapse = ", "))
global_term_freq <- dtm_counts |> group_by(lemma) |> summarise(term_total = sum(n), .groups = "drop")
total_tokens <- sum(global_term_freq$term_total)
global_term_freq <- global_term_freq |> mutate(term_share = term_total / total_tokens)
lda_with_global <- lda_terms_filtered |> left_join(global_term_freq, by = c("term" = "lemma")) |> mutate(term_share = replace_na(term_share, 1e-9), lift = beta / term_share)
top_distinctive <- lda_with_global |> group_by(topic) |> slice_max(lift, n = 12) |> summarise(terms_distinctive = paste(term, collapse = ", "))

Мы задали k=6, так как при этом значении можно добиться относительной различимости в самых популярных словах. Из матрицы β (вероятности слова в теме) выбраны наиболее значимые термины для каждой темы. Ниже приведены топ-12 лексем по каждой теме (лучшая группа лемм по β):

Тема Лексемы
Тема 1 быть, царь, море, князь, гость, сказать, говорить, так, свет, день, знать, царица
Тема 2 любовь, друг, быть, день, милый, душа, где, жизнь, сердце, любить, слеза, сон
Тема 3 быть, конь, сказать, бог, так, старик, море, там, видеть, рыбка, золотой, где
Тема 4 быть, рука, так, день, где, видеть, один, ночь, друг, сердце, молодой, здесь
Тема 5 где, быть, там, день, душа, мир, волна, видеть, меч, грозный, сердце, небо
Тема 6 быть, друг, поэт, душа, бог, где, милый, стих, ль, рука, муза, певец

Таким образом, выявились темы, связанные с царской и морской тематикой (1), любовной лирикой (2, 6), сказочными образами («конь», «рыбка», «старик» – тема 3), природными/божественными сюжетами (5) а также философские настроения («душа», «бог», «вечность», «спокойствие»). Отметим, что многие темы содержат одно и то же слово «быть» – универсальный глагол-помощник.

7 Cентимент-анализ

Следующий этап – сентимент-анализ с использованием русскоязычного словаря эмоциональной окраски RuSentiLex (Loukachevitch и Levchik 2016). RuSentiLex содержит слова с оценочной валентностью (положительная или отрицательная). Словарь hash_sentiment_rusentilex_2017взят из репозитория dmafanasyev/rulexicon (Aфанасьев 2025).

Код
# Загрузка rusentilex и подсчёт сентимента
loc_files_specific <- list.files(pattern = "hash_sentiment.*rusentilex.*\\.(RData|rda|rdata)$", ignore.case = TRUE)
loc_files_any <- list.files(pattern = "^hash_sentiment.*\\.(RData|rda|rdata)$", ignore.case = TRUE)
loc_files <- if (length(loc_files_specific) > 0) loc_files_specific else loc_files_any
tmp_lex <- tibble(word = character(0), sentiment = numeric(0))
for (f in loc_files) {
  tmpenv <- new.env()
  load(f, envir = tmpenv)
  objs <- ls(tmpenv)
  candidate_names <- objs[grepl("rusentilex", objs, ignore.case = TRUE)]
  if (length(candidate_names) == 0) candidate_names <- objs
  for (o in candidate_names) {
    obj <- get(o, envir = tmpenv)
    lex <- NULL
    if (is.data.frame(obj)) {
      coln <- tolower(names(obj))
      wcol <- names(obj)[which(coln %in% c("word","token","term","lemma","token_norm"))[1]]
      scol <- names(obj)[which(coln %in% c("sentiment","score","value","sent","val"))[1]]
      if (!is.null(wcol) && !is.null(scol)) lex <- tibble(word = tolower(obj[[wcol]]), sentiment = as.numeric(obj[[scol]]))
    }
    if (is.null(lex) && is.vector(obj) && !is.null(names(obj))) {
      vals <- suppressWarnings(as.numeric(obj))
      if (!all(is.na(vals))) lex <- tibble(word = tolower(names(obj)), sentiment = as.numeric(vals))
    }
    if (is.null(lex)) {
      lst <- tryCatch(as.list(obj), error = function(e) NULL)
      if (!is.null(lst) && length(lst) > 0) {
        lex <- tibble::enframe(lst, name = "word", value = "raw") |> mutate(sentiment = purrr::map_dbl(raw, ~{ v <- tryCatch(unlist(.x, use.names = FALSE), error = function(e) NA); as.numeric(v[1]) })) |> select(word, sentiment)
      }
    }
    if (!is.null(lex) && nrow(lex) > 0) {
      tmp_lex <- lex |> mutate(word = str_replace_all(tolower(word), "ё", "е") |> str_replace_all("[^а-я-]", "") |> str_squish()) |> filter(!is.na(sentiment) & nchar(word) > 0)
      break
    }
  }
  if (nrow(tmp_lex) > 0) break
}
if (nrow(tmp_lex) == 0) stop("Не удалось извлечь rusentilex из локального RData.")
rusentilex_df <- tmp_lex

sent_rus <- anno |> inner_join(rusentilex_df, by = c("token_norm" = "word")) |> group_by(doc_id) |> summarise(sent = sum(sentiment), matches = n(), .groups = "drop")
sentiment_tbl <- texts_with_meta |> select(uid, title, text) |> left_join(sent_rus, by = c("uid" = "doc_id")) |> mutate(sent = replace_na(sent, 0), matches = replace_na(matches, 0)) |> rename(sent_primary = sent)

Мы сопоставили каждому токену корпуса его значение сентимента и суммировали по текстам. Для каждого стихотворения вычислены суммарная оценка и число найденных совпадений с лексиконом. После этого получены списки топ-10 самых «позитивных» и «негативных» стихотворений.

Код
# Топ-10 позитивных и топ-10 негативных стихотворений
n_top_sent <- 10
output_prefix <- "pushkin_final"

top_pos <- sentiment_tbl |> distinct(title, .keep_all = TRUE) |> arrange(desc(sent_primary)) |> slice_head(n = n_top_sent) |> mutate(title_short = map_chr(title, ~ if_else(nchar(str_squish(.x)) > 70, str_trunc(str_squish(.x), 70), str_squish(.x))))
top_neg <- sentiment_tbl |> distinct(title, .keep_all = TRUE) |> arrange(sent_primary) |> slice_head(n = n_top_sent) |> mutate(title_short = map_chr(title, ~ if_else(nchar(str_squish(.x)) > 70, str_trunc(str_squish(.x), 70), str_squish(.x))))

p_pos <- ggplot(top_pos, aes(x = sent_primary, y = forcats::fct_reorder(title_short, sent_primary))) +
  geom_col(fill = palette_main[1], width = 0.7) +
  geom_text(aes(label = title_short, x = sent_primary / 2), color = "white", size = 3, fontface = "plain") +
  theme_minimal(base_size = 12) +
  labs(title = paste0("Топ ", nrow(top_pos), " позитивных стихотворений"), x = "Сумма сентимента", y = NULL) +
  theme(axis.text.y = element_blank())
if (include_interactive) try(plotly::ggplotly(p_pos, tooltip = c("x")), silent = TRUE)

Наиболее позитивные стихотворения (по суммарному сентименту): «Городок (К**)»* (сентимент = +18), «Сказка о царе Салтане…» (+16), «Я думал, что любовь погасла навсегда…» (+12), и т.д.

Код
p_neg <- ggplot(top_neg, aes(x = sent_primary, y = forcats::fct_reorder(title_short, sent_primary))) +
  geom_col(fill = "#A64B4B", width = 0.7) +
  geom_text(aes(label = title_short, x = sent_primary / 2), color = "white", size = 3, fontface = "plain") +
  theme_minimal(base_size = 12) +
  labs(title = paste0("Топ ", nrow(top_neg), " негативных стихотворений"), x = "Сумма сентимента", y = NULL) +
  theme(axis.text.y = element_blank())
if (include_interactive) try(plotly::ggplotly(p_neg, tooltip = c("x")), silent = TRUE)

Наиболее негативные стихотворения: «Андрей Шенье» (≈‒30), «Безверие» (‒24), «Моему Аристарху» (‒22), «Романс» (‒20) и т.д.

Такие результаты в целом соответствует ожиданиям: сказочные поэмы и лирика часто оцениваются лексически позитивно, а глубоко философские или военные стихотворения («Безверие», «Андрей Шенье», «Сон (Отрывок)», «Бородинская годовщина» и пр.) – отрицательно.

8 Хронология сентимента

Наконец, проанализирована хронология сентимента по годам. Для этого из метаданных извлечены годы создания или публикации стихов. По годам вычислены средние значения суммарного сентимента. На рис. 2 показано, как менялось «эмоциональное настроение» поэзии Пушкина с течением времени.

Код
# Хронология сентимента — ggplot, затем ggplotly(p_time, tooltip = c("x","y","size"))
possible_date_cols <- c("terminus_post_quem","terminus_ante_quem","dated","first_publication","date","year","created")
available_date_cols <- intersect(possible_date_cols, colnames(meta))
extract_year <- function(s) {
  if (is.na(s) || str_trim(as.character(s)) == "") return(NA_integer_)
  y <- str_extract(as.character(s), "\\b(17|18|19|20)\\d{2}\\b")
  if (!is.na(y)) return(as.integer(y))
  NA_integer_
}
meta_years <- meta |> rowwise() |> mutate(year = {
  y <- NA_integer_
  for (col in available_date_cols) {
    v <- cur_data()[[col]]
    if (!is.null(v)) { y <- extract_year(v); if (!is.na(y)) break }
  }
  if (is.na(y)) y <- extract_year(paste(unlist(cur_data()), collapse = " "))
  y
}) |> ungroup() |> select(uid, year)

sent_with_year <- sentiment_tbl |> left_join(meta_years, by = "uid")
year_summary <- sent_with_year |> filter(!is.na(year)) |> group_by(year) |> summarise(mean_sent = mean(sent_primary, na.rm = TRUE), n_poems = n(), .groups = "drop") |> arrange(year)

if (nrow(year_summary) > 0) {
  min_y <- min(year_summary$year, na.rm = TRUE)
  max_y <- max(year_summary$year, na.rm = TRUE)
  breaks_seq <- seq(floor(min_y/5)*5, ceiling(max_y/5)*5, by = 5)
  
  p_time <- ggplot(year_summary, aes(x = year, y = mean_sent)) +
    geom_line(color = palette_main[2]) +
    geom_point(aes(size = n_poems), color = palette_main[2]) +
    geom_smooth(method = "loess", se = TRUE, color = palette_main[3], fill = alpha(palette_main[3], 0.2)) +
    scale_x_continuous(breaks = breaks_seq) +
    scale_size_continuous(name = "Число стихотворений", range = c(2, 10)) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "bottom") +
    labs(title = "Хронология сентимента: средний по годам", x = "Год", y = "Средний сентимент")
  
  
  if (include_interactive) {
    try((plotly::ggplotly(p_time, tooltip = c("x","y","size"))), silent = TRUE)
  }
}

Рис. 2. Средний сентимент по годам публикации. Размер точек соответствует количеству стихотворений в соответствующем году.

На графике видны значительные колебания: некоторые годы (например, 1818 и 1832) характеризуются высокой положительной оценкой в сентименте. Возможно, связано с переходным периодом в жизни поэта между лицейской юностью и началом взрослой жизни в Петербурге (1818 ) и поступлением на государственную службу (1832)). В годы потрясений и драматических событий наблюдаются отрицательные пики (1812–1815 война, 1821–1823 южная ссылка в Кишинев и Одессу, 1830 карантин в Болдино, 1833 путешествие по местам Пугачевского восстания. Важно отметить, что сетевой граф сентиментов смещён в отрицательную сторону (средний сентимент чаще нулевой или отрицательный), что может отражать пессимистические и философские мотивы творчества.

Запишем получившиеся данные в файлы.

Код
readr::write_csv(top_bigrams_tbl, paste0(output_prefix, "_top_bigrams.csv"))
readr::write_csv(top_lemmas, paste0(output_prefix, "_top_lemmas.csv"))
readr::write_csv(top_terms_by_beta, paste0(output_prefix, "_lda_terms_beta.csv"))
readr::write_csv(top_distinctive, paste0(output_prefix, "_lda_terms_distinctive.csv"))
readr::write_csv(sentiment_tbl |> select(uid, title, sent_primary, matches), paste0(output_prefix, "_sentiment_per_poem.csv"))
readr::write_csv(top_pos |> select(uid, title, sent_primary, matches), paste0(output_prefix, "_top_positive.csv"))
readr::write_csv(top_neg |> select(uid, title, sent_primary, matches), paste0(output_prefix, "_top_negative.csv"))
readr::write_csv(year_summary, paste0(output_prefix, "_sentiment_by_year.csv"))

9 Заключение

Проведённый корпусный анализ подтвердил значимость ключевых образов в лирике Пушкина: любовь, дружба, душа, сердце, бог, море и пр. (топ-леммами). Тематическая модель выделила темы «царской поэзии», «сказок» и «любви», «бежественного» показав разнообразие сюжетов. Сентимент-анализ выявил контраст между «светлыми» (сказочными и любовными) и «тёмными» (военно-патриотическими, философскими) стихами. Визуализации (распределение частот лемм, облако слов, временные ряды сентимента) наглядно иллюстрируют полученные результаты. Итогом работы стало описание лингвистической структуры корпуса поэтических текстов Пушкина, сочетающее методы частотного анализа, тематического моделирования и сентимент-анализа.

Библиография

Aфанасьев, Д. М. 2025. «rulexicon: Russian Lexicons for Text Analysis». [Электронный ресурс]. https://github.com/dmafanasyev/rulexicon.
Loukachevitch, Natalia, и Anatolii Levchik. 2016. «Creating a General Russian Sentiment Lexicon». В Proceedings of the Tenth International Conference on Language Resources and Evaluation (LREC’16), под редакцией Nicoletta Calzolari, Khalid Choukri, Thierry Declerck, Sara Goggi, Marko Grobelnik, Bente Maegaard, Joseph Mariani, и др., 1171–76. Portorož, Slovenia: European Language Resources Association (ELRA). https://aclanthology.org/L16-1186/.
Вожик, Е. И., Е. О. Казакова, и Р. А. Лисюков. 2023. «Корпус стихотворений А. С. Пушкина». Репозиторий открытых данных по русской литературе и фольклору. https://doi.org/10.31860/openlit-2023.8-C005.