1. Импорт данных

Разметка содержит:

  • Упоминания персонажей: тег <rs ref="ID" rolename="...">
  • Прямую речь: тег <said who="говорящий" corresp="адресат">
  • Семантические роли: agent, undergoer, experiencer
  • Структуру: 4 тома

Два персонажа считаются связанными, если они оба упомянуты в одной главе (co-occurrence) или ведут диалог (<said>). Вес ребра - это число глав совместного появления и число диалоговых реплик. Анализируются все 4 тома.

library(xml2)
library(tidyverse)
library(igraph)
library(ggraph)
# Скачиваем XML (если файла нет локально)
if (!file.exists("War_and_Peace.xml")) {
  download.file(
    "https://dataverse.pushdom.ru/api/access/datafile/4212",
    destfile = "War_and_Peace.xml", mode = "wb"
  )
}

doc <- read_xml("War_and_Peace.xml")
ns  <- xml_ns(doc)
# Извлечение списка персонажей из заголовка
persons    <- xml_find_all(doc, ".//d1:person", ns)
person_ids <- xml_attr(persons, "id")

get_person_name <- function(node) {
  forenames <- xml_text(xml_find_all(node, ".//d1:forename", ns))
  surnames  <- xml_text(xml_find_all(node, ".//d1:surname", ns))
  parts <- trimws(c(forenames, surnames))
  parts <- parts[parts != ""]
  if (length(parts) == 0) {
    return(trimws(xml_text(xml_find_first(node, ".//d1:persName", ns))))
  }
  paste(parts[1], tail(parts, 1), sep = " ")
}

person_names <- sapply(persons, get_person_name)
id_to_name   <- setNames(person_names, person_ids)
cat("Всего персонажей в header:", length(person_ids))
## Всего персонажей в header: 84

2. Парсинг глав и построение рёбер

chapters <- xml_find_all(doc, ".//d1:div[@type='chapter']", ns)
cat("Глав в романе:", length(chapters))
## Глав в романе: 358
get_volume <- function(ch) {
  vol_node <- xml_find_first(ch, "ancestor::d1:div[@type='volume']", ns)
  if (!is.na(vol_node)) xml_attr(vol_node, "n") else NA_character_
}

chapter_data <- map_dfr(seq_along(chapters), function(i) {
  ch    <- chapters[[i]]
  ch_id <- xml_attr(ch, "id")
  vol   <- get_volume(ch)

  rs_refs <- xml_attr(xml_find_all(ch, ".//d1:rs[@ref]", ns), "ref")
  rs_refs <- rs_refs[rs_refs != "" & !is.na(rs_refs)]

  said_nodes   <- xml_find_all(ch, ".//d1:said[@who]", ns)
  said_who     <- xml_attr(said_nodes, "who")
  said_corresp <- xml_attr(said_nodes, "corresp")

  all_chars <- unique(c(rs_refs, said_who, said_corresp))
  all_chars <- all_chars[all_chars != "" & !is.na(all_chars)]
  all_chars <- all_chars[all_chars %in% person_ids]

  tibble(chapter_id = ch_id, volume = vol, character_id = all_chars)
})

cat("Записей (персонаж x глава):", nrow(chapter_data))
## Записей (персонаж x глава): 1848
# Рёбра: совместное появление в главе
edges_cooccurrence <- chapter_data %>%
  inner_join(chapter_data, by = "chapter_id",
             relationship = "many-to-many") %>%
  filter(character_id.x < character_id.y) %>%
  count(character_id.x, character_id.y, name = "weight") %>%
  rename(from = character_id.x, to = character_id.y)

# Диалоговые связи
said_all <- xml_find_all(doc, ".//d1:said[@who]", ns)
dialog_edges <- tibble(
  who     = xml_attr(said_all, "who"),
  corresp = xml_attr(said_all, "corresp")
) %>%
  filter(corresp != "" & !is.na(corresp),
         who %in% person_ids, corresp %in% person_ids,
         who != corresp) %>%
  mutate(from = pmin(who, corresp), to = pmax(who, corresp)) %>%
  count(from, to, name = "dialog_weight")

# Объединяем
edges_final <- edges_cooccurrence %>%
  left_join(dialog_edges, by = c("from", "to")) %>%
  replace_na(list(dialog_weight = 0)) %>%
  mutate(
    total_weight = weight + dialog_weight,
    type = ifelse(dialog_weight > 0, "dialog+co-occurrence", "co-occurrence")
  )

cat("Итого рёбер:", nrow(edges_final))
## Итого рёбер: 998

3. Создание графа и описание

g <- graph_from_data_frame(
  edges_final %>% select(from, to,
    weight = total_weight, type,
    cooccurrence_weight = weight, dialog_weight),
  directed = FALSE,
  vertices = tibble(name = person_ids) %>%
    filter(name %in% c(edges_final$from, edges_final$to))
)
V(g)$label <- id_to_name[V(g)$name]

cat("Тип: неориентированный, взвешенный\n")
## Тип: неориентированный, взвешенный
cat("Узлов:", vcount(g), "\n")
## Узлов: 82
cat("Рёбер:", ecount(g), "\n")
## Рёбер: 998
cat("Компонент связности:", components(g)$no, "\n")
## Компонент связности: 1
cat("Плотность:", round(graph.density(g), 4), "\n")
## Плотность: 0.3005

Атрибуты рёбер: weight (суммарный вес), type (dialog+co-occurrence / co-occurrence), dialog_weight, cooccurrence_weight.

4. Атрибуты узлов

V(g)$degree      <- degree(g)
V(g)$strength    <- strength(g)
V(g)$betweenness <- betweenness(g, weights = 1 / E(g)$weight)
V(g)$closeness   <- closeness(g, weights = 1 / E(g)$weight)
V(g)$eigenvector <- eigen_centrality(g, weights = E(g)$weight)$vector

tibble(
  Персонаж    = V(g)$label,
  Степень     = V(g)$degree,
  `Взв. степень` = V(g)$strength,
  Betweenness = round(V(g)$betweenness, 1),
  Eigenvector = round(V(g)$eigenvector, 4)
) %>%
  arrange(desc(Степень)) %>%
  head(15) %>%
  knitr::kable(caption = "Топ-15 персонажей по степени")
Топ-15 персонажей по степени
Персонаж Степень Взв. степень Betweenness Eigenvector
Наполеон Бонапарт 70 483 174.0 0.1513
Андрей Болконский 68 1518 1786.0 0.6818
Александр Александр 67 566 86.0 0.1844
Михаил Кутузов 61 467 925.5 0.1361
Петр Безухов 52 1534 1142.5 0.7450
Наталья Ростова 52 1654 1250.0 1.0000
Петр Багратион 50 218 0.0 0.0767
Николай Ростов 48 1427 803.0 0.7566
Марья Болконская 46 877 315.0 0.5157
Вася Денисов 45 496 89.0 0.2595
Федор Долохов 44 436 80.0 0.1884
Николай Болконский 44 422 0.0 0.1934
Илья Ростов 43 671 182.0 0.3754
Борис Друбецкой 43 529 12.0 0.3015
Сонюшка Ростова 43 778 0.0 0.5838

5. Визуализация полного графа

g_vis <- delete_edges(g, E(g)[E(g)$weight < 5])
g_vis <- delete_vertices(g_vis, V(g_vis)[degree(g_vis) == 0])

set.seed(123)
ggraph(g_vis, layout = "fr") +
  geom_edge_link(aes(width = weight, alpha = weight),
                 color = "grey60", show.legend = FALSE) +
  geom_node_point(aes(size = degree(g)[V(g_vis)$name]),
                  color = "#2c3e50", alpha = 0.8) +
  geom_node_text(aes(label = label),
                 size = 2.5, repel = TRUE, max.overlaps = 20) +
  scale_edge_width(range = c(0.3, 3)) +
  scale_edge_alpha(range = c(0.2, 0.8)) +
  scale_size_continuous(range = c(2, 12), name = "Степень") +
  labs(
    title = "Сеть персонажей «Войны и мира»",
    subtitle = "Рёбра: совместное появление в главе (вес >= 5). Размер узла ~ степени"
  ) +
  theme_graph(base_family = "sans") +
  theme(plot.title = element_text(face = "bold", size = 14))

6. Подграф: ego-граф Пьера Безухова

Обоснование: Пьер Безухов — один из центральных персонажей с наибольшей степенью. Его ego-граф (порядка 1) показывает ближайшее окружение и связи между соседями, позволяя увидеть, как Пьер соединяет сюжетные линии Ростовых, Болконских, Курагиных и военные эпизоды.

ego_pierre <- make_ego_graph(g, order = 1,
                              nodes = "Pierre_Bezukhov")[[1]]

ego_vis <- delete_edges(ego_pierre,
  E(ego_pierre)[E(ego_pierre)$weight < 3])
ego_vis <- delete_vertices(ego_vis,
  V(ego_vis)[degree(ego_vis) == 0])

cat("Ego-граф Пьера: узлов =", vcount(ego_pierre),
    ", рёбер =", ecount(ego_pierre), "\n")
## Ego-граф Пьера: узлов = 53 , рёбер = 699
set.seed(123)
ggraph(ego_vis, layout = "fr") +
  geom_edge_link(aes(width = weight, alpha = weight),
                 color = "grey50", show.legend = FALSE) +
  geom_node_point(
    aes(size = degree(ego_vis)),
    color = ifelse(V(ego_vis)$name == "Pierre_Bezukhov",
                   "#e74c3c", "#3498db"),
    alpha = 0.8) +
  geom_node_text(aes(label = label),
                 size = 3, repel = TRUE, max.overlaps = 25) +
  scale_edge_width(range = c(0.3, 2.5)) +
  scale_edge_alpha(range = c(0.3, 0.9)) +
  scale_size_continuous(range = c(3, 14), guide = "none") +
  labs(
    title = "Ego-граф Пьера Безухова (порядок 1)",
    subtitle = "Ближайшее окружение. Красный = Пьер, размер ~ степени в подграфе",
    caption = "Рёбра с весом < 3 удалены для читаемости"
  ) +
  theme_graph(base_family = "sans")

7. Анализ сообществ (Louvain)

set.seed(42)
comm_louvain <- cluster_louvain(g, weights = E(g)$weight)
V(g)$community <- membership(comm_louvain)

cat("Число сообществ:", length(comm_louvain), "\n")
## Число сообществ: 4
cat("Модулярность Q:", round(modularity(comm_louvain), 4), "\n")
## Модулярность Q: 0.2495
# Размеры сообществ
sort(sizes(comm_louvain), decreasing = TRUE)
## Community sizes
##  3  1  4  2 
## 29 19 18 16
# Состав крупнейших сообществ
comm_sizes <- sizes(comm_louvain)
top_comms  <- names(sort(comm_sizes, decreasing = TRUE))[1:min(5, length(comm_sizes))]

for (ci in top_comms) {
  members <- V(g)$name[V(g)$community == as.integer(ci)]
  labels  <- id_to_name[members]
  degs    <- V(g)$degree[V(g)$community == as.integer(ci)]
  labels  <- labels[order(degs, decreasing = TRUE)]
  cat(sprintf("Сообщество %s (%d чел.): %s\n\n",
              ci, length(members),
              paste(head(labels, 10), collapse = ", ")))
}
## Сообщество 3 (29 чел.): Наполеон Бонапарт, Александр Александр, Михаил Кутузов, Петр Багратион, Бенигсен Бенигсен, Федор Растопчин, Несвицкий Несвицкий, Мюрат Мюрат, Мак Мак, Вольцоген Вольцоген
## 
## Сообщество 1 (19 чел.): Наталья Ростова, Николай Ростов, Вася Денисов, Илья Ростов, Борис Друбецкой, Сонюшка Ростова, Ростова Ростова, Альфонс Берг, Петя Ростов, Шиншин Шиншин
## 
## Сообщество 4 (18 чел.): Петр Безухов, Федор Долохов, Элен Курагина, Василий Курагин, Анатоль Курагин, Жюли Друбецкая, Анна Друбецкая, Кирилл Безухов, Анна Шерер, Ипполит Курагин
## 
## Сообщество 2 (16 чел.): Андрей Болконский, Марья Болконская, Николай Болконский, Елизавета Болконская, NA, Яков Алпатыч, Десаль Десаль, Билибин Билибин, Михаил Сперанский, Николенька Болконский
g_comm <- g_vis
V(g_comm)$community <- V(g)$community[match(V(g_comm)$name, V(g)$name)]

set.seed(123)
ggraph(g_comm, layout = "fr") +
  geom_edge_link(aes(width = weight), alpha = 0.15,
                 color = "grey50", show.legend = FALSE) +
  geom_node_point(aes(color = factor(community),
                       size = degree(g_comm)), alpha = 0.85) +
  geom_node_text(aes(label = label),
                 size = 2.5, repel = TRUE, max.overlaps = 20) +
  scale_edge_width(range = c(0.2, 2)) +
  scale_color_brewer(palette = "Set2", name = "Сообщество") +
  scale_size_continuous(range = c(2, 12), guide = "none") +
  labs(
    title = "Сообщества персонажей (Louvain)",
    subtitle = paste0("Модулярность Q = ",
                      round(modularity(comm_louvain), 3),
                      ". Цвет = сообщество, размер ~ степени")
  ) +
  theme_graph(base_family = "sans") +
  theme(legend.position = "right")

Walktrap (для сравнения)

comm_walktrap <- cluster_walktrap(g, weights = E(g)$weight)
cat("Walktrap: сообществ =", length(comm_walktrap),
    ", модулярность =", round(modularity(comm_walktrap), 4), "\n")
## Walktrap: сообществ = 8 , модулярность = 0.195

8. Модулярность

Модулярность Q (Louvain) указывает на то, насколько плотность связей внутри сообществ превышает ожидаемую при случайном распределении рёбер. Значение Q > 0.3 свидетельствует о выраженной модульной структуре: персонажи группируются в сообщества, соответствующие сюжетным линиям (семья Ростовых, Болконских, петербургский свет, военные эпизоды и т.д.).

9. Точки сочленения и клики

art_points <- articulation_points(g)
cat("Точек сочленения:", length(art_points), "\n")
## Точек сочленения: 0
cat("Примеры:", paste(head(id_to_name[V(g)$name[art_points]], 10),
                      collapse = ", "), "\n")
## Примеры:

Точки сочленения — вершины, удаление которых увеличивает число компонент связности. Это персонажи, единственным образом связывающие отдельные эпизоды.

all_cliques <- max_cliques(g, min = 4)
cat("Клик (размер >= 4):", length(all_cliques), "\n")
## Клик (размер >= 4): 212
largest <- largest_cliques(g)
cat("Наибольшая клика:", length(largest[[1]]), "чел.\n")
## Наибольшая клика: 23 чел.
cat("Состав:", paste(id_to_name[V(g)$name[largest[[1]]]],
                     collapse = ", "), "\n")
## Состав: Петр Безухов, Илья Ростов, Андрей Болконский, Наполеон Бонапарт, Александр Александр, Борис Друбецкой, Марья Болконская, Наталья Ростова, Ростова Ростова, Николай Ростов, Сонюшка Ростова, Анна Друбецкая, Шиншин Шиншин, Федор Долохов, Элен Курагина, Альфонс Берг, Федор Растопчин, Вася Денисов, Василий Курагин, Елизавета Болконская, Николай Болконский, Петр Багратион, Михаил Кутузов

Наибольшие клики соответствуют сценам с одновременным присутствием многих персонажей (балы, сражения, семейные собрания).

10. Заключение

Сетевой анализ «Войны и мира» показывает характерные свойства социальной сети: выраженные сообщества (семейно-сюжетные линии), узлы-хабы и модульную структуру. Пьер Безухов, Наташа Ростова и князь Андрей выступают ключевыми связующими звеньями между разными частями романа.