«Европейская ночь» на языке R

Анализ сетевых данных из «Камер-фурьерского журнала» Ходасевича

Автор

Полина Дорожкина

Дата публикации

21.03.2025

«Читателей у нас нет. Родины нет, влиять мы ни на что не можем… В то же время самый простодушный из нас “блажен”, “заживо пьет бессмертие” и не только вправе — обязан глядеть на мир со “страшной высоты”, как дух на смертных…»

— Г. Иванов

Что это?

Попытка рассказать о том, как можно проанализировать добытые Ореховым Б. В., Успенским П. Ф. и Файнбергом В. В. данные из «Камер-фурьерского журнал» В. Ходасевича, а также интерпретация этих данных под впечатлением от статьи авторов датасета, биографии Г.Иванова, интервью о влиянии периода эмиграции на В. Ходасевича.

Данные и их сбор

Данные — это обобщённые за 1937 год файлы .gexf о социальных контактах круга В. Ходасевича. Они собраны с помощью фильтров “1937” и “File Type:”Unknown” на странице датасета.

library(tidyverse)
library(rgexf)
library(igraph)
library(readr)
library(visNetwork)
# Загружаем все файлы
my_files <- list.files("./months_data", pattern = ".gexf", full.names = TRUE) 

# Функция для чтения и преобразования данных
process_doc <- function(doc) {
  read.gexf(doc) |>
    gexf.to.igraph() |>
    as_long_data_frame() |>
    select(from_name, to_name, weight)
}

# Чтение всех файлов и объединение их в один датафрейм
joined <- my_files |>
  purrr::map_df(process_doc)

# Суммирование веса для одинаковых пар
final_tbl <- joined |>
  group_by(from_name, to_name) |>
  summarize(weight = sum(weight), .groups = "drop")

final_tbl

# A tibble: 1,749 × 3
   from_name   to_name  weight
   <chr>       <chr>     <dbl>
 1 Абрамович   Милочка       1
 2 Абрамович   Фельзен       1
 3 Авксентьевы Алданов       1
 4 Авксентьевы Алданова      1
 5 Авксентьевы Ася           1
 6 Авксентьевы Балашевы      1
 7 Авксентьевы Берберов      1
 8 Авксентьевы Бунин         1
 9 Авксентьевы Бунина        1
10 Авксентьевы Вейдле        1
# ℹ 1,739 more rows

Преобразуем таблицу в граф.

graph <- graph_from_data_frame(final_tbl)
graph

IGRAPH 32f495e DNW- 143 1749 -- 
+ attr: name (v/c), weight (e/n)
+ edges from 32f495e (vertex names):
 [1] Абрамович  ->Милочка       Абрамович  ->Фельзен      
 [3] Авксентьевы->Алданов       Авксентьевы->Алданова     
 [5] Авксентьевы->Ася           Авксентьевы->Балашевы     
 [7] Авксентьевы->Берберов      Авксентьевы->Бунин        
 [9] Авксентьевы->Бунина        Авксентьевы->Вейдле       
[11] Авксентьевы->Вишняк        Авксентьевы->Вишнячка     
[13] Авксентьевы->Гессен        Авксентьевы->Златопольская
[15] Авксентьевы->Мандельштам   Авксентьевы->Марианна     
+ ... omitted several edges

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

vcount(graph)  # Количество вершин

[1] 143

ecount(graph)  # Количество рёбер

[1] 1749

edge_density(graph)  # Плотность графа

[1] 0.08613218

components(graph)$no  # Количество компонент связности

[1] 2

lgc <- largest_component(graph) 
diameter(lgc, directed = TRUE)  # Диаметр сети

[1] 16

get_diameter(lgc)

+ 4/141 vertices, named, from 335c152:
[1] Долинский   Мандельштам Марианна    Фрида

farthest_vertices(lgc)

$vertices
+ 2/141 vertices, named, from 335c152:
[1] Долинский Фрида    

$distance
[1] 16

transitivity(graph)  # Транзитивность

[1] 0.6353439

Атрибуты рёбер и узлов

Изначальные атрибуты

Прежде чем смотреть на атрибуты получившегося объединённого графа хочется убедиться, что мы ничего не потеряли. Предлагаю для этого преобразовать gexf-файлы в igraph объекты и посмотреть на них.

read_gexf <- function(file) {
  gexf_data <- read.gexf(file)  # Читаем GEXF файл
  return(gexf.to.igraph(gexf_data))  # Конвертируем в igraph
}

graph_progenitor <- map(my_files, read_gexf)

print (graph_progenitor[[1]])

IGRAPH 338779f UNW- 46 453 -- 
+ attr: layout (g/n), name (v/c), color (v/c), size (v/n), weight (e/n)
+ edges from 338779f (vertex names):
 [1] жена_Степуна--Нина         Алексеева   --Нина        
 [3] Коновалов_С --Нина         Крымова     --Нина        
 [5] Зензинов    --Нина         Зайцева_В   --Нина        
 [7] Львов_Л     --Нина         жена_Конюса --Нина        
 [9] Гликберг    --Нина         Нина        --Степун      
[11] Нина        --Фондаминский Каплан      --Нина        
[13] Нина        --Шик_А        Вишнячка    --Нина        
[15] Карышева_Д  --Нина         Макеев      --Нина        
+ ... omitted several edges

Получаем, что первоначальные отрибуты вершин — это name (v/c), color (v/c), size (v/n), рёбер — weight (e/n). Что же в нашем квазимодном графе?

print(edge_attr_names(graph)) #вершины

[1] "weight"

print(vertex_attr_names(graph)) #рёбра

[1] "name"

Мы потеряли цвета и размеры, но сохранили имена и веса. Первые 2 атрибута не являются для нас ценными при дальнейшем анализе, поэтому не будем даже пытаться восстановить информацию о них. Это подтверждает и информация из Readme: “Все лица, упомянутые Ходасевичем, рассматриваются как узлы сети, а факт их встречи между собой в этот месяц — как основание для проведения ребра между ними”.

Доп атриубуты рёбер:

V(graph)$strength <- degree(graph)
node_strength <- data.frame(name = V(graph)$name, strength = V(graph)$strength) |>
  arrange(desc(strength))  

head(node_strength, 10)  # Выводим топ-10 узлов

           name strength
1       Фельзен       85
2         Бунин       81
3          Нина       74
4        Бунина       71
5  Фондаминский       70
6      Алданова       69
7        Руднев       68
8    Смоленский       66
9       Ставров       66
10     Ставрова       66

Доп атрибуты вершин

names <- vertex_attr(graph)$name    
names[1:143]

  [1] "Абрамович"       "Авксентьевы"     "Адамович"        "Алданов"        
  [5] "Алданова"        "Алексеева"       "Алферов"         "Амиров"         
  [9] "Асс"             "Ася"             "Бакст"           "Балашевы"       
 [13] "Берберов"        "Блох_Р"          "Блох_Я"          "Болотова_Шура"  
 [17] "Брайнеры"        "Булгаков_С"      "Бунин"           "Бунина"         
 [21] "Вакар"           "Варшавский_Б"    "Варшавский_В"    "Варшавский_С"   
 [25] "Вейдле"          "Вермели"         "Вишняк"          "Вишнячка"       
 [29] "Воловик"         "Волькенгейм"     "Гессен"          "Гессен_Г"       
 [33] "Гингер"          "Гликберг"        "Гликберг_М"      "Головина"       
 [37] "Гомолицкий"      "Горлин"          "Городецкая"      "Гринберг"       
 [41] "Гринберг_С"      "Даманская"       "Долинский"       "Емельянов"      
 [45] "Женя"            "Жирмунская"      "Зайцев_Б"        "Зайцева_В"      
 [49] "Закович"         "Зензинов"        "Златопольская"   "Зуров"          
 [53] "Зюзя"            "Иванов"          "Каплан"          "Карышева_Д"     
 [57] "Кауфман_С"       "Кельберин"       "Клебанова"       "Кнут"           
 [61] "Коновалов_С"     "Конюс"           "Костецкий"       "Крымов"         
 [65] "Крымова"         "Кузнецова"       "Лампен"          "Луи"            
 [69] "Львов_Л"         "Макеев"          "Мандельштам"     "Марианна"       
 [73] "Милочка"         "Михельсон"       "Набокова"        "Наташа"         
 [77] "Нидермиллер"     "Никулин"         "Нина"            "Оболенская"     
 [81] "Одоевцева"       "Оллиан"          "Павловские"      "Пети"           
 [85] "Пети_С"          "Поль"            "Прегель_С"       "Присманова"     
 [89] "Ротштейн"        "Ротштейн_Э"      "Рощин"           "Рубинштейн"     
 [93] "Рубинштейница"   "Руднев"          "Руднева"         "Сазонова"       
 [97] "Сирин"           "Скрябина"        "Смоленский"      "Соломон"        
[101] "Софиев"          "Ставров"         "Ставрова"        "Степун"         
[105] "Терапиано"       "Тихонова"        "Тумаркин_Р"      "Тэффи"          
[109] "Фельзен"         "Феничка"         "Фондаминский"    "Фрид"           
[113] "Червинская"      "Ческес"          "Шайкевич"        "Шик_А"          
[117] "Шик_Г"           "Эйтингоны"       "Якобсон"         "жена_Конюса"    
[121] "жена_Степуна"    "семья_Ротштейна" "Яблоновский_С"   "Яновский"       
[125] "Соловейчик"      "Черток"          "Кан_Н"           "Ольга_Сергеевна"
[129] "Берберов_Л"      "Лозинский"       "Евреинов"        "Шаршун"         
[133] "Хигерович"       "Ческес_Б"        "Могилевский"     "Трахтерев"      
[137] "Черниховский"    "Шайкевич_Вар"    "Фрида"           "Тумаркин"       
[141] "Шауб"            "Шик_И"           "Цветаева"

V(graph)$degree <- degree(graph)  # Степень узла (кол-во связей)
V(graph)$pagerank <- page_rank(graph)$vector  # PageRank (авторитетность узлов)

print(vertex_attr_names(graph))  # Проверяем, что атрибуты добавились

[1] "name"     "strength" "degree"   "pagerank"

Ранжированный список по степени:

head(
  data.frame(name = V(graph)$name, degree = V(graph)$degree, pagerank = V(graph)$pagerank) |>
    arrange(desc(degree)), 10
)

           name degree    pagerank
1       Фельзен     85 0.057628642
2         Бунин     81 0.003635327
3          Нина     74 0.011291249
4        Бунина     71 0.003512379
5  Фондаминский     70 0.040350124
6      Алданова     69 0.002604566
7        Руднев     68 0.011973306
8    Смоленский     66 0.018002714
9       Ставров     66 0.020173307
10     Ставрова     66 0.026205369

Ранжированный список по PageRank:

head(
  data.frame(name = V(graph)$name, degree = V(graph)$degree, pagerank = V(graph)$pagerank) |>
    arrange(desc(pagerank)), 10
)

            name degree   pagerank
1       Яновский     45 0.08087144
2        Фельзен     85 0.05762864
3  Яблоновский_С     27 0.05274297
4        Якобсон     54 0.04418393
5   Фондаминский     70 0.04035012
6     Червинская     43 0.03387862
7      Эйтингоны     27 0.02850972
8       Ставрова     66 0.02620537
9        Ставров     66 0.02017331
10         Тэффи     53 0.01932663

Козырный атрибут

Читаем в Readme: “В директории betweenness_centrality представлены расчёты значения betweenness centrality для всех упомянутых в журнале Ходасевича персон, которые в данном случае рассмотрены как узлы сети, а факт их встречи в этом году как основание для проведения ребра между ними.”

Если для создателей датасета был важен этот атрибут, то и мы попытаемся сделать на нём акцент и рассказать про него подробнее.

Центральность посредничества (betweenness centrality) показывает, насколько часто узел находится на кратчайших путях между другими узлами. Это значит, что:

Узел с высоким betweenness = важный “посредник” в сети, через него проходит много связей.
Узел с низким betweenness = менее важный в передаче информации.

Добавляем этот атрибут:

betweenness_data <- read_delim("./1937.csv", delim = "\t", col_names = FALSE)
betweenness_data

# A tibble: 161 × 2
   X1             X2
   <chr>       <dbl>
 1 Фельзен    0.111 
 2 Смоленский 0.0700
 3 Бунин      0.0552
 4 Рощин      0.0411
 5 Оллиан     0.0401
 6 Долинский  0.0366
 7 Сирин      0.0319
 8 Нина       0.0266
 9 Бунина     0.0256
10 Вейдле     0.0250
# ℹ 151 more rows

colnames(betweenness_data) <- c("name", "betweenness")

V(graph)$betweenness <- betweenness_data$betweenness[match(V(graph)$name, betweenness_data$name)]

head(
  data.frame(name = V(graph)$name, betweenness = V(graph)$betweenness) |> 
    arrange(desc(betweenness)), 
  10
)

         name betweenness
1     Фельзен  0.11141984
2  Смоленский  0.07000176
3       Бунин  0.05524820
4       Рощин  0.04111769
5      Оллиан  0.04009279
6   Долинский  0.03656373
7       Сирин  0.03192254
8        Нина  0.02661643
9      Бунина  0.02559140
10     Вейдле  0.02498629

Визуализация графа

Граф намеренно визуализирован без фильтров, чтобы показать его объёмы и переплетённости. Для удобства использования создан поиск по имени.

nodes <- data.frame(id = V(graph)$name, 
                    label = V(graph)$name, 
                    value = V(graph)$betweenness, 
                    degree = V(graph)$degree, 
                    pagerank = V(graph)$pagerank)

edges <- data.frame(
  from = as.character(ends(graph, E(graph))[,1]),  
  to = as.character(ends(graph, E(graph))[,2]),    
  width = E(graph)$weight                          
)

# Визуализация с visNetwork
visNetwork(nodes, edges) |> 
  visNodes(scaling = list(min = 10, max = 50))  |>   
  visEdges(smooth = FALSE) |> 
  visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE)  |> 
  visPhysics(enabled = FALSE)

Создание ego-графа

В связи с тем, что у Фельзена самый большой показатель betweenness, было решено визуализировать ego-граф с ним.

target_name <- "Фельзен"

# Создаём эго-граф радиусом 1 (сам узел + его соседи)
ego_felzen <- make_ego_graph(graph, order = 1, nodes = V(graph)[name == target_name])[[1]]

# Визуализируем
par(mar = rep(0, 4), cex = 0.7)

# Используем layout с Kamada-Kawai для лучшей визуализации
layout_ego <- layout_with_kk(ego_felzen)

# Визуализируем подграф
plot(ego_felzen, 
     vertex.size = 6, 
     edge.arrow.size = 0.5, 
     vertex.label.dist = 1, 
     edge.curved = 0.2, 
     edge.color = "grey80", 
     vertex.color = "plum", 
     layout = layout_ego)

Анализ ключевых узлов / структур

articulation_points <- articulation_points(graph)
print(articulation_points)

+ 11/143 vertices, named, from 32f495e:
 [1] Вейдле     Смоленский Долинский  Сирин      Фрид       Оллиан    
 [7] Фельзен    Гликберг   Бунина     Берберов   Ася

В графе 11 узлов. Эти узлы играют важную роль в связи различных частей сети, и их удаление нарушит существующие связи, потенциально разрывая сеть на несколько отдельных компонент.

Узнаем размер наибольшей клики:

clique_num(graph)

[1] 36

Анализ сообществ

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

eb <- cluster_edge_betweenness(graph)
plot(eb, graph)

modularity(eb)

[1] 0.04923051

im <- cluster_infomap(graph)
plot(im, graph)

modularity(im)

[1] 0.0107258

Решено визуализировать сообщество, собранное с помощью метода cluster_edge_betweenness. Однако теперь мы не хотим представлять все персоналии, поэтому вводим “порог входа” в визуализацию:

betweenness_values <- betweenness(graph)
threshold <- quantile(betweenness_values, 0.50)  # Порог для половины значений
nodes_to_keep <- V(graph)$name[betweenness_values >= threshold]
filtered_graph <- induced_subgraph(graph, nodes_to_keep)
eb <- cluster_edge_betweenness(filtered_graph)
modularity(eb)

[1] 0.05065251

layout_positions <- layout_with_fr(filtered_graph)
community_colors <- membership(eb)  
plot(eb, filtered_graph, 
     layout = layout_with_fr(filtered_graph),  # Расположение вершин
     vertex.color = community_colors,  # Цвет вершин по сообществам
     vertex.size = 8,  # Размер вершин
     vertex.label.cex = 0.6,  # Размер текста
     edge.width = 0.5,  # Толщина рёбер (меньше значение - тоньше рёбра)
     edge.color = "white",  # Цвет рёбер
     edge.arrow.size = 0.2,  # Размер стрелок (уменьшаем стрелки)
     main = "Граф с сообществами (Edge Betweenness)")

Выводы

Мы видим большую сплочённость сообщества русских эмигрантов. Хотя с точки зрения исследования это немного расстораивает, хотелось расщепить их на подгруппы поинтереснее. Однако выводы об их тесных связях подтверждаются и в исследовании создателей датасета с отсылкой на социологическую характеристику русской эмиграфии Гусеффа, охарактеризованную “крепкими внутриобщинными связями”.

P.S.

pov: ты судорожно пытаешься успеть проект к дедлайну…..

  visNetwork(nodes, edges) |> 
  visNodes(scaling = list(min = 10, max = 50))  |>   
  visEdges(smooth = FALSE) |> 
  visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE) |> 
  visPhysics(stabilization = TRUE)