Сеть связей персонажей Толстого

library(tidyverse)
library(igraph)
library(ggraph)
library(xml2) 

doc <- read_xml("/Users/kiddmaloy/Downloads/DH_R/dataverse_files/War_and_Peace.xml")
xml_ns_strip(doc)

paragraphs <- xml_find_all(doc, "//p") # извлечение всех абзацев

# Функция для извлечения уникальных персонажей из одного абзаца
get_characters_from_p <- function(p_node) {
  rs_nodes <- xml_find_all(p_node, ".//rs[@ref]") # ищем теги rs, у которых есть атрибут ref
  refs <- xml_attr(rs_nodes, "ref") # оставляем только уникальные упоминания в рамках одного абзаца
  unique(refs)}

# Применяем ко всем абзацам
chars_in_paragraphs <- map(paragraphs, get_characters_from_p)

# Оставляем только те абзацы, где упомянуто больше одного персонажа
interactions <- keep(chars_in_paragraphs, ~ length(.x) > 1)

# Создаем все возможные уникальные пары из списка персонажей абзаца
edges_df <- map_dfr(interactions, function(chars) {
  combn(chars, 2, simplify = FALSE) |>
    map_dfr(~ tibble(source = .x[1], target = .x[2]))})

# Сортируем имена по алфавиту внутри пары, чтобы A-B и B-A считались одной связью
edges_weighted <- edges_df |>
  mutate(char1 = pmin(source, target), char2 = pmax(source, target)) |>
  count(char1, char2, name = "weight") |>
  rename(source = char1, target = char2)

# Оставляем только те пары, которые встречались вместе 5+ раз
edges_strong <- edges_weighted |> 
  filter(weight > 5)

# Создаем граф только из сильных связей
wp_core <- graph_from_data_frame(edges_strong, directed = FALSE)

# Удаляем персонажей, у которых после фильтрации не осталось связей
wp_core <- delete_vertices(wp_core, degree(wp_core) == 0)

# Считаем степень, чтобы настроить размер кружков
V(wp_core)$deg <- degree(wp_core)

# Присваиваем сообщества
cw <- cluster_walktrap(wp_core)
V(wp_core)$cluster <- as.character(membership(cw))
# Осмысление
cat("Узлов графа -", vcount(wp_core))
## Узлов графа - 69
cat("Кол-во ребер -", ecount(wp_core))
## Кол-во ребер - 253
cat("Плотность сети -", edge_density(wp_core))
## Плотность сети - 0.1078431
mod_score <- modularity(cw)
cat("Модулярность -", mod_score)
## Модулярность - 0.243747
# Точки сочленения (персонажи, без которых сеть распадется на части)
art_points <- articulation_points(wp_core)
print(V(wp_core)[art_points]$name)
##  [1] "Countess_Natalya_Rostova"     "Pierre_Bezukhov"             
##  [3] "Tsar_Alexander_I_of_Russia"   "Nikolai_Rostov"              
##  [5] "Yakov_Alpatych"               "Rastopchin"                  
##  [7] "Princess_Mariya_Bolkonskaya"  "Mikhail_Ilarionovich_Kutuzov"
##  [9] "Napoleon_Bonaparte"           "NatashaRostova"              
## [11] "Anna_Pavlovna_Scherer"        "AndreyBolkonsky"
# Самые крупные клики (максимально сплоченные группы, где все связаны со всеми)
cat("Размер максимальной клики -", clique_num(wp_core), "\n")
## Размер максимальной клики - 8
largest_cliques(wp_core)
## [[1]]
## + 8/69 vertices, named, from f0adb7c:
## [1] Vera_Rostova             Boris_Drubetskoy         Sonya_Rostova           
## [4] Pierre_Bezukhov          Nikolai_Rostov           NatashaRostova          
## [7] Countess_Natalya_Rostova Count_Ilya_Rostov       
## 
## [[2]]
## + 8/69 vertices, named, from f0adb7c:
## [1] Sonya_Rostova               Count_Ilya_Rostov          
## [3] Pierre_Bezukhov             NatashaRostova             
## [5] Nikolai_Rostov              Countess_Natalya_Rostova   
## [7] AndreyBolkonsky             Princess_Mariya_Bolkonskaya
## 
## [[3]]
## + 8/69 vertices, named, from f0adb7c:
## [1] Sonya_Rostova            Count_Ilya_Rostov        Pierre_Bezukhov         
## [4] NatashaRostova           Nikolai_Rostov           Countess_Natalya_Rostova
## [7] AndreyBolkonsky          Boris_Drubetskoy        
## 
## [[4]]
## + 8/69 vertices, named, from f0adb7c:
## [1] Sonya_Rostova            Count_Ilya_Rostov        Pierre_Bezukhov         
## [4] NatashaRostova           Nikolai_Rostov           Countess_Natalya_Rostova
## [7] AndreyBolkonsky          Vasily__Vasska__Denisov 
## 
## [[5]]
## + 8/69 vertices, named, from f0adb7c:
## [1] Sonya_Rostova            Count_Ilya_Rostov        Pierre_Bezukhov         
## [4] NatashaRostova           Nikolai_Rostov           Countess_Natalya_Rostova
## [7] Petya_Rostov             Vasily__Vasska__Denisov 
## 
## [[6]]
## + 8/69 vertices, named, from f0adb7c:
## [1] Sonya_Rostova            Count_Ilya_Rostov        Pierre_Bezukhov         
## [4] NatashaRostova           Nikolai_Rostov           Fedor_Ivanovich_Dolokhov
## [7] Vasily__Vasska__Denisov  Petya_Rostov

После фильтрации ядро сети составило 69 узлов (персонажей) и 253 ребра (устойчивых связей). Плотность сети около 11%. Возможно, для социальной сети такого масштаба это не высокий показатель, но он означает, что каждый десятый возможный контакт в этом ядре реально существует.

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

В графе выявлено 12 точек сочленения — это персонажи-«мосты», при удалении которых сеть распадется на несвязанные фрагменты. Математический расчет идеально отражает сюжетную роль героев:

Главные герои: Пьер Безухов, Андрей Болконский, Наташа Ростова, графиня Ростова, Николай Ростов. Они связывают между собой разные семьи и социальные круги (например, Пьер вхож абсолютно везде — от масонских лож до салона Шерер и поля Бородина). Организаторы пространств: Анна Павловна Шерер (объединяет петербургскую элиту) и граф Растопчин (центр московского общества). Исторические и военные лидеры: Наполеон, Александр I, Кутузов. Они выступают связующими звеньями для военных персонажей, генералов и адъютантов, которые без них не пересеклись бы с остальным сюжетом. Специфические мосты: Яков Алпатыч, как управляющий, он является единственным связующим звеном между изолированным имением Лысые Горы и внешним миром.

Размер максимальной клики (группы, где абсолютно каждый персонаж взаимодействовал с каждым другим) составил 8 узлов. Алгоритм нашел 6 таких клик, и их состав крайне показателен.

Ядром абсолютно всех максимальных клик является семья Ростовых (граф, графиня, Наташа, Николай, Соня). В разных конфигурациях к этой замкнутой домашней ячейке присоединяются их самые частые гости и женихи: Пьер Безухов, Андрей Болконский, Борис Друбецкой, Василий Денисов и Федор Долохов. С точки зрения сетевого анализа, дом Ростовых — это самая сплоченная, плотная и открытая к взаимодействию социальная структура в романе, что полностью совпадает с замыслом Л.Н. Толстого.

# Визуализация
set.seed(2026) 
ggraph(wp_core, layout = "stress") +
  geom_edge_link(aes(alpha = weight, edge_width = weight), color = "grey65") +
  geom_node_point(aes(size = deg, fill = cluster), shape = 21, color = "grey20", show.legend = FALSE) +
  geom_node_text(aes(label = name, filter = deg > 15), # подписываем только элиту:)
                 repel = TRUE, size = 3, color = "black", bg.color = "white") + 
  scale_edge_width_continuous(range = c(0.1, 1), guide = 'none') +
  scale_edge_alpha_continuous(range = c(0.1, 0.4), guide = 'none') +
  scale_size_continuous(range = c(2, 10), guide = 'none') +
  theme_graph() +
  
  coord_cartesian(clip = "off") + # расширяем холст, чтобы repel надписи не обрезались краями картинки
  theme(plot.margin = margin(0, 0, 0, 0)) +
  labs(title = "Ядро взаимодействий персонажей «Войны и мира»")

# Анализ отдельных сообществ
communities <- unique(V(wp_core)$cluster)

# Для каждого сообщества выполняем один и тот же набор действий
for (i in communities) {
  # Отбираем узлы, которые относятся к текущему кластеру
  nodes_in_comm <- V(wp_core)[cluster == i]
  
  # Оставляем только этих персонажей и связи строго между ними, для анализа был выбран метод выделения подграфов на основе атрибута принадлежности к сообществу
  subgraph_comm <- induced_subgraph(wp_core, vids = nodes_in_comm)
  
  # Отсеиваем слишком мелкие смысловые блоки
  if (vcount(subgraph_comm) >= 4) {
    
    # Строим визуализацию для текущего подграфа
    p <- ggraph(subgraph_comm, layout = "stress") + 
      # Ребра делаем потолще, так как на графике теперь просторно
      geom_edge_link(aes(edge_width = weight), color = "grey65", alpha = 0.7) +
      
      # Цвет узлов теперь можно сделать одинаковым, кластер тереь один один
      geom_node_point(aes(size = deg), fill = "blue", shape = 21, color = "white") +
      
      # Так как персонажей мало, мы снимаем жесткий фильтр текста и подписываем ВСЕХ участников конкретной группы
      geom_node_text(aes(label = name), repel = TRUE, size = 4, bg.color = "white") +
      scale_edge_width_continuous(range = c(0.5, 2.5), guide = 'none') +
      scale_size_continuous(range = c(4, 15), guide = 'none') +
      theme_graph() +
      coord_cartesian(clip = "off") +
      theme(plot.margin = margin(0, 0, 0, 0)) +
      
      # Заголовок будет автоматически меняться для каждой картинки
      labs(title = paste("Сообщество №", i),
           subtitle = paste("Количество персонажей в группе:", vcount(subgraph_comm)))
    
    print(p)
  }
}