Сетевой анализ персонажей на основе XML-датасета по роману ‘Война и мир’

Импортируем библиотеки и добавляем датасет:

library(xml2)
library(tidyverse)
library(igraph)
library(visNetwork)
library(tidygraph)

knitr::opts_knit$set(root.dir = "/Users/aroslavkurganov/Yandex.Disk.localized")
doc <- read_xml("/Users/aroslavkurganov/Yandex.Disk.localized/War_and_Peace.xml")
xml_ns_strip(doc)

Начинаем искать взаимодействия с персонажами в конкретных предложениях. Также формируем единую таблицу с этими персонажами.

mentions_raw <- doc %>%
  xml_find_all(".//s[descendant::rs[@ref]]") %>%
  map_df(function(s_node) {
    sentence_id <- xml_path(s_node)
    chars <- xml_find_all(s_node, ".//rs[@ref]") %>% 
      xml_attr("ref") %>% 
      str_remove_all("#") %>%
      unique()
    
    if(length(chars) > 0) {
      tibble(char = chars, s_id = sentence_id)
    } else {
      NULL
    }
  })

Немного дополняем для ясности таблицу – теперь она выглядит так:

pair_links <- mentions_raw %>%
  inner_join(mentions_raw, by = "s_id", relationship = "many-to-many") %>%
  filter(char.x != char.y) %>%
  filter(char.x < char.y) %>%
  count(char.x, char.y, name = "weight") %>%
  arrange(desc(weight))
print(head(pair_links, 10))

# A tibble: 10 × 3
   char.x                   char.y                      weight
   <chr>                    <chr>                        <int>
 1 NatashaRostova           Pierre_Bezukhov                217
 2 NatashaRostova           Sonya_Rostova                  181
 3 AndreyBolkonsky          Pierre_Bezukhov                159
 4 Nikolai_Rostov           Vasily__Vasska__Denisov        126
 5 AndreyBolkonsky          NatashaRostova                 125
 6 Nikolai_Rostov           Sonya_Rostova                  121
 7 NatashaRostova           Nikolai_Rostov                 117
 8 Prince_Nikolay_Bolkonsky Princess_Mariya_Bolkonskaya    116
 9 NatashaRostova           Princess_Mariya_Bolkonskaya    107
10 AndreyBolkonsky          Princess_Mariya_Bolkonskaya     92

# Создаем связи: персонажи вместе в одном предложении (максимальная близость)
pair_links <- mentions_raw %>%
  inner_join(mentions_raw, by = "s_id") %>%
  filter(char.x < char.y) %>% # Убираем дубликаты и петли
  count(char.x, char.y, name = "weight") %>%
  filter(weight >= 3) # Порог для отсечения случайных встреч

Теперь на основе получившейся таблицы создаем граф.

# 1. Расчет метрик и сообществ
net_work <- as_tbl_graph(pair_links, directed = FALSE) %>%
  activate(nodes) %>% 
  mutate(
    # Центральность собственного вектора
    influence = centrality_eigen(),
    # Сообщества (Fast Greedy)
    group = as.factor(group_fast_greedy())
  ) %>%
  activate(edges) %>%
  mutate(edge_width = weight)

# 2. Поиск точек сочленения (через igraph)
g_igraph <- as.igraph(net_work)
bridges <- articulation_points(g_igraph)
# Для вывода имен: V(g_igraph)$name[bridges]

# 3. Создание "Ядра" (Core-декомпозиция)
# Мы заменяем проблемный node_is_center на фильтрацию по K-Core и важности
core_net <- net_work %>%
  activate(nodes) %>%
  mutate(core_val = node_coreness()) %>%
  #фильтруем персонажей, которые входят в устойчивое ядро (минимум 3 связи)
  filter(core_val >= 3, influence > mean(influence)) %>%
  activate(edges) %>%
  #в то же время удаляем ребра, которые остались без узлов после фильтрации
  filter(!edge_is_multiple())

Финальный этап – сама визуализация. Во время попыток создания интерактивного графа через visNetwork Rstudio невероятно лагал, поэтому ограничимся статическим графиком :(

# 1. ПРОВЕРКА И ПОДГОТОВКА ДАННЫХ ДЛЯ ВИЗУАЛИЗАЦИИ
# Если net_work существует, мы выделяем из него "ядро"
if (exists("net_work")) {
  
  core_plot_data <- net_work %>%
    tidygraph::activate(nodes) %>%
    # Оставляем только тех, кто имеет 3+ связи в своей группе (K-core)
    # Это отсекает лишний "шум" на графике
    dplyr::filter(tidygraph::node_coreness() >= 3) %>%
    # Дополнительно считаем PageRank для размера узлов
    dplyr::mutate(importance = tidygraph::centrality_pagerank()) %>%
    tidygraph::activate(edges) %>%
    dplyr::mutate(edge_weight = weight)

  # 2. ПОСТРОЕНИЕ ГРАФИКА
  library(ggraph)
  library(viridis)

  ggraph(core_plot_data, layout = "kk") + 
    # Рисуем дуги (наша "фишка" для уникальности)
    geom_edge_arc(aes(width = edge_weight, alpha = edge_weight), 
                  color = "azure4", 
                  strength = 0.1, 
                  show.legend = FALSE) +
    
    # Узлы: размер по PageRank, цвет по сообществам (рассчитанным в Chunk 5)
    geom_node_point(aes(size = importance, color = group), alpha = 0.8) +
    
    # Подписи: только для важных героев, шрифт с засечками (serif)
    geom_node_text(aes(label = name, filter = importance > mean(importance)), 
                   repel = TRUE, 
                   size = 4, 
                   family = "serif", 
                   fontface = "bold.italic",
                   color = "#1a1a1a") +
    
    # Настройка цветов и размеров
    scale_size_continuous(range = c(3, 15), name = "Влияние (PageRank)") +
    scale_color_viridis_d(option = "mako", begin = 0.2, end = 0.8, name = "Кластер") +
    scale_edge_width(range = c(0.2, 2)) +
    
    # Оформление
    theme_graph(base_family = "serif") +
    theme(legend.position = "bottom") +
    labs(
      title = "Сетевая архитектура ядра романа 'Война и мир'",
      subtitle = "Анализ на уровне предложений. Выделено структурное ядро (K-core >= 3).",
      caption = "Метод укладки: Kamada-Kawai | Метрика: PageRank"
    )

} else {
  message("Объект net_work не найден. Убедитесь, что Chunk 5 выполнился без ошибок.")
}