library(XML)
library(tidyverse)
library(igraph)
library(visNetwork)Война и мир: графы и графини
Домашнее задание № 17
Аннотация
С помощью TEI-разметки “Войны и Мира” , сделанной Даниилом Скоринкиным, попробуем проанализировать социальную сеть персонажей и выявить какие-то закономерности или особенности.
Предобработка и сбор данных
Установим все необходимые для работы библиотеки:
Обработаем наш документ с TEI-разметкой, выделим из него список персонажей и все вхождения тега said, в котором как раз и хранится информация о том, кто с кем разговаривает.
filename = "War_and_Peace.xml"
doc <- xmlTreeParse(filename, useInternalNodes = T)
rootnode <- xmlRoot(doc)
person_list <- xmlElementsByTagName(rootnode, "person", recursive = TRUE) |>
map_chr(xmlGetAttr, "xml:id")
said_tags <- xmlElementsByTagName(rootnode, "said", recursive = TRUE)Сложим наши данные в таблицу: who - автор реплики, corresp - адресат реплики. Также есть важный аргумент speech_id- номер реплики, поскольку некоторые теги повторяются, и не стоит считать их дважды. Также отфильтруем данные по списку персонажей, иначе граф будет переполнен вершинами персонажей, которые встретились в романе один раз (в духе “мужичок”, “офицер” и пр.).
wp_data <- tibble(who = map_chr(said_tags, xmlGetAttr, "who"),
corresp = map_chr(said_tags, xmlGetAttr,
"corresp", default = "NULL"),
speech_id = map_chr(said_tags, xmlGetAttr, "speech_id",
default = "0")) |>
distinct(speech_id, .keep_all = TRUE) |>
filter(who %in% person_list, corresp %in% person_list)|>
group_by(who, corresp) |>
summarise(weight = n()) |>
arrange(-weight)
wp_data# A tibble: 379 × 3
# Groups: who [68]
who corresp weight
<chr> <chr> <int>
1 AndreyBolkonsky Pierre_Bezukhov 106
2 NatashaRostova Sonya_Rostova 89
3 Pierre_Bezukhov AndreyBolkonsky 85
4 NatashaRostova Countess_Natalya_Rostova 77
5 Sonya_Rostova NatashaRostova 69
6 NatashaRostova Nikolai_Rostov 67
7 Pierre_Bezukhov NatashaRostova 60
8 NatashaRostova Pierre_Bezukhov 58
9 Countess_Natalya_Rostova NatashaRostova 51
10 Vasily__Vasska__Denisov Nikolai_Rostov 51
# ℹ 369 more rowsСоздание графа
У нас получился направленный граф, так как у каждой реплики были адресант и адресат. У рёбер уже есть вес - количество реплик между персонажами. Сразу присвоим вершинам степень (отдельно по входящим и по исходящим рёбрам) и посчитаем взвешенную центральность (по входящим и исходящим ребрам вместе). Выведем самых центральных персонажей.
wp_graph <- graph_from_data_frame(wp_data)
V(wp_graph)$degree <- degree(wp_graph, mode = "out")
V(wp_graph)$prestige <- degree(wp_graph, mode = "in")
V(wp_graph)$w_degree <- strength(wp_graph, mode = "all")
sort(strength(wp_graph, mode = "all"), decreasing = T)[1:10] Pierre_Bezukhov NatashaRostova
820 795
AndreyBolkonsky Nikolai_Rostov
676 603
Princess_Mariya_Bolkonskaya Countess_Natalya_Rostova
436 252
Sonya_Rostova Vasily__Vasska__Denisov
215 199
Fedor_Ivanovich_Dolokhov Prince_Nikolay_Bolkonsky
169 159 Узнаем чуть больше про получившийся граф.
Количество вершин:
vcount(wp_graph)[1] 71Плотность:
edge_density(wp_graph)[1] 0.07625755Количество компонент: всего одна, то есть все персонажи представляют собой единую сеть
components(wp_graph)$no[1] 1Диаметр получился ого-го, потому что плотность низкая, и ребёр не так много
diameter(wp_graph, directed = TRUE)[1] 49Вот самые дальние вершины в графе
farthest_vertices(wp_graph)$vertices
+ 2/71 vertices, named, from a2f5afd:
[1] Platon_Karataev Gerasim
$distance
[1] 49Визуализация
Попробуем теперь изобразить наш граф, может быть, станет понятнее?
V(wp_graph)$color <- ifelse(V(wp_graph)$w_degree >= 150, "#A7DBD8FF", "#E0E4CCFF")
wp_visnet <- toVisNetworkData(wp_graph)
wp_visnet$edges$value <- wp_visnet$edges$weight
wp_graph_3d <- visNetwork(nodes = wp_visnet$nodes,
edges = wp_visnet$edges,
color = wp_visnet$nodes$color,
width = "100%",
height = 600)
visOptions(wp_graph_3d,
highlightNearest = list(enabled = TRUE, degree = 1, hover = TRUE),
nodesIdSelection = FALSE) |>
visPhysics(maxVelocity = 20, stabilization = FALSE) |>
visInteraction(dragNodes = TRUE)Красиво, но как-то ясности не прибавилось. Давайте отфильтруем неважные вершины, чтобы глаза не разбегались.
Создание подграфа
Давайте уберём самых незначимых персонажей. Уберём персонажей, у которых только одно ребро (скорее всего, они почти не участвуют в сюжете), и отфильтруем самые тонкие рёбра, чтобы оставить только связи, когда персонажи действительно общаются между собой, а не пересеклись единожды.
vert <- which(vertex_attr(wp_graph)$degree >= 2)
edges <- which(edge_attr(wp_graph)$weight >= 4)
wp_subgraph <- induced_subgraph(wp_graph, vids = vert) |>
subgraph_from_edges(eids = edges)Теперь вершин стало значительно меньше
vcount(wp_subgraph)[1] 43Визуализация
wp_visnet <- toVisNetworkData(wp_subgraph)
wp_visnet$edges$value <- wp_visnet$edges$weight
wp_graph_3d <- visNetwork(nodes = wp_visnet$nodes,
edges = wp_visnet$edges,
color = wp_visnet$nodes$color,
width = "100%",
height = 600)
visOptions(wp_graph_3d,
highlightNearest = list(enabled = TRUE, degree = 1, hover = TRUE),
nodesIdSelection = FALSE) |>
visPhysics(maxVelocity = 20, stabilization = FALSE) |>
visInteraction(dragNodes = TRUE)Кажется, стало чуть лучше… Хотя количество персонажей всё ещё угнетает. Но чуть лучше видно отдельные ветки
Сообщества
Попробуем применить к нашему графу несколько алгоритмов нахождения сообществ. Так как наш граф ориентированный, мы достаточно ограничены в выборе.
cw <- cluster_edge_betweenness(wp_subgraph)
membership(cw) |> head(10) AndreyBolkonsky NatashaRostova
1 2
Pierre_Bezukhov Sonya_Rostova
2 3
Countess_Natalya_Rostova Vasily__Vasska__Denisov
2 2
Nikolai_Rostov Prince_Nikolay_Bolkonsky
2 1
Princess_Mariya_Bolkonskaya Bilibin
4 5 Некоторая логика видна: объединились Ростовы (а также Пьер, т.е. муж Наташи, и Василий Денисов, командир Николая Ростова)
par(mar = rep(0, 4))
plot(cw, wp_subgraph)
modularity(cw)[1] 0.08082368График получился неаккуратный, но это, конечно, такое печальное число, что как будто бы и нет смысла его улучшать… Попробуем другой подход.
cw <- cluster_infomap(wp_subgraph)
membership(cw) |> head(10) AndreyBolkonsky NatashaRostova
1 1
Pierre_Bezukhov Sonya_Rostova
1 1
Countess_Natalya_Rostova Vasily__Vasska__Denisov
1 1
Nikolai_Rostov Prince_Nikolay_Bolkonsky
1 1
Princess_Mariya_Bolkonskaya Bilibin
1 1 Ммммммм… есть плохое предчувствие.
par(mar = rep(0, 4))
plot(cw, wp_subgraph)
modularity(cw)[1] 0.01088092Ну, это, конечно, неплохое разделение, но никакого нового знания нам тоже не несёт.
Сочленения и Клики
articulation_points(wp_subgraph)+ 8/43 vertices, named, from a3243a4:
[1] Tsar_Alexander_I_of_Russia
[2] Mikhail_Ilarionovich_Kutuzov
[3] Princess_Elisabeta__Lisa__Karlovna_Bolkonskaya
[4] Fedor_Ivanovich_Dolokhov
[5] Lavrushka
[6] Nikolai_Rostov
[7] Pierre_Bezukhov
[8] AndreyBolkonsky articulation_points(wp_graph)+ 10/71 vertices, named, from a2f5afd:
[1] Napoleon_Bonaparte Bolhovitinov
[3] Mikhail_Ilarionovich_Kutuzov Nikolai_Rostov
[5] Vasily__Vasska__Denisov Pierre_Bezukhov
[7] Captain_Ramballe NatashaRostova
[9] Pfuel AndreyBolkonsky Получается, и в оригинальном графе, и в “отфильтрованном” точками сочленения являются в основном персонажи, у которых есть военные товарищи.
Клики высчитываются как в ненаправленном графе:
clique_num(wp_subgraph)[1] 6cliques(wp_subgraph, min=6)[[1]]
+ 6/43 vertices, named, from a3243a4:
[1] AndreyBolkonsky NatashaRostova
[3] Pierre_Bezukhov Countess_Natalya_Rostova
[5] Nikolai_Rostov Princess_Mariya_BolkonskayaВ общем, клику составляют как раз центральные персонажи, которые чаще всего разговаривают в романе, что логично