📦 Подключение библиотек

library(xml2)
library(tidyverse)
library(igraph)
library(ggraph)
library(visNetwork)
library(viridis)

Загружаем библиотеки. # Загружаем библиотеки, которые нам понадобятся. # xml2 для работы с XML, tidyverse для удобной работы с таблицами, # igraph и ggraph для графов, visNetwork для интерактивной сети. —

Загрузка XML

doc <- read_xml("War_and_Peace.xml")

Читаем наш XML-файл с текстом «Войны и мира».

# В будущем будем извлекать из него реплики персонажей.

Извлечение реплик

Здесь я делаю функцию, которая вытаскивает из XML все элементы . Для каждого элемента берём, кто говорит (speaker) и кому адресована реплика (addressee).

extract_speeches <- function(doc) {
  saids <- xml_find_all(doc, ".//*[local-name()='said']")

  tibble(
    speaker   = xml_attr(saids, "who"),
    addressee = xml_attr(saids, "corresp")
  )
}

Получаем, кто говорит и кому.

Очистка данных

Превращаем столбцы с несколькими именами через запятую в отдельные строки.

Убираем лишние символы и пробелы, а также пустые значения и дубликаты.

speeches <- extract_speeches(doc) |>
  separate_rows(speaker, sep = "[,;]") |>
  separate_rows(addressee, sep = "[,;]") |>
  mutate(
    speaker   = str_squish(str_remove_all(speaker, "#")),
    addressee = str_squish(str_remove_all(addressee, "#"))
  ) |>
  filter(
    speaker != "", addressee != "",
    !is.na(speaker), !is.na(addressee),
    speaker != addressee
  )

# Проверяем первые несколько строк, чтобы убедиться, что всё окэй
head(speeches)

Чистим данные.

Формирование связей

Считаем, сколько раз каждый персонаж говорил с другим.

Фильтруем пары, которые встретились хотя бы 2 раза — чтобы убрать слабые связи.

edges <- speeches |>
  count(speaker, addressee, name = "weight") |>
  filter(weight >= 2)
# Смотрим на первые строки, чтобы убедиться, что подсчет прошел нормально
head(edges)

Создаём связи.

Создание графа

Строим граф из таблицы связей.

Граф неориентированный, потому что диалоги двусторонние.

g <- graph_from_data_frame(edges, directed = FALSE)

# Печатаем базовые характеристики графа
cat("Узлов:", vcount(g), "\n")
## Узлов: 206
cat("Рёбер:", ecount(g), "\n")
## Рёбер: 573
cat("Компонент:", components(g)$no, "\n")
## Компонент: 6
cat("Плотность:", edge_density(g), "\n")
## Плотность: 0.02713711

Базовые характеристики графа.

Метрики

Считаем разные метрики для узлов:

degree — количество связей,

strength — сумма веса связей,

betweenness — насколько персонаж посредник между другими.

V(g)$degree      <- degree(g)
V(g)$strength    <- strength(g, weights = E(g)$weight)
V(g)$betweenness <- betweenness(g, weights = E(g)$weight, normalized = TRUE)

head(as_data_frame(g, what = "vertices"))

Центральности узлов.

Сочленения узлов

Точки сочленения — узлы, удаление которых разрывает граф

art_points <- articulation_points(g)
V(g)$name[art_points]  # показываем имена этих персонажей
##  [1] "Fedor_Ivanovich_Dolokhov"             
##  [2] "Pierre_Bezukhov"                      
##  [3] "Count_Ilya_Rostov"                    
##  [4] "Balashev"                             
##  [5] "Uncle"                                
##  [6] "Petya_Rostov"                         
##  [7] "Zherkov"                              
##  [8] "regimental commander"                 
##  [9] "солдат"                               
## [10] "Prince_Nesvitsky"                     
## [11] "Napoleon_Bonaparte"                   
## [12] "Tsar_Alexander_I_of_Russia"           
## [13] "Prince_Kozlovsky"                     
## [14] "адъютант"                             
## [15] "Count_Rostopchin"                     
## [16] "Prince_Nikolay_Bolkonsky"             
## [17] "Yakov_Alpatych"                       
## [18] "Princess_Mariya_Bolkonskaya"          
## [19] "HeleneKuragin"                        
## [20] "NatashaRostova"                       
## [21] "old priest"                           
## [22] "Princess_Anna_Mikhaylovna_Drubetskaya"
## [23] "женщина"                              
## [24] "Julie_Karagina"                       
## [25] "Nikolai_Rostov"                       
## [26] "AndreyBolkonsky"                      
## [27] "Bolhovitinov"                         
## [28] "Mikhail_Ilarionovich_Kutuzov"         
## [29] "Anatole_Kuragin"                      
## [30] "Vasili_Kuragin"

Клики — полностью связанные подграфы (тройки и больше)

cl <- cliques(g, min = 3)
length(cl)              # сколько клик всего
## [1] 402
largest_cliques(g)      # самые крупные клики
## [[1]]
## + 6/206 vertices, named, from d518c68:
## [1] Vasily__Vasska__Denisov  Nikolai_Rostov           Pierre_Bezukhov         
## [4] NatashaRostova           Countess_Natalya_Rostova AndreyBolkonsky         
## 
## [[2]]
## + 6/206 vertices, named, from d518c68:
## [1] Princess_Mariya_Bolkonskaya AndreyBolkonsky            
## [3] Pierre_Bezukhov             Nikolai_Rostov             
## [5] NatashaRostova              Countess_Natalya_Rostova

Визуализация сети

Рисуем общую сеть персонажей с ggraph Узлы по размеру отражают strength, по цвету — betweenness geom_edge_link показывает рёбра, а geom_node_text имена персонажей

ggraph(g, layout = "fr") +
  geom_edge_link(aes(width = weight), alpha = 0.3) +
  geom_node_point(aes(size = strength, color = betweenness)) +
  geom_node_text(aes(label = name), repel = TRUE, max.overlaps = Inf) +
  theme_void()

Общий вид сети.

Ego-граф

Строим ego-граф для самого “центрального” персонажа (макс betweenness) Это показывает только ближайшее окружение персонажа

ego_node <- which.max(V(g)$betweenness)
ego_g <- make_ego_graph(g, order = 1, nodes = ego_node)[[1]]

ggraph(ego_g, layout = "fr") +
  geom_edge_link(aes(width = weight), alpha = 0.5) +
  geom_node_point(aes(size = strength, color = betweenness)) +
  geom_node_text(aes(label = name), repel = TRUE, size = 4) +
  scale_color_viridis_c(option = "plasma") +
  theme_void() +
  ggtitle("Ego-граф центрального персонажа — force-directed")

Окружение центрального персонажа.

Сообщества

Выделяем сообщества методом Louvain suppressWarnings, чтобы не было лишних предупреждений Мера качества разбиения на сообщества

comm <- suppressWarnings(cluster_louvain(g, weights = E(g)$weight))
V(g)$community <- membership(comm)

modularity(comm)
## [1] 0.4247657

Кластеры.

Визуализация сообществ

Красим узлы по принадлежности к сообществу Пример визуализации сети с группами

ggraph(g, layout = "fr") +
  geom_edge_link(alpha = 0.2) +
  geom_node_point(aes(color = factor(community), size = strength)) +
  theme_void()

Группы персонажей.

Топ персонажей

Выбираем 15 персонажей с самой высокой силой связей (strength)

top_chars <- tibble(
  name = V(g)$name,
  strength = V(g)$strength
) |>
  arrange(desc(strength)) |>
  slice(1:15)

top_chars

Лидеры сети.

График топа

Визуализируем топ-15 персонажей по strength Используем coord_flip, чтобы имена были читаемыми

ggplot(top_chars, aes(x = reorder(name, strength), y = strength)) +
  geom_col(fill = "darkred") +
  coord_flip() +
  theme_minimal()

Визуализация топа.

Интерактивная сеть

Делаем интерактивную версию графа с visNetwork Можно выделять соседей и искать по имени

vis_nodes <- tibble(
  id    = V(g)$name,
  label = V(g)$name,
  value = V(g)$strength,
  group = V(g)$community
)

vis_edges <- tibble(
  from  = edges$speaker,
  to    = edges$addressee,
  value = edges$weight
)

net <- visNetwork(vis_nodes, vis_edges) |>
  visOptions(
    highlightNearest = TRUE,
    nodesIdSelection = TRUE
  ) |>
  visPhysics(solver = "forceAtlas2Based")

# Показываем интерактивный граф

net

Интерактивный граф.

Сохранение графа

htmlwidgets::saveWidget(net, "network.html", selfcontained = TRUE)

Визуализация крупнейшей клики

# Находим самую крупную клику (полностью связанную подгруппу)
largest_cl <- largest_cliques(g)[[1]]

# Создаем подграф для этой клики
clique_g <- induced_subgraph(g, vids = largest_cl)

ggraph(clique_g, layout = "circle") +
  geom_edge_link(aes(width = weight), color = "darkgreen") +
  geom_node_point(aes(size = strength), color = "orange") +
  geom_node_text(aes(label = name), repel = TRUE) +
  ggtitle("Самая крупная клика персонажей") +
  theme_void()