Анализ диалогов персонажей романа ‘Война и мир’

Начало работы

Грузим библиотеки и данные

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

Загружаем XML-файл романа

ns <- c(tei = "http://www.tei-c.org/ns/1.0")
xml_file_path <- "War_and_Peace.xml"

doc <- read_xml(xml_file_path)

Персонажи

Найдем всех персонажей

persons <- xml_find_all(doc, "//tei:person", ns = ns)

xml_strip_text <- \(text) text |>
  xml_text() |>
  str_squish()

build_name <- function(pers_name_node) {
  forename <- pers_name_node |>
    xml_find_all(".//tei:forename", ns = ns) |>
    xml_strip_text()
  
  surname <- pers_name_node |>
    xml_find_all(".//tei:surname", ns = ns) |>
    xml_strip_text()
  
  patronymic <- pers_name_node |>
    xml_find_first(".//tei:patronymic", ns = ns) |>
    xml_strip_text()
  
  name_parts <- c(forename, patronymic, surname)
  name_parts <- name_parts[!is.na(name_parts) & name_parts != ""]
  
  if (length(name_parts) == 0) {
    return(xml_text(pers_name_node) |> str_squish())
  }
  
  paste(name_parts, collapse = " ")
}

Соберем их в таблицу

person_list <- persons |>
  map_df(function(p) {
    pid <- xml_attr(p, "id")
    pers_name <- xml_find_first(p, ".//tei:persName", ns = ns)
    name_text <- build_name(pers_name) |> str_squish()
    
    if (is.na(name_text) || name_text == "") {
      name_text <- pid
    }
    
    tibble(id = pid, name = name_text)
  }) |>
  distinct(id, .keep_all = TRUE) |>
  filter(!is.na(name), name != "")

cat("Персонажей всего:", nrow(person_list), "\n\n")

Персонажей всего: 84 

Диалоги

Достанем диалоги

said_nodes <- xml_find_all(doc, "//tei:said[@who]", ns = ns)

cat("Найдено реплик (said) с атрибутом who:", length(said_nodes), "\n")

Найдено реплик (said) с атрибутом who: 6306 

# для поиска абзаца-родителя
find_parent_paragraph <- function(node) {
  p <- xml_parent(node)
  while (!is.na(p) && xml_name(p) != "p") {
    p <- xml_parent(p)
  }
  return(p)
}

extract_persons_from_paragraph <- function(paragraph) {
  if (is.na(paragraph) || xml_name(paragraph) != "p") return(character(0))
  
  rs_nodes <- xml_find_all(paragraph, ".//tei:rs[@ref]", ns = ns)
  rs_nodes |>
    map_chr(~ xml_attr(.x, "ref") |> str_remove("^#")) |>
    unique()
}

dialogues_df <- map_dfr(said_nodes, function(said) {
  speaker <- xml_attr(said, "who") |> str_remove("^#")
  if (is.na(speaker) || speaker == "") return(NULL)
  
  # абзац диалога
  parent_p <- find_parent_paragraph(said)
  if (is.na(parent_p) || xml_name(parent_p) != "p") return(NULL)
  
  # персонажи в абзаце
  all_persons <- extract_persons_from_paragraph(parent_p)
  
  # адресатами считаем всех, кроме говорящего
  addressees <- setdiff(all_persons, speaker)
  
  if (length(addressees) == 0) return(NULL)
  
  # ребра от говорящего до адресатов
  map_dfr(addressees, function(addressee) {
    tibble(from = speaker, to = addressee, weight = 1)
  })
})

cat("Найдено диалогов:", nrow(dialogues_df), "\n")

Найдено диалогов: 3709 

Суммируем веса, собираем ребра

edges_df <- dialogues_df |>
  group_by(from, to) |>
  summarise(weight = sum(weight), .groups = "drop") |>
  mutate(
    from_sorted = pmin(from, to),
    to_sorted = pmax(from, to)
  ) |>
  group_by(from_sorted, to_sorted) |>
  summarise(weight = sum(weight), .groups = "drop") |>
  rename(from = from_sorted, to = to_sorted)

cat("Уникальных взаимодействий (пар персонажей):", nrow(edges_df), "\n")

Уникальных взаимодействий (пар персонажей): 746 

cat("Всего диалогов:", sum(edges_df$weight), "\n\n")

Всего диалогов: 3709 

Некоторые персонажи, упомянутые в диалогах, могут отсутствовать в <listPerson>. Добавим их.

vertex_ids_from_edges <- unique(c(edges_df$from, edges_df$to))

# какие id из рёбер отсутствуют в person_list
missing_ids <- setdiff(vertex_ids_from_edges, person_list$id)

if (length(missing_ids) > 0) {
  cat("Найдено", length(missing_ids), "ID персонажей в рёбрах, которых нет в person_list\n")

  missing_persons <- tibble(
    id = missing_ids,
    name = missing_ids
  )
  
  person_list <- bind_rows(person_list, missing_persons) |>
    distinct(id, .keep_all = TRUE)
}

Найдено 200 ID персонажей в рёбрах, которых нет в person_list

# у всех должно быть имя
person_list <- person_list |>
  mutate(name = ifelse(is.na(name) | name == "", id, name))

Граф диалогов

g <- graph_from_data_frame(edges_df, directed = FALSE, vertices = person_list)

V(g)$display_name <- V(g)$name
V(g)$id <- V(g)$name

Описание графа

Проверим связность

is_connected(g)

[1] FALSE

Несвязный.

Ненаправленный.

cat("Количество вершин:", vcount(g), "\n")

Количество вершин: 284 

cat("Количество рёбер:", ecount(g), "\n")

Количество рёбер: 746 

cat("Плотность графа:", round(edge_density(g), 4), "\n")

Плотность графа: 0.0186 

cat("Количество компонент связности:", count_components(g), "\n")

Количество компонент связности: 7 

Граф очень большой и разреженный, много персонажей, но мало кто взаимодействует со всеми или почти всеми остальными (что ожидаемо)

Центральности

V(g)$degree <- degree(g, mode = "all")
V(g)$weighted_degree <- strength(g)

V(g)$betweenness <- betweenness(g, normalized = TRUE)

V(g)$closeness <- closeness(g, normalized = TRUE)
V(g)$eigen_centrality <- eigen_centrality(g)$vector
V(g)$coreness <- coreness(g)

Подграф: топ-15 персонажей по кол-ву диалогов

Обоснование: хотим посмотреть на наиболее “разговорчивых” персонажей

top_n <- 15

degree_df <- data.frame(
  name = V(g)$name,
  weighted_degree = V(g)$weighted_degree
) |>
  arrange(desc(weighted_degree)) |>
  head(top_n)

top_nodes <- degree_df$name
g_core <- induced_subgraph(g, top_nodes)

Характеристики подграфа

cat("Метод: топ-", length(top_nodes), "персонажей по количеству диалогов\n")

Метод: топ- 15 персонажей по количеству диалогов

cat("Вершин в подграфе:", vcount(g_core), "\n")

Вершин в подграфе: 15 

cat("Рёбер в подграфе:", ecount(g_core), "\n")

Рёбер в подграфе: 83 

cat("Плотность подграфа:", round(edge_density(g_core), 4), "\n")

Плотность подграфа: 0.7905 

У подграфа плотность гораздо выше, чем у графа. Топ-15 персонажей по кол-ву диалогов активно взаимодействуют друг с другом (являются таким “ядром” произведения)

Персонажи

print(degree_df)

Сообщества

set.seed(42)
communities <- cluster_walktrap(g, weights = E(g)$weight)

V(g)$community <- membership(communities)

mod_val <- modularity(communities)

Результат анализа сообществ с помощью walktrap

cat("Модулярность:", round(mod_val, 4), "\n")

Модулярность: 0.351 

cat("Количество сообществ:", max(V(g)$community), "\n")

Количество сообществ: 112 

модулярность > 0.3 указывает на значимую кластерную структуру (хорошо выделяются кластера). То есть, хорошо выделимы (заметны) группы часто общающихся персонажей.

articulation_pts <- articulation_points(g)

articulation_names <- V(g)$name[articulation_pts]
cat("Найдено:", length(articulation_pts), "точек сочленения\n")

Найдено: 39 точек сочленения

cat("Примеры:", paste(head(articulation_names, 10), collapse = ", "), "\n")

Примеры: Рамбаль, Василий Сергеевич Курагин, Ипполит Курагин, abbe_Morio, Анна Павловна Шерер, Тушин, Вася Василий Васька Дмитрич Денисов, Жерков, Яков Алпатыч, Ростова 

clique_max_size <- tryCatch(clique_num(g), error = function(e) NA)
cat("Наибольшая клика содержит", clique_max_size, "персонажей\n")

Наибольшая клика содержит 9 персонажей

Топ-20 персонажей по центральностям

top_characters <- data.frame(
  Персонаж = V(g)$name,
  Диалогов = V(g)$weighted_degree,
  Партнёров = V(g)$degree,
  Betweenness = round(V(g)$betweenness, 4),
  Closeness = round(V(g)$closeness, 4),
  Eigenvector = round(V(g)$eigen_centrality, 4),
  Coreness = V(g)$coreness,
  Сообщество = V(g)$community
) |>
  arrange(desc(Диалогов)) |>
  head(20)

print(top_characters)

NA

Визуализация основного графа (топ-15)

top_n_main <- 15
top_indices <- order(V(g)$weighted_degree, decreasing = TRUE)[1:min(top_n_main, vcount(g))]
top_nodes_main <- V(g)$name[top_indices]
top_nodes_main <- top_nodes_main[!is.na(top_nodes_main)]

g_top <- induced_subgraph(g, top_nodes_main)

min_edge_weight <- 30
g_top_filtered <- subgraph.edges(g_top, eids = which(E(g_top)$weight >= min_edge_weight), delete.vertices = FALSE)

set.seed(42)
p_main <- ggraph(g_top_filtered, layout = "stress") +
  geom_edge_link(aes(alpha = weight, width = weight), 
                 color = "grey50", show.legend = FALSE) +
  geom_node_point(aes(size = weighted_degree, 
                      fill = as.factor(community)),
                  shape = 21, color = "grey30", alpha = 0.9) +
  geom_node_text(aes(label = name),
                 repel = TRUE, size = 3.5) +
  scale_size_continuous(range = c(4, 16), name = "Количество диалогов") +
  scale_fill_brewer("Сообщество", palette = "Set3") +
  labs(title = "Сеть диалогов персонажей романа 'Война и мир'",
       subtitle = paste0("Топ-15 по количеству диалогов | Вес рёбер ≥ ", min_edge_weight, " | ",
                         "Модулярность = ", round(mod_val, 3), " | ",
                         "Вершин: ", vcount(g_top_filtered), " | Рёбер: ", ecount(g_top_filtered))) +
  theme_graph() +
  theme(legend.position = "bottom")

print(p_main)

Визуализация подграфа (топ-15)

set.seed(42)
p_core <- ggraph(g_core, layout = "stress") +
  geom_edge_link(aes(alpha = weight, width = weight), 
                 color = "grey50", show.legend = FALSE) +
  geom_node_point(aes(size = weighted_degree, 
                      fill = as.factor(coreness)),
                  shape = 21, color = "grey30", alpha = 0.9) +
  geom_node_text(aes(label = name),
                 repel = TRUE, size = 4, fontface = "bold") +
  scale_size_continuous(range = c(5, 18), name = "Количество диалогов") +
  scale_fill_brewer("K-core", palette = "RdYlBu") +
  labs(title = "Топ-15 персонажей по количеству диалогов",
       subtitle = paste0("Вершин: ", vcount(g_core), " | Рёбер: ", ecount(g_core), 
                         " | Плотность: ", round(edge_density(g_core), 3))) +
  theme_graph() +
  theme(legend.position = "bottom")

print(p_core)