Введение

В этом отчёте проводится анализ сетевых данных на основе данных «Камер-фурьерского журнала».
Используется библиотека igraph для построения и анализа графов, а также rgexf для импорта данных.
В ходе исследования выполняются сбор данных, построение графа, вычисление ключевых метрик, анализ сообществ и визуализация.

Загрузка библиотек

library(rgexf)   # Импорт GEXF файлов
library(igraph)  # Работа с графами
library(dplyr)   # Обработка данных
library(stringi) # Нормализация Unicode

Импорт данных и предобработка

На этом этапе импортируем данные и используем цикл для их предобработки.

setwd("C:/Users/schudinova/Desktop/masters/dataverse_files/months_data")

gexf_files <- list.files(pattern = "\\.gexf$")
all_edges <- data.frame(from = character(), to = character(), weight = numeric(), stringsAsFactors = FALSE)
all_nodes <- data.frame(id = character(), label = character(), stringsAsFactors = FALSE)

for (file in gexf_files) {
  gexf_data <- read.gexf(file)
  
  if (!is.null(gexf_data$nodes)) {
    nodes_df <- gexf_data$nodes
    nodes_df$id <- trimws(tolower(as.character(nodes_df$id)))
    all_nodes <- rbind(all_nodes, nodes_df)
  }
  
  if (!is.null(gexf_data$edges) && nrow(gexf_data$edges) > 0) {
    edges_df <- gexf_data$edges
    if (!all(edges_df$source %in% nodes_df$id)) {
      label_to_id <- setNames(nodes_df$id, trimws(tolower(nodes_df$label)))
      edges_df$source <- label_to_id[trimws(tolower(edges_df$source))]
      edges_df$target <- label_to_id[trimws(tolower(edges_df$target))]
    }
    names(edges_df) <- gsub("source", "from", names(edges_df))
    names(edges_df) <- gsub("target", "to", names(edges_df))
    if (!"weight" %in% names(edges_df)) edges_df$weight <- NA_real_
    
    all_edges <- rbind(all_edges, edges_df[, c("from", "to", "weight")])
  }
}

Очистка данных и построение графа

Предварительно очищаем данные…

# Приводим значения в столбцах 'from' и 'to' к нижнему регистру и удаляем лишние пробелы по краям
all_edges$from <- trimws(tolower(as.character(all_edges$from)))
all_edges$to   <- trimws(tolower(as.character(all_edges$to)))

# Удаляем строки, где значения 'from' или 'to' пустые
all_edges <- all_edges %>% filter(from != "" & to != "")

# Объединяем уникальные значения из столбцов 'from', 'to' и 'id' из all_nodes, удаляя пробелы
all_node_ids <- unique(c(all_edges$from, all_edges$to, trimws(tolower(all_nodes$id))))

# Создаем датафрейм 'vertices' с уникальными именами вершин и исключаем пустые значения
vertices <- data.frame(name = all_node_ids, stringsAsFactors = FALSE) %>% 
  filter(name != "") %>% distinct(name)

# Фильтруем 'all_edges', оставляя только те рёбра, оба конца которых есть в 'vertices'
all_edges <- all_edges %>% filter(from %in% vertices$name & to %in% vertices$name)

… и далее строим граф.

# Группируем данные 'all_edges' по парам 'from' и 'to', суммируя веса рёбер
all_edges <- all_edges %>%
  group_by(from, to) %>%
  summarise(weight = sum(weight, na.rm = TRUE), .groups = "drop")

# Создаем неориентированный граф на основе параллельных рёбер и вершин
g_agg <- graph_from_data_frame(d = all_edges, vertices = vertices, directed = FALSE)

g_agg
## IGRAPH 7b08ee8 UNW- 991 19142 -- 
## + attr: name (v/c), weight (e/n)
## + edges from 7b08ee8 (vertex names):
##  [1] каплун      --mariechen  зайцев_б    --абрамова   алданов     --абрамович 
##  [4] ася         --абрамович  бунин       --абрамович  варшавский_в--абрамович 
##  [7] гликберг    --абрамович  абрамович   --головин_а  абрамович   --головина_а
## [10] зюзя        --абрамович  иванов      --абрамович  абрамович   --кауфман   
## [13] макеев      --абрамович  мандельштам --абрамович  марианна    --абрамович 
## [16] милочка     --абрамович  абрамович   --михайлов   абрамович   --нилус     
## [19] оллиан      --абрамович  абрамович   --присманова раевский    --абрамович 
## [22] абрамович   --ротштейн  
## + ... omitted several edges

Характеристики графа

cat("Количество вершин:", vcount(g_agg), "\n")
## Количество вершин: 991
cat("Количество рёбер:", ecount(g_agg), "\n")
## Количество рёбер: 19142
cat("Плотность графа:", edge_density(g_agg), "\n")
## Плотность графа: 0.0390219
cat("Число компонент связности:", components(g_agg)$no, "\n\n")
## Число компонент связности: 70

Анализ атрибутов узлов

Рассчитываем степень и центральность промежуточных узлов для каждого узла в графе.

V(g_agg)$degree <- degree(g_agg)
V(g_agg)$betweenness <- betweenness(g_agg)

Построение k-core подграфа

# Рассчитываем номера k-core для каждого узла в графе
core_numbers <- coreness(g_agg)

# Находим максимальное значение номера k-core
max_core <- max(core_numbers)

# Отбираем подграф с узлами, номер k-core которых равен максимальному
subgraph_core <- induced_subgraph(g_agg, vids = which(core_numbers == max_core))

cat("Подграф k-core (max core =", max_core, ") имеет", 
    vcount(subgraph_core), "вершин и", ecount(subgraph_core), "рёбер.\n\n")
## Подграф k-core (max core = 75 ) имеет 79 вершин и 4016 рёбер.

Визуализация

## null device 
##           1

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

Применяем алгоритм Лувена для анализа сообществ в графе.

louvain_comm <- cluster_louvain(g_agg)

# Рассчитываем модульность разбиения
mod_value <- modularity(louvain_comm)
cat("Модульность разбиения (Louvain):", mod_value, "\n\n")
## Модульность разбиения (Louvain): 0.3255308

Визуализируем граф, раскрашенный по сообществам.

Анализ ключевых узлов

Находим точки сочленения в графе (узлы, удаление которых увеличивает количество компонент связности).

articulation_pts <- articulation_points(g_agg)
cat("Количество точек сочленения:", length(articulation_pts), "\n")
## Количество точек сочленения: 48
if (length(articulation_pts) > 0) {
  print(V(g_agg)[articulation_pts][1:min(10, length(articulation_pts))]$name)
}
##  [1] "слоним"       "якобсон"      "гершензон"    "николаевский" "поволоцкий"  
##  [6] "лампен"       "черток"       "ледницкий"    "именитов"     "шишмарева"
largest_cliques_list <- largest_cliques(g_agg)
cat("Количество крупнейших кликов:", length(largest_cliques_list), "\n")
## Количество крупнейших кликов: 1
if (length(largest_cliques_list) > 0) {
  clique_sizes <- sapply(largest_cliques_list, length)
  print(paste("Размеры крупнейших кликов:", paste(head(clique_sizes, 3), collapse=", ")))
}
## [1] "Размеры крупнейших кликов: 51"

Выводы (или попытка в выводы…)

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