Это учебная работа. Выполнена на корпусе интервью, собранных в ходе экспедиции в Пермь в 2025 г.. Все интервью получены легальным путем с письменным разрешением интервьюируемых и находятся в архиве Еврейского музея и цента толерантности. Однако, т.к. работа учебная и корпус готовился в сжатые сроки, просьба не использовать его для других работ, а обратиться в музей или к автору работы. В учебный корпус вошли 93 полнотекстовых интервью в черновой расшифровке (файлы формата word и md, word предварительно были пересохранены как txt) с последующей очисткой и разметкой udpipe.

Начинаем работу с очистки от ненужных слов (специфические слова выбирались прецедентно, как визуально засоряющие визуализацию. Как правило, служебные слова для процесса сбора материалов).

# Русские стоп-слова
russian_stopwords <- stopwords("ru", source = "stopwords-iso")

# Специфические для корпуса стоп-слова
custom_stopwords <- c(
  "согласие", "интервью", "Род.", "дата", "пожалуйст", "живет",
  "Информант", "Инф", "Соб", "Собиратель", "продолжительность", "Соб1",
  "запись", "Патрушев", "минута", "запись", "сбор", "июль", "исследуе", "музей"
)

all_stopwords <- unique(c(russian_stopwords, custom_stopwords))

Анализ существительных.

Порог 12 выбран опытным путем как оптимальный, не перегружающий график, но при этом дающий представление, о чем велись беседы.

# Отбираем существительные без стоп-слов
perm_subset <- my_data |> 
  filter(upos == "NOUN") |>
  filter(!lemma %in% all_stopwords) |>
  filter(!str_detect(lemma, "^[0-9]+$")) |>
  filter(nchar(lemma) > 2)

# Совместная встречаемость
cooc <- cooccurrence(perm_subset, 
                     term = "lemma", 
                     group = c("doc_id", "sentence_id")) |>
  as_tibble()

# Фильтруем по порогу
cooc_filtered <- cooc |> 
  filter(cooc > 12)

cat("Найдено пар существительных:", nrow(cooc_filtered), "\n")
## Найдено пар существительных: 77

Визуализация сети совместной встречаемости для существительных.

if(nrow(cooc_filtered) > 0) {
  g <- graph_from_data_frame(cooc_filtered[, c("term1", "term2")], 
                             directed = FALSE)
  E(g)$weight <- cooc_filtered$cooc
  
  set.seed(123)
  ggraph(g, layout = "dh") +
    geom_edge_link(aes(alpha = weight, width = weight),
                   color = "grey20") +
    geom_node_point(aes(size = degree(g)),
                    color = "steelblue", 
                    alpha = 0.7) +
    geom_node_text(aes(label = name), 
                   repel = TRUE,
                   size = 3,
                   max.overlaps = 30) +
    scale_edge_width_continuous(range = c(0.5, 2)) +
    scale_size_continuous(range = c(2, 8)) +
    theme_graph(base_family = "sans") +
    labs(title = "Сеть совместной встречаемости существительных",
         subtitle = paste("Стоп-слова удалены | Порог > 15 | Вершин:", 
                          vcount(g), "| Ребер:", ecount(g)))
}

Анализ совместной встречаемости существительных и прилагательных.

В ходе работы над визуализацией решено покрасить их в разные цвета. Порог 20 также выбран опытным путем после построения первых статических графов. Укладка сети и вид ребер - попытка сделать граф сколько-нибудь информативным.

relevant_data <- my_data |> 
  filter(upos %in% c("NOUN", "ADJ")) |>
  filter(!lemma %in% all_stopwords) |>
  filter(!str_detect(lemma, "^[0-9]+$")) |>
  filter(nchar(lemma) > 2)

cooc2 <- cooccurrence(relevant_data$lemma, skipgram = 1) |> 
  as_tibble() |> 
  filter(cooc > 20)

cat("Найдено биграмм:", nrow(cooc2), "\n")
## Найдено биграмм: 92

Статическая визуализация биграмм

После нескольких построений было решено избавиться от периферийных узлов, не присоединенных к основному кластеру. Они, хоть и могли привнести в смысловую картину несколько новых мотивов, сильно загромождали изображение и делали основной блок нечитаемым.

if(nrow(cooc2) > 0) {
  g <- graph_from_data_frame(cooc2[, c("term1", "term2")], directed = FALSE)
  E(g)$weight <- cooc2$cooc
  
  # Главный компонент графа (который было решено сделать основой визуализации)
  comp <- components(g)
  g <- induced_subgraph(g, which(comp$membership == which.max(comp$csize)))
  
  # Части речи
  pos_info <- relevant_data |> distinct(lemma, upos)
  V(g)$upos <- pos_info$upos[match(V(g)$name, pos_info$lemma)]
  V(g)$upos[is.na(V(g)$upos)] <- "UNKNOWN"
  
  colors <- c("NOUN" = "steelblue", "ADJ" = "salmon", "UNKNOWN" = "lightblue")
  
  set.seed(123)
  ggraph(g, layout = "on_sphere") +
    geom_edge_link(aes(alpha = weight, width = weight), color = "grey30") +
    geom_node_point(aes(size = degree(g), color = upos), alpha = 0.8) +
    geom_node_text(aes(label = name), repel = TRUE, size = 3, max.overlaps = 30) +
    scale_edge_width_continuous(range = c(0.3, 1.5)) +
    scale_size_continuous(range = c(3, 10)) +
    scale_color_manual(values = colors, name = "Часть речи") +
    theme_graph(base_family = "sans") +
    theme(legend.position = "bottom") +
    labs(title = "Сеть биграмм: существительные и прилагательные",
         subtitle = paste("Главный компонент | Порог > 20 | Вершин:", vcount(g), 
                          "| Ребер:", ecount(g)))
}

Интерактивная визуализация биграмм

if(exists("g") && vcount(g) > 0) {
  # Подготовка данных
  nodes <- data.frame(
    id = 1:vcount(g),
    label = V(g)$name,
    group = V(g)$upos,
    value = degree(g),
    title = paste0("<b>", V(g)$name, "</b><br>Часть речи: ", V(g)$upos, 
                   "<br>Степень: ", degree(g))
  )
  
  edges_df <- igraph::as_data_frame(g, what = "edges")
  edges <- edges_df |>
    mutate(
      from = match(from, V(g)$name),
      to = match(to, V(g)$name),
      value = weight,
      title = paste("Вес:", weight)
    )
  
  nodes$color <- colors[nodes$group]
  nodes$color[is.na(nodes$color)] <- "lightblue"
  nodes$border <- "grey80"
  
  # Интерактивный граф (без сохранения в файл)
  interactive_plot <- visNetwork(nodes, edges, 
                                 width = "100%", 
                                 height = "600px",
                                 main = "Сеть биграмм (интерактивная)") |>
    visGroups(groupname = "NOUN", color = list(background = colors["NOUN"], 
                                               border = "grey80")) |>
    visGroups(groupname = "ADJ", color = list(background = colors["ADJ"], 
                                              border = "grey80")) |>
    visOptions(highlightNearest = list(enabled = TRUE, degree = 1, hover = TRUE),
               nodesIdSelection = TRUE) |>
    visPhysics(solver = "forceAtlas2Based", 
               forceAtlas2Based = list(gravitationalConstant = -30)) |>
    visEdges(
      color = list(color = "grey60", highlight = "grey30", opacity = 0.4),
      smooth = list(enabled = TRUE, type = "curvedCW", roundness = 0.3)
    ) |>
    visLayout(randomSeed = 123)
  
  # Просто выводим граф (без iframe)
  interactive_plot
} else {
  cat("Граф не построен")
}

Заключение

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

Дата выполнения: 2026-03-01