library(xml2)
library(tidyverse)
library(igraph)
library(visNetwork)
library(ggraph)Персонажи “Войны и мира” Л. Н. Толстого
Исследуем разговоры в “Войне и мире”
Используемые библиотеки
Сбор данных для сети
Загружаю документ, определяю пространство имен и использую язык XPath, чтобы добраться до нужных мне узлов. Я ищу все реплики said, поскольку хочу определить вес рёбер в графе взаимодействий как количество раз, когда персонажи между собой разговаривали. Причем граф получится направленный - в тексте размечены и говорящий, и адресат речи.
doc <- read_xml("War_and_Peace.xml")
ns <- xml_ns(doc)
said_nodes <- xml_find_all(doc, "//d1:said", ns)Создаю функцию, которая предназначена для обработки тега said. В ней нахожу пары взаимодействий: говорящий + слушающий.
extract_said_interactions <- function(said_node) {
speaker <- xml_attr(said_node, "who")
listener <- xml_attr(said_node, "corresp")
# Убираю те строки, где один из участников коммуникации пустой
if (!is.na(speaker) & !is.na(listener) & speaker != "" & listener != "") {
return(list(c(speaker, listener)))
} else {
return(NULL)
}
}Собираю все взаимодействия персонажей и преобразую в тиббл.
interactions <- list()
for (node in said_nodes) {
pair <- extract_said_interactions(node)
if (!is.null(pair)) {
interactions <- append(interactions, pair)
}
}
data <- as_tibble(do.call(rbind, interactions)) |>
rename(source = V1, target = V2) |>
count(source, target, name = "weight") |>
filter(!is.na(source) & !is.na(target) & source != "" & target != "") |>
filter(weight > 2) |>
arrange(-weight)
data# A tibble: 396 × 3
source target weight
<chr> <chr> <int>
1 NatashaRostova Sonya_Rostova 127
2 NatashaRostova Nikolai_Rostov 123
3 AndreyBolkonsky Pierre_Bezukhov 117
4 NatashaRostova Countess_Natalya_Rostova 110
5 Pierre_Bezukhov AndreyBolkonsky 92
6 Nikolai_Rostov NatashaRostova 91
7 Telyanin Nikolai_Rostov 89
8 Pierre_Bezukhov NatashaRostova 82
9 Boris_Drubetskoy Nikolai_Rostov 77
10 Sonya_Rostova NatashaRostova 76
# ℹ 386 more rowsСоздание объекта графа
g <- graph_from_data_frame(data, directed = TRUE)
gIGRAPH 36243e5 DNW- 149 396 --
+ attr: name (v/c), weight (e/n)
+ edges from 36243e5 (vertex names):
[1] NatashaRostova ->Sonya_Rostova
[2] NatashaRostova ->Nikolai_Rostov
[3] AndreyBolkonsky ->Pierre_Bezukhov
[4] NatashaRostova ->Countess_Natalya_Rostova
[5] Pierre_Bezukhov ->AndreyBolkonsky
[6] Nikolai_Rostov ->NatashaRostova
[7] Telyanin ->Nikolai_Rostov
[8] Pierre_Bezukhov ->NatashaRostova
+ ... omitted several edgesОсновные характеристики графа:
D - Directed (граф направленный)
N - Named (вершины именованные)
W - Weighted (граф взвешенный)
149 вершин
vcount(g)[1] 149- 396 ребер
ecount(g)[1] 396- Плотность графа
edge_density(g)[1] 0.01795755- Число компонент
components(g)$no[1] 4- Размеры компонент
components(g)$csize[1] 144 2 2 1- Кто не связан с главной компонентой
which(components(g)$membership !=1) берейтор Лоррен чиновник Тит Вторая княжна
45 108 125 127 148 - Диаметр сети
lgc <- largest_component(g)
diameter(lgc, directed = TRUE)[1] 122get_diameter(lgc)+ 4/144 vertices, named, from 9f2b1e6:
[1] Telyanin Nikolai_Rostov AndreyBolkonsky Bilibin farthest_vertices(lgc)$vertices
+ 2/144 vertices, named, from 9f2b1e6:
[1] Telyanin Bilibin
$distance
[1] 122- Транзитивность
transitivity(g)[1] 0.1328935Показатель важности узлов
Добавим показатель важности узлов. В нашем случае это будет престиж, поскольку сеть направленная.
degrees <- degree(g, mode = "in")
V(g)$in_degree <- degree(g, mode = "in")
sort(degrees, decreasing = T)[1:10] Pierre_Bezukhov Nikolai_Rostov
42 35
AndreyBolkonsky NatashaRostova
29 22
Princess_Mariya_Bolkonskaya Count_Ilya_Rostov
14 11
Countess_Natalya_Rostova Vasily__Vasska__Denisov
9 9
Fedor_Ivanovich_Dolokhov Prince_Nikolay_Bolkonsky
9 7 Также добавим центральность по собственному вектору, чтобы отразить важность персонажа с учетом влиятельности тех персонажей, с которыми он взаимодействует.
eigen <- eigen_centrality(g, directed = TRUE)$vector
V(g)$eigenvector <- eigen_centrality(g, directed = TRUE)$vector
sort(eigen, decreasing = T)[1:10] NatashaRostova Nikolai_Rostov
1.0000000 0.8694808
Pierre_Bezukhov Sonya_Rostova
0.7223131 0.5983240
Princess_Mariya_Bolkonskaya AndreyBolkonsky
0.5461074 0.5313425
Countess_Natalya_Rostova Vasily__Vasska__Denisov
0.5194211 0.2041921
Boris_Drubetskoy Count_Ilya_Rostov
0.1968641 0.1340081 Визуализация графа
Использую visNetwork для интерактивной визуализации графа.
Количество взаимодействий между героями, то есть вес ребер, я определю с помощью прозрачности и толщины линий.
Цвет узлов отражает престиж узла, то есть количество входящих связей.
Размер узла отражает центральность по собственному вектору (важность персонажа), то есть отделяет “центральных” персонажей от “периферийных”
vis <- toVisNetworkData(g)
# Нормирую цвет и размер узлов
vis$nodes$size <- V(g)$eigenvector / max(V(g)$eigenvector, na.rm = TRUE) * 30 + 5
vis$nodes$color <- cut(V(g)$in_degree, breaks = 4, labels = c("mistyrose", "orchid", "hotpink", "maroon4"))
# Нормирую толщину и прозрачность рёбер
vis$edges$width <- E(g)$weight / max(E(g)$weight, na.rm = TRUE) * 5
vis$edges$opacity <- E(g)$weight / max(E(g)$weight, na.rm = TRUE) * 0.9 + 0.1
visNetwork(vis$nodes, vis$edges) |>
visEdges(arrows = "to", color = list(opacity = vis$edges$opacity)) |>
visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE) |>
visLayout(randomSeed = 812938012)Создание подграфа
Создам подграф из всех соседей Наташи Ростовой, то есть граф, отражающий все разговоры Наташи с другими персонажами.
Для этого воспользуюсь функцией make_ego_graph().
natasha <- make_ego_graph(
g,
order = 1,
nodes = "NatashaRostova",
mode = "all"
)[[1]]
natashaIGRAPH 1d58301 DNW- 23 105 --
+ attr: name (v/c), in_degree (v/n), eigenvector (v/n), weight (e/n)
+ edges from 1d58301 (vertex names):
[1] NatashaRostova->NatashaRostova
[2] NatashaRostova->AndreyBolkonsky
[3] NatashaRostova->Pierre_Bezukhov
[4] NatashaRostova->Nikolai_Rostov
[5] NatashaRostova->Boris_Drubetskoy
[6] NatashaRostova->Sonya_Rostova
[7] NatashaRostova->Countess_Natalya_Rostova
[8] NatashaRostova->Vasily__Vasska__Denisov
+ ... omitted several edgesggraph(natasha, layout = "kk") +
geom_edge_link(aes(width = weight), color = "grey80", alpha = 0.4,
arrow = arrow(length = unit(5, "mm"), type = "open"),
show.legend = FALSE) +
geom_node_point(aes(size = in_degree,
fill = ifelse(name == "NatashaRostova", "plum", "mistyrose")),
color = "black", shape = 21,
show.legend = FALSE) +
geom_node_text(aes(label = name), repel = TRUE, size = 4, family = "sans") +
scale_size_continuous(range = c(2, 9)) +
scale_fill_identity() +
theme_void()
Анализ ключевых узлов / структур
Точки сочленения, увеличивающие компонент связности. В графе 22 точки сочленения из 88 вершин.
articulation_points(g)+ 30/149 vertices, named, from 36243e5:
[1] Princess_Elisabeta__Lisa__Karlovna_Bolkonskaya
[2] Count_Ilya_Rostov
[3] Lieutenant_Alphonse_Karlovich_Berg
[4] Uncle
[5] Petya_Rostov
[6] Staff_Captain_Tushin
[7] regimental commander
[8] генерал
[9] Zherkov
[10] Tsar_Alexander_I_of_Russia
+ ... omitted several verticesРазмер наибольшей клики - 6.
clique_num(g)[1] 6В графе две клики по 6 узлов. Они отличаются между собой только одним персонажем. В первой клике это Princess_Mariya_Bolkonskaya, во второй - Vasily__Vasska__Denisov
cliques(g, min=6)[[1]]
+ 6/149 vertices, named, from 36243e5:
[1] NatashaRostova AndreyBolkonsky
[3] Pierre_Bezukhov Nikolai_Rostov
[5] Countess_Natalya_Rostova Princess_Mariya_Bolkonskaya
[[2]]
+ 6/149 vertices, named, from 36243e5:
[1] NatashaRostova AndreyBolkonsky Pierre_Bezukhov
[4] Nikolai_Rostov Countess_Natalya_Rostova Vasily__Vasska__Denisov Анализ сообществ
Поскольку граф направленный, взвешенный, и в нем выделяются несколько компонент, возьму следующие алгоритмы:
Edge-betweenness
InfoMAP
Edge-betweenness
cl_btwn <- cluster_edge_betweenness(g)
membership(cl_btwn) |> head() NatashaRostova AndreyBolkonsky Pierre_Bezukhov Nikolai_Rostov
1 2 2 2
Telyanin Boris_Drubetskoy
1 1 par(mar = rep(0, 4))
plot(cl_btwn, g, vertex.label = NA)
Модулярность получилась крайне низкая, попробуем другие алгоритмы
modularity(cl_btwn)[1] 0.07140196InfoMAP
cl_map <- cluster_infomap(g)
membership(cl_map) |> head() NatashaRostova AndreyBolkonsky Pierre_Bezukhov Nikolai_Rostov
1 2 2 1
Telyanin Boris_Drubetskoy
1 1 par(mar = rep(0, 4))
plot(cl_map, g, vertex.label = NA)
Модулярность уже выше, но все равно недостаточно высокая.
modularity(cl_map)[1] 0.4044906Меньше связей
Было принято решение пренебречь некоторыми связями для облегчения визуализации сообществ.
tmp <- data |> filter(weight > 25)
g <- graph_from_data_frame(tmp, directed = TRUE)Изменила граф, оставив только самую большую компоненту
components <- components(g)
largest_comp <- which.max(components$csize)
g <- induced_subgraph(g, which(components$membership == largest_comp))Walktrap
cl_w <- cluster_walktrap(g)
membership(cl_w) |> head() NatashaRostova AndreyBolkonsky Pierre_Bezukhov Nikolai_Rostov
3 1 1 2
Telyanin Boris_Drubetskoy
2 2 par(mar = rep(0, 4))
plot(cl_w, g)
Модулярность невысокая.
modularity(cl_w)[1] 0.3585689