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

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

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) #фильтруем для отсечения случайных встреч

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

# Создаем объект tidygraph
net_work <- as_tbl_graph(pair_links, directed = FALSE) %>%
  activate(nodes) |>
  mutate(
    importance = centrality_pagerank(), 
    degree = centrality_degree(),
    community = as.factor(group_louvain()) # используем алгоритм Louvain 
  ) |>
  activate(edges) |>
  mutate(type = ifelse(weight > 10, "Strong", "Weak")) # Атрибут ребер (Критерий 2)

cat("узлов:", vcount(net_work), "\n")

узлов: 88 

cat("ребер:", ecount(net_work), "\n")

ребер: 325 

cat("Плотность сети:", round(edge_density(net_work), 4), "\n")

Плотность сети: 0.0849 

Дальше смотрим модулярность – все это используя алгоритм Louvrain

g_igraph <- as.igraph(net_work)
louvain_comm <- cluster_louvain(g_igraph)
m_value <- modularity(louvain_comm)

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

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

Такая модулярность подтверждает, что в романе много “сквозных” персонажей, которые пересекаются друг с другом.

Теперь смотрим клики:

art_points <- articulation_points(g_igraph)
cat("\nКлючевые 'мосты' сюжета:", V(g_igraph)$name[art_points][1:5], "...\n")

Ключевые 'мосты' сюжета: Napoleon_Bonaparte Dmitry_Dokhturov Mikhail_Ilarionovich_Kutuzov Countess_Natalya_Rostova Pierre_Bezukhov ...

cl_list <- largest_cliques(g_igraph)
cat("Размер крупнейшей клики:", length(cl_list[[1]]), "персонажей.\n")

Размер крупнейшей клики: 9 персонажей.

Создаем подграф – на основе ядра, без второстепенных персонажей:

core_net <- net_work |>
  activate(nodes) |>
  filter(node_coreness() >= 3) 

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

library(ggraph)
library(viridis)

if (exists("core_net")) {
  
  #оставляем только важные связи (вес >= 5), чтобы убрать "шум"
  plot_data <- core_net |>
    activate(edges) |>
    filter(weight >= 5) |>
    activate(nodes) |>
    filter(!node_is_isolated())
  p <- ggraph(plot_data, layout = "stress") + 
    
    geom_edge_link(aes(edge_width = weight), 
                   color = "grey85", 
                   alpha = 0.4, 
                   show.legend = FALSE) +
    
    geom_node_point(aes(size = importance, color = community), 
                    alpha = 0.8) +
    
    geom_node_text(aes(label = name), 
                   repel = TRUE, 
                   size = 4, 
                   family = "serif", 
                   fontface = "italic",
                   color = "grey10") +
    
    scale_size_continuous(range = c(3, 12), name = "Влияние") +
    scale_color_viridis_d(option = "mako", begin = 0.2, end = 0.8, name = "Сообщество") +
    scale_edge_width(range = c(0.2, 1.5)) +
    
    #оформление
    theme_graph(base_family = "serif") +
    theme(
      legend.position = "bottom",
      plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
      plot.subtitle = element_text(hjust = 0.5, size = 11, color = "grey40")
    ) +
    labs(
      title = "Ключевая структура персонажей 'Войны и мира'",
    )
  print(p)
}