doc <- read_xml("War_and_Peace.xml")
paragraphs <- xml_find_all(doc, ".//*[local-name()='p']")
length(paragraphs)
## [1] 11104
scenes <- xml_find_all(doc, ".//*[local-name()='div']") # или нужный уровень
get_chars_scene <- function(scene) {
refs <- xml_find_all(scene, ".//*[local-name()='rs'][@ref]")
chars <- xml_attr(refs, "ref")
unique(chars[!is.na(chars)])
}
scene_chars <- map(scenes, get_chars_scene)
scene_chars <- scene_chars[lengths(scene_chars) > 1]
scene_chars <- map(scene_chars, ~ str_replace_all(.x, "_", " "))
length(scene_chars)
## [1] 351
edges_df <- map(scene_chars, ~ combn(.x, 2, simplify = FALSE)) %>%
flatten() %>%
map_dfr(~ tibble(from = .x[1], to = .x[2])) %>%
filter(!is.na(from), !is.na(to))
head(edges_df)
## # A tibble: 6 × 2
## from to
## <chr> <chr>
## 1 Anna Pavlovna Scherer empress Mariya
## 2 Anna Pavlovna Scherer Vasili Kuragin
## 3 Anna Pavlovna Scherer HeleneKuragin
## 4 Anna Pavlovna Scherer Tsar Alexander I of Russia
## 5 Anna Pavlovna Scherer Napoleon Bonaparte
## 6 Anna Pavlovna Scherer abbe Morio
edges_weighted <- edges_df %>%
count(from, to, name = "weight")
summary(edges_weighted$weight)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 1.000 2.000 2.953 3.000 61.000
g <- graph_from_data_frame(edges_weighted, directed = FALSE)
# Граф ненаправленный, взвешенный
# Число вершин:
vcount(g)
## [1] 137
# Число рёбер:
ecount(g)
## [1] 7862
# Компоненты связности:
components(g)
## $membership
## ref=
## 1
## Aline Kuragina
## 1
## Anatole Kuragin
## 1
## Andrei Kaysarov
## 1
## AndreyBolkonskiy
## 1
## AndreyBolkonsky
## 1
## Andrusha son of Nikolai and Mariya
## 1
## Anna Ignatyevna Malvintsev
## 1
## Anna Pavlovna Scherer
## 1
## Arakcheev
## 1
## Bagovut
## 1
## Balashev
## 1
## Barclay de Tolly
## 1
## Beausset
## 1
## Belova
## 1
## Berthier
## 1
## Bilibin
## 1
## Bitsky
## 1
## Bolhovitinov
## 1
## Boris Drubetskoy
## 1
## Capt. von Toll
## 1
## Captain Ramballe
## 1
## Catiche(eldest princess)
## 1
## Chichagov
## 1
## Count Bennigsen
## 1
## Count Ilya Rostov
## 1
## Count Kirill Bezukhov
## 1
## Count Rastopchin
## 1
## Count Vasily Orlov-Denisov
## 1
## Countess Natalya Rostova
## 1
## DanilaTerentich
## 1
## Dmitry Dokhturov
## 1
## Dron Zakharych
## 1
## Dunyasha
## 1
## Ekaterina II
## 1
## Emperor Francis I of Austria
## 1
## Fedor Ivanovich Dolokhov
## 1
## Ferapontov
## 1
## General Davoust
## 1
## General Mack
## 1
## Gerasim
## 1
## HeleneKuragin
## 1
## Hippolyte Kuragin
## 1
## Ilyin
## 1
## Joachim Murat
## 1
## Joseph Alexeevich Bazdeev
## 1
## Julie Karagina
## 1
## Kamenskiy
## 1
## Kirsten
## 1
## Kochubey
## 1
## Konovitsyn
## 1
## Kutajsov
## 1
## Lavrushka
## 1
## Lieutenant Alphonse Karlovich Berg
## 1
## Lopukhin
## 1
## Mademoiselle Bourienne
## 1
## Magnitskiy
## 1
## Marya Dmitriyevna Akhrosimova
## 1
## Marya Lvovna Karagina
## 1
## Mavra Kuzminishna
## 1
## Michaud
## 1
## Mikhail Ilarionovich Kutuzov
## 1
## Mikhail Ivanych
## 1
## Miloradovich
## 1
## Mitenka
## 1
## Monsieur Dessalles
## 1
## Napoleon
## 1
## Napoleon Bonaparte
## 1
## Natasha daughter of Nikolai and Mariya
## 1
## NatashaRostova
## 1
## Ney
## 1
## Nikolai Rostov
## 1
## Nikolenka Bolkonsky
## 1
## Paisi Kaysarov
## 1
## Peronskaya
## 1
## Petya Bezukhov
## 1
## Petya Rostov
## 1
## Pfuel
## 1
## Pierre Bezukhov
## 1
## Pierre Bezukhov abbe Morio
## 1
## Piotr Petrovich Konovnitsyn
## 1
## Platon Karataev
## 1
## Platov
## 1
## Ponyatovskiy
## 1
## Prince Adam Jerzy Czartoryski
## 1
## Prince Bagration
## 1
## Prince Dolgorukov
## 1
## Prince Kozlovsky
## 1
## Prince Nesvitsky
## 1
## Prince Nikolay Bolkonsky
## 1
## Prince Volkonsky
## 1
## Princess Anna Mikhaylovna Drubetskaya
## 1
## Princess Elisabeta Lisa Karlovna Bolkonskaya
## 1
## Princess Mariya Bolkonskaya
## 1
## Pyotr Nikolaitch Shinshin
## 1
## Raevsky
## 1
## Ramballe
## 1
## Rastopchin
## 1
## Rumyantsev
## 1
## Saltykov
## 1
## Schmitt
## 1
## Shcherbinin
## 1
## Shubert
## 1
## Sonya Rostova
## 1
## Speransky
## 1
## Staff Captain Tushin
## 1
## Stolypin
## 1
## Suvorov
## 1
## Telyanin
## 1
## Tikhon Shtcherbatov
## 1
## Tikhon the servant
## 1
## Timohin
## 1
## Tsar Alexander I of Russia
## 1
## Tuchkov
## 1
## Uvarov
## 1
## Vasili Kuragin
## 1
## Vasily Vasska Denisov
## 1
## Vera Rostova
## 1
## Vereshchagin
## 1
## Vyazmitinov
## 1
## Weyrother
## 1
## Willarski
## 1
## Wolzogen
## 1
## Yakov Alpatych
## 1
## Yermolov
## 1
## Zherkov
## 1
## Zubov
## 1
## abbe Morio
## 1
## baron Funke
## 1
## empress Elisabeth
## 1
## empress Mariya
## 1
## little Natasha
## 1
## prince
## 1
## secretary Shishkov
## 1
## viscount
## 1
## visсount
## 1
## Anna Makarovna
## 1
##
## $csize
## [1] 137
##
## $no
## [1] 1
# Плотность:
edge_density(g)
## [1] 0.8439244
# Количество связей у персонажа
V(g)$degree <- degree(g)
# Cуммарная «сила» связей
V(g)$wDegree <- strength(g)
# Насколько персонаж близок ко всем остальным
V(g)$closeness <- closeness(g, normalized = TRUE)
# Насколько часто персонаж выступает посредником между другими
V(g)$betweenness <- betweenness(g, normalized = TRUE)
# Важность персонажа с учётом важности его соседей
V(g)$eigen <- eigen_centrality(g)$vector
# ПРинадлежность к ядру (центру)
V(g)$core <- coreness(g)
# Распределение вершин по ядрам
table(V(g)$core)
##
## 25 26 55 56 57 59 60 61 63 65 68 71 81 83
## 4 1 3 15 1 5 3 5 1 1 11 1 1 85
# Описание распределения взвешенной степени
summary(V(g)$wDegree)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 58.0 109.0 171.0 338.9 469.0 1557.0
# Ищем сообщества
comm <- cluster_louvain(g)
# Даем каждому персонажу номера сообщества
V(g)$community <- membership(comm)
# Модулярность
modularity(comm)
## [1] 0.1318115
# Размеры сообществ
table(V(g)$community)
##
## 1 2 3
## 35 66 36
# Альтернативный алгоритм — Walktrap
cw <- cluster_walktrap(g)
# Модулярность для сравнения
modularity(cw)
## [1] 0.1013392
# Топ-10 по активности
sort(V(g)$wDegree, decreasing = TRUE)[1:10]
## [1] 1557 1421 1421 1320 1290 1266 1210 1190 1131 1032
# Персонажи с наибольшим взаимодействием (посредники)
sort(V(g)$betweenness, decreasing = TRUE)[1:10]
## [1] 0.02568738 0.02552278 0.02305580 0.02256723 0.02141758 0.02130318
## [7] 0.01861042 0.01599639 0.01520217 0.01467426
# Топ-10 по близости
sort(V(g)$closeness, decreasing = TRUE)[1:10]
## [1] 0.6570048 0.6476190 0.6476190 0.6445498 0.6384977 0.6267281 0.6238532
## [8] 0.6210046 0.6181818 0.6181818
# Топ-10 по «влиянию»
sort(V(g)$eigen, decreasing = TRUE)[1:10]
## [1] 1.0000000 0.9789760 0.9229683 0.8535431 0.8343962 0.8127375 0.7873925
## [8] 0.7328396 0.7299517 0.6731435
set.seed(123)
Из XML-файла романа извлечены сцены и персонажи. Для каждой сцены определены персонажи, после чего построены пары совместного появления. На их основе сформирован список ребер, где вес отражает частоту совместного появления. Получена сеть из 137 персонажей и 7862 связей в сумме. Сеть связная (одна компонента), с высокой плотностью (edge_density(g) = 0.84), что указывает на большое количество взаимодействий между персонажами. Для вершин были рассчитаны основные метрики: степень, взвешенная степень, closeness, betweenness, eigenvector centrality и k-core. Взвешенная степень сильно варьируется (до 1557), то есть явно присутствуют центральные персонажи. Высокие значения betweenness показывают персонажей-посредников. Closeness указывает на персонажей, быстро «достигающих» остальных. В сети выделяются ключевые герои, через которых проходит основное взаимодействие. Также нашлись 3 сообщества с модулярностью +- = 0.13. Т.е. сообщества выражены слабо, сеть сильно перемешанная, без строгих кластеров.
# если cделать {r, fig.width=20, fig.height=15}, то будет красивее выглядеть, но становится тяжело и ломается выгрузка в rpubs(((
p1 <- ggraph(g, layout = "stress") +
geom_edge_link(aes(alpha = weight), color = "grey50") +
geom_node_point(aes(size = wDegree,
fill = closeness),
shape = 21,
color = "black") +
geom_node_text(aes(filter = (wDegree > 15),
label = name),
repel = TRUE,
force = 5) +
scale_fill_viridis_c() +
theme_graph()
p1
Есть ядро сети с плотными связями, большинство персонажей тесно связаны.
Также можно выделит крупные узлы — центральные герои, с большим
количеством взаимодействий.
p2 <- ggraph(g, layout = "stress") +
geom_edge_link(color = "orange", alpha = 0.1) +
geom_node_point(aes(color = as.factor(community),
size = wDegree)) +
geom_node_text(aes(filter = (wDegree > 15),
label = name),
repel = TRUE) +
theme_graph()
p2
Сообщества перекрываются, у них нет чётких границ между группами, что
подтверждает низкую модулярность (ну и персонажи активно взаимодействуют
между собой)
p3 <- ggraph(g, layout = "stress") +
geom_edge_link(color = "steelblue", alpha = 0.2) +
geom_node_point(aes(size = betweenness),
color = "orange") +
geom_node_text(aes(label = name,
filter = betweenness > quantile(betweenness, 0.9)),
repel = TRUE) +
theme_graph()
p3
ТОп персонажей-посредников, которые сединяют разные части сети и группы персонажей.
p4 <- ggraph(g, layout = "stress") +
geom_edge_link(color = "steelblue", alpha = 0.2) +
geom_node_point(aes(color = as.factor(core)),
size = 4) +
geom_node_text(aes(label = name,
filter = core > quantile(core, 0.8)),
repel = TRUE) +
theme_graph()
p4