Сетевые ландшафты культуры: Как теория графов раскрывает связи между мифом, религией и историей

Теория графов как инструмент анализа мифологических, религиозных и исторических нарративов

Автор

Екатерина Егоренкова

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

21.03.2025

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

Основу этого небольшого исследования составили гравюры XVII–XVIII веков из коллекции сэра Ганса Слоана, хранящиеся в Британском музее. Эти артефакты служат уникальным источником для анализа визуальных нарративов, объединяющих античную мифологию, христианскую иконографию и исторические сюжеты.

Данные были собраны в рамках исследования гравюр Ганса Слоана в электронном каталоге Британского музея при помощи Python Silenium со следующими фильтрами:

Собранные данные были дополнительно отфильтрованы вручную: удалены все гравюры, не содержащие изображений людей

В рамках исследования был проанализирован массив из 5853 изображений гравюр, снабженных метаданными. Из текстовых описаний в поле «Описание» метаданных были вручную извлечены именованные сущности, включающие национальности, профессии, имена людей, имена мифических существ и названия животных. Всего была выделена 2601 уникальная именованная сущность.

Полученные именованные сущности были разделены на следующие тематические группы: персонажи греческой мифологии, персонажи римской мифологии (Hansen W. 2005), ветхозаветные персонажи, новозаветные персонажи (Ryken L., Wilhoit J. 2010), святые (Farmer D. 2011), «персонификация», то есть персонажи являющиеся олицетворением чего-либо, персонажи, которые названы в описании по их профессии или роду деятельности, исторические личности, женщины разных стран, персонажи, названные по их национальной принадлежности, животные, «фоновые» персонажи, названные такими словами как «мужчина», «женщина», «фигуры» . Количество уникальных персонажей внутри каждой группы отражено на диаграмме:

Количество уникальных персонажей, приходящееся на каждую группу. Самой разнообразной является группа «Исторические личности», следующая по количеству персонажей – «Греческая мифология»

Готовим данные для создания графов: в исходной таблице 1 строка = 1 гравюра, соответственно персонажи одной гравюры, выписывались в ячейки одной строки. Для построения графа будем связывать между собой персонажей соответсвующих строк.
Сразу будем учитывать количество связей (вес ребер) и встречаемость персонажей (центральность узлов).

library(igraph)
library(visNetwork)
library(dplyr)
url <- "https://raw.githubusercontent.com/EEgoren/hello_world_2/refs/heads/main/data_for_graph.csv"

data <- read.csv(url, sep = ";")

df_cleaned <- data[ , !(names(data) %in% c("link"))]

df_cleaned[] <- lapply(df_cleaned, function(x) ifelse(x == "" | is.na(x), NA, x))

edges <- c()

for (i in 1:nrow(df_cleaned)) {
  characters <- na.omit(as.character(df_cleaned[i, ]))# Все персонажи в строке
  for (j in 1:(length(characters) - 1)) {  # Создаем все возможные пары персонажей
    for (k in (j + 1):length(characters)) {
      edge <- sort(c(characters[j], characters[k]))
      edges <- c(edges, paste(edge, collapse = "-"))
    }
  }
}

edge_table <- table(edges)
edge_weight_df <- as.data.frame(edge_table)
colnames(edge_weight_df) <- c("edge", "weight")

edge_weight_df$edge <- as.character(edge_weight_df$edge)

edge_weight_df$character1 <- sapply(strsplit(edge_weight_df$edge, "-"), `[`, 1)
edge_weight_df$character2 <- sapply(strsplit(edge_weight_df$edge, "-"), `[`, 2)

edge_weight_df <- edge_weight_df[!is.na(edge_weight_df$character1) & !is.na(edge_weight_df$character2), ]

graph <- graph_from_data_frame(edge_weight_df[, c("character1", "character2", "weight")], directed = FALSE)
nodes_vis <- data.frame(
  id = V(graph)$name,
  label = V(graph)$name,
  value = degree(graph),
  title = paste(
    "Персонаж:", V(graph)$name
  ),
  font = list(align = "center"),
  stringsAsFactors = FALSE
)

edges_vis <- get.data.frame(graph, what = "edges")

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

Исходный график слишком большой, так как содержит 2601 персонажа и больше 10 000 связей и не может быть хоть сколько-нибудь наглядным.

cat("Класс:", class(graph))
Класс: igraph
cat("\nКоличество узлов:", vcount(graph)) 

Количество узлов: 2601
cat("\nКоличество ребер:", ecount(graph))

Количество ребер: 12465

Оптимизация графа: от хаоса к смысловым кластерам

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

Поэтому присвоим персонажам (узлам) атрибут “группа” и оставляем только нужные нам оставшиеся 6 групп. Дополнительно удалим все изолированные узлы, они возникают из-за присутствия в коллекции портретов.

Для удобной фильтрации добавим выпадающий список групп - он позволяет изолировать кластеры, например, визуально сравнить плотность связей в греческой и римской мифологии.

groups_url <- "https://raw.githubusercontent.com/EEgoren/hello_world_2/main/grouping.csv"
groups_df <- read.csv(groups_url, sep = ";", stringsAsFactors = FALSE, header = TRUE)

library(tidyr)
groups_long <- tryCatch(
  {
    groups_df |> 
      pivot_longer(
        cols = everything(),
        names_to = "Group",
        values_to = "Character",
        values_drop_na = TRUE
      ) |> 
      mutate(
        Character = trimws(Character),
        Group = trimws(Group)
      )
  }
)


original_nodes <- V(graph)$name
V(graph)$group <- groups_long$Group[match(
  trimws(V(graph)$name), 
  trimws(groups_long$Character)
)]

matched <- sum(!is.na(V(graph)$group))

V(graph)$group[is.na(V(graph)$group)] <- "missing"


graph <- simplify(graph, remove.loops = TRUE, remove.multiple = FALSE)


exclude_pattern <- "Other|missing|Animals|Nationality|Occupation|Occupation...Nationality|Personification|Women.of.different.countries"
vertices_to_keep <- V(graph)[!grepl(exclude_pattern, V(graph)$group, ignore.case = TRUE)]

subgraph <- induced_subgraph(graph, vertices_to_keep)

isolated <- which(degree(subgraph) == 0)

if(length(isolated) > 0) {
  subgraph <- delete_vertices(subgraph, isolated)
}
library(RColorBrewer)

color_palette <- c(
  "The.Old.Testament" = "#c7522a",
  "Historical.figures" = "#850085",
  "Roman.mythology" = "#008585",
  "Greek.mythology" = "#c5e07b",
  "The.New.Testament" = "#e5c185",
  "Saints" = "#fbf2c4")

nodes_vis <- data.frame(
  id = V(subgraph)$name,
  label = V(subgraph)$name,
  group = V(subgraph)$group,
  color = color_palette[V(subgraph)$group],
  value = degree(subgraph),
  title = paste(
    "Персонаж:", V(subgraph)$name,
    "<br>Группа:", V(subgraph)$group,
    "<br>Центральность:", degree(subgraph)
  ),
  font = list(align = "center"),
  stringsAsFactors = FALSE
)

edges_vis <- get.data.frame(subgraph, what = "edges") |> 
  mutate(
    width = log(weight) + 1  # Нормализиция для визуализации
  )

vis_graph <- visNetwork(nodes_vis, edges_vis, main = "Сеть персонажей") |>
  visNodes(
    shape = "dot",
    scaling = list(
      min = 15,
      max = 50,
      label = list(
        enabled = TRUE,
        min = 14,
        max = 20,
        maxVisible = 10000
      )
    ),
    font = list(
      size = 16,
      color = "black",
      strokeWidth = 2,
      strokeColor = "white"
    ),
    color = list(
      background = nodes_vis$color,
      border = "black",
      highlight = list(
        background = nodes_vis$color,
        border = "darkred"
      ))
  ) |>
  visEdges(
    color = list(color = "rgba(100,100,100,0.7)", highlight = "red"),
    smooth = list(enabled = TRUE, type = "horizontal"),
    scaling = list(min = 1, max = 8),
    hoverWidth = 0
  ) |>
  visPhysics(
    stabilization = list(
      iterations = 5000,
      updateInterval = 50
    ),
    forceAtlas2Based = list(
      gravitationalConstant = -35,
      centralGravity = 0.01,
      springLength = 150,
      avoidOverlap = 0.5
    )
  ) |>
  visOptions(
    selectedBy = list(
      variable = "group",
      style = "width: 200px; font-size: 14px; padding: 5px;",
      values = unique(nodes_vis$group),
      multiple = FALSE
    ),
    highlightNearest = list(
      enabled = TRUE,
      degree = 1,
      algorithm = "hierarchical"
    ),
    nodesIdSelection = list(
      enabled = TRUE,
      style = "width: 200px; font-size: 14px;"
    )
  ) |>
  visInteraction(
    hover = TRUE,
    tooltipDelay = 0
  )

vis_graph

Казалось бы, 6 тематических групп - античные мифы, библейские сюжеты, святые и исторические фигуры - должны быть разрозненными мирами. Но именно их взаимодействие составляет суть коллекции Слоана, отражая универсальный закон культуры: ни один нарратив не существует в вакууме.

Граф содержит 827 персонажей и 1967 связей между ними

cat("Класс:", class(subgraph))
Класс: igraph
cat("\nКоличество узлов:", vcount(subgraph))

Количество узлов: 827
cat("\nКоличество ребер:", ecount(subgraph))

Количество ребер: 1967

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

cat("Плотность:", edge_density(subgraph))
Плотность: 0.005759023

Граф фрагментирован и имеет 78 компонент (все изолированные узлы удалены).

Граф имеет такое большое количество компонент во многом из-за присутствия реальных исторических личностей, они имеют связи между собой, но никак не связаны с мифологическими персонажами, которые создают основу графа (главную компоненту размером 627).

cat("Количество компонент:", components(subgraph)$no)
Количество компонент: 78
cat("\nРазмер компонент:\n", components(subgraph)$csize)

Размер компонент:
 627 2 2 2 5 7 5 3 4 2 2 5 2 2 2 2 4 2 5 3 2 4 4 2 5 2 2 2 2 2 2 2 2 2 3 2 2 2 2 2 2 2 2 5 2 2 2 2 2 2 2 2 2 2 2 2 2 5 2 3 2 3 2 2 3 3 3 3 2 5 2 2 2 2 2 2 2 2

Скрытые узлы: Микроструктуры культурной паутины

в этом маленьком разделе отойдем от основного графа и рассмотрим “побочные сюжетные линии”

За пределами крупных кластеров и центральных узлов, определяющих магистральные сюжеты, скрываются малоизученные компоненты, объединяющие всего 4–7 элементов. Эти микроструктуры - не просто случайные скопления, но уникальные «узоры».

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

library(ggraph)
library(tidygraph)
library(ggplot2)

components <- components(subgraph)

selected_components <- which(components$csize >= 4 & components$csize <= 7)

subgraphs <- lapply(selected_components, function(comp) {
  nodes <- which(components$membership == comp)
  induced_subgraph(subgraph, nodes)
})

for (i in 1:length(subgraphs)) {
  g <- subgraphs[[i]]
  
  p <- ggraph(g, layout = "auto") +
    geom_edge_link(aes(alpha = 0.7)) +
    geom_node_point(aes(color = as.factor(V(g)$group), size = degree(g))) +
    geom_node_text(aes(label = V(g)$name), repel = TRUE, size = 3) +
    scale_color_manual(values = color_palette) +
    ggtitle(paste("Компонента", unique(components$membership[V(g)]))) +
    theme(
      panel.grid = element_blank(),
      legend.position = "none",
      axis.title = element_blank(),
      axis.text = element_blank(),
      axis.ticks = element_blank()
    )
  
  ggsave(paste0("component_", i, ".png"), plot = p, width = 8, height = 6)
}

Начнем с компоненты, содержащей автора рассматриваемой коллекции - Ганса Слоана (1660–1753) врача, натуралиста, чья коллекция легла в основу Британского музея. На гравюре также изображены Исаак Ньютон (1643–1727) математик, физик, астроном; Джошуа Вард (1685–1761) предприниматель, известный производством лекарств; Джон Тейлор (1703–1772) поэт и драматург, а также Сара Мэпп. Из биографий точно известно, что Ньютон, Слоан и Вард действительно были знакомы и объединены научно-медицинскими кругами Лондона XVII–XVIII вв., остальные связи, как и установление личности Сары Мэпп требуют дополнительного исследования.

Эсфирь, Артаксеркс, Аманай и, неожиданно, живописец Антонио Аллегри да Корреджо. Все дело в том, что в одной из ветхозаветных сцен на стене был изображен портрет этого художника. Конечно, эта связь косвенная и в идеальной ситуации такое ребро должно иметь специальный атрибут и отображаться особенным образом. Стоить также отметить, что персонажи сюжета об Эсфири не связаны с остальными персонажами ветхого завета.

Граф визуализирующий сюжет из библейской Книги Руфи, на котором можно увидеть Руфь и Орфу, являющихся маовитянками; Наоми, свекровь Руфи и Орфы и богатого израилитянена Боаза. Также в граф включен целый народ - Моавитяне, которые при идельно правильной группировке должны были уйти вместе с упоминаниями любых других народов. Эти связи появлись благодаря серии гравюр “История Руфи”.

Короли Иеровоам, Реабоам,Абиям, Аса, чиновник Адорам и пророк Ахия являются персонажами Ветхого Завета и встречаются на гравюрах, которые посвящены царям Израиля и Иудеи после смерти царя Соломона, когда Израиль раскололся на два государства и началась борьба за влияние. Король Иеровоам связан также с пророком через сюжет из 1-ой книги Царств 11:29-39, где Ахия отдает ему 10 из 12 кусков плаща говорит: «Возьми себе десять частей, ибо так говорит Господь: я отдам тебе десять колен Израилевых.». Именно через пророка на гравюрах король связан со своим сыном (о смерти которого мы также узнаем из пророчества Ахии).

Граф, содержащий сюжет Книги Судей 4–5 и следующих персонажей: противоборствующих военачальников Сисару и Варака, героиню Иаиль, которая и убила Сисару, а также Шамгара, судью, напрямую не участвавшего в сюжете и появляющегося в книгах раньше.

Эсон, отец Ясона, был лишён власти, что становится причиной путешествия Ясона за Золотым руном, в котором Медея помогает ему, но после предательства Ясона (он решает жениться на дочери коринфского царя) жестоко ему мстит. После бегства Медеи из Коринф, она находит приют у афинского царя Аэгея и в обмен на защиту обещает дать ему наследника Тесея, которого потом пытается отравить.

Граф визуализирует сюжет, связанный с мифом о Мелеагре и Калидонском вепре,.На графе можно увидеть мать Мелеагра Алфею, которая из мести убивает своего сына, также на графе можно увидеть единственную женщину-охотницу на вепря Аталанту и ее жениха Гиппомена, который хитростью победил Аталанту в беге.

Граф, связывающий Якова I (1566–1625) и Анну Датскую (1574–1619), которые были супругами, Ричарда II (1367–1400) и Вильгельма I (1028–1087), которые также правили Англией, сформировался за счет присутствия гравюры из серии “Книга королей”.

Томас Бодли (1545–1613), ученый и дипломат, основатель Бодлианской библиотеки в Оксфорде; Уильям Герберт, 3-ий граф Пембурк (1506–1570), дипломат, один из самых влиятельных людей Англии; Уильям Лод (1573–1645), архиепископ и политик; Кенельм Дигби (1603–1665) английским философ, ученый, дипломат и авантюрист; Джон Селден (1584–1654), юрист, ученый и мыслитель. Все эти личности были важными фигурами в интеллектуальной и культурной жизни Англии в 16-17 веках, а связаны на графе оказались благодаря фронтиспису каталога Бодлианской библиотеки. Связь этих людей в реальной истории должна быть исследована отдельно.

Анализ малых компонент, объединяющих от 4 до 7 узлов, позволил выявить, что даже локальные сюжеты сохраняют универсальные архетипы: наказание за гордыню, неразделённая любовь, превращение как искупление.
Также небольшие компоненты позволяют проследить связи исторических личностей. Конечно, такую связанность между людьми одного времени необходимо подтверждать их биографией или другими достоверными источниками, но это позволяет задавать интересные вопросы истории.

Если основные кластеры отражают доминирующие культурные догматы, малые компоненты акцентируют индивидуальные трагедии и локальные интерпретации.

Анализ характеристик главного графа

вернемся к исследованию основного графа

Диаметр графа, равный 16, указывает на наличие протяжённых цепочек связей, характерных для сложных структур.

cat("Диаметр:\n")
Диаметр:
lgc <- largest_component(subgraph)
diameter(lgc, directed = FALSE)
[1] 16
get_diameter(lgc)
+ 8/627 vertices, named, from 18679f9:
[1] Abel     Eve      demon    Envy     Jupiter  Aurora   Cephalus Procris

Низкий коэффициент транзитивности (0.187) свидетельствует о слабой кластеризации узлов. Это означает, что связи в графе преимущественно направлены через центральные узлы, а не формируют плотные локальные группы. Например, фигуры с высокой центральностью (Иисус, Дева Мария, ангел) выступают «хабами», соединяющими различные подгруппы, тогда как остальные вершины образуют радиальные связи

cat("Транзитивность:", transitivity(subgraph))
Транзитивность: 0.187366

Наибольшую степень центральности демонстрируют:

Иисус (120), ангел (112), Дева Мария (73) - ключевые религиозные символы. Геркулес (63), Купидон (60), Юпитер (56) - мифологические фигуры.

degrees <- degree(subgraph)
cat("Центральность по количеству связей:\n")
Центральность по количеству связей:
print(sort(degrees, decreasing = T)[1:10])
             Christ               angel              Virgin            Hercules 
                120                 112                  73                  63 
              Cupid             Jupiter             Ulysses            St Peter 
                 60                  56                  52                  46 
St John the Baptist               Venus 
                 42                  42 
betweenness_new <- betweenness(subgraph, 
                               directed = FALSE,
                               normalized = TRUE)

V(subgraph)$betweenness <- betweenness_new

result_tbl <- tibble(
  name = V(subgraph)$name,
  b_old = round(V(subgraph)$betweenness, 4),
  b_new = round(betweenness_new, 4)
) |> 
  arrange(-b_old)

print(result_tbl)
# A tibble: 827 × 3
   name                 b_old  b_new
   <chr>                <dbl>  <dbl>
 1 Hercules            0.153  0.153 
 2 angel               0.139  0.139 
 3 Jupiter             0.0854 0.0854
 4 Christ              0.0812 0.0812
 5 Ulysses             0.0573 0.0573
 6 St Peter            0.0542 0.0542
 7 Aeneas              0.0487 0.0487
 8 Cupid               0.0383 0.0383
 9 Virgin              0.0377 0.0377
10 St John the Baptist 0.0335 0.0335
# ℹ 817 more rows

Точки сочленения - узлы, удаление которых фрагментирует граф. Среди них:

Купидон, Геркулес, Минерва - мифологические персонажи, связывающие античные сюжеты. Святой Павел, Святой Доминик, Дева Мария - религиозные фигуры, обеспечивающие целостность христианского нарратива. Чарльз V Лотарингский, Октавиан Август - исторические личности, интегрирующие политический контекст.

cat("Точки сочленения:\n")
Точки сочленения:
articulation_points(subgraph)
+ 104/827 vertices, named, from 1836d7e:
  [1] Moses                  Agamemnon              Cupid                 
  [4] Galatea                Hercules               Phaeton               
  [7] Ulysses                Pan                    St Paul               
 [10] St Dominic             Charles V of Lorraine  Victory               
 [13] Minerva                Pope                   Augustus              
 [16] Virgin                 St Cecilia             Samson                
 [19] Perseus                King David             Elisha                
 [22] Elijah                 St James the Great     Mars                  
 [25] triton                 Odysseus               Polyphemus            
 [28] Ceres                  Junius Juvenal         satyr                 
+ ... omitted several vertices

Клика размером 10, представляет собой полностью связанную подгруппу. Это ядро религиозного нарратива, отражающее тесные взаимодействия в рамках библейских текстов.

cat("Количество клик:\n")
Количество клик:
clique_num(subgraph)
[1] 10
largest_cliques(subgraph)
[[1]]
+ 10/827 vertices, named, from 1836d7e:
 [1] Holy Family         angel               Virgin             
 [4] St Joseph           St John the Baptist Christ             
 [7] St Elizabeth        Zacharias           Tobias             
[10] Raphael

Модулярность по заданным вручную группам (греческая мифология, римская мифология, новый завет, ветхий завет, святые, исторические личности), равная 0.358, указывает на то, что структура графа частично соответствует заданным группам, но не демонстрирует чёткой кластеризации. Такой показатель может быть связан с пересечением тематических областей, то есть узлы принадлежат нескольким группам одновременно.

group <- as.numeric(factor(V(subgraph)$group))
cat("Модулярность по заданным группам:", modularity(subgraph, membership = group))
Модулярность по заданным группам: 0.3579137

Модулярность случайного блуждания (0.503) выше, чем для заданных групп, что свидетельствует о более эффективном выявлении сообществ этим методом.

cat("Случайное блуждание:\n")
Случайное блуждание:
cw <- cluster_walktrap(subgraph)
membership(cw) |> head()
    Aaron     Abdon      Abel   Abigail Abimelech    Abiram 
       74       169        70       170         4       128 
cat("\nМодулярность:", modularity(cw))

Модулярность: 0.5033611

Модулярность главного собственного вектора (0.539) - самая высокая среди трёх методов, что указывает на разделение графа на сообщества. Это согласуется с идеей, что ключевые узлы формируют ядра кластеров, вокруг которых группируются остальные вершины.

Низкая транзитивность и высокая модулярность графа сочетаются в модели, где слабо связанные кластеры объединены через несколько ключевых узлов.

cat("Главный собственный вектор\n")
Главный собственный вектор
cev <- cluster_leading_eigen(subgraph)
membership(cev) |> head()
    Aaron     Abdon      Abel   Abigail Abimelech    Abiram 
        1         2         1        80        81         1 
cat("\nМодулярность:", modularity(cev))

Модулярность: 0.5387087

Архитектура сообществ: алгоритм Лувена и фокусный анализ кластера

Кластеризация графа алгоритмом Лувена позволит выявить естественные сообщества в сложной сети, систематизируя данные для анализа. 

louvain_clusters <- cluster_louvain(subgraph)
V(subgraph)$louvain_group <- membership(louvain_clusters)

cluster_sizes <- sizes(louvain_clusters)
cat("Размеры кластеров:\n")
Размеры кластеров:
print(cluster_sizes)
Community sizes
  1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20 
 37   2  59   2   2 196  71  82   5   7   5   3  30   4   2   2   5   2   2   2 
 21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37  38  39  40 
  3   2 111   4   2   5   3   2   2   2   4   4   4   2   5   2   2   2   2   2 
 41  42  43  44  45  46  47  48  49  50  51  52  53  54  55  56  57  58  59  60 
  2   2   2   2   2   3   2   2   2   2   2   2   2   2   5   2   2   2   2   2 
 61  62  63  64  65  66  67  68  69  70  71  72  73  74  75  76  77  78  79  80 
  2   2   2   2   2   5   2   2   2   4   2   2   2   5   5   2   3   2   3   2 
 81  82  83  84  85  86  87  88  89  90  91  92  93  94  95  96  97  98 
  2   3   3   3   3   3   3   2   5   2   2   2   2   2   2   2   2   2

Модулярность алгоритма Лувена близкая к 0.56 указывает на выраженную структурированность сети. Узлы внутри выделенных сообществ связаны значительно плотнее, чем с узлами из других групп.

cat("Модулярность:", modularity(louvain_clusters))
Модулярность: 0.5581643

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

Обратим внимание, например, на кластер 7, он содержит 199 персонажей, 129 из которых относятся к греческой мифологии и 47 к римской, такое соотношение выглядит осмысленным, учитывая распространенность пересечения персонажей римской и греческой мифологии. В 8 кластере 98 из 131 персонажа относятся к греческой мифологии и еще 19 к римской. Кластер 23 объединяет святых и персонажей Нового Завета, на третьем месте реальные исторические личности. Персонажи Ветхого Завета состовляют кластер 4, а вот исторические личности не выделились в отдельный кластер, они либо составляют малую часть больших кластеров другой тематики, либо составляют собственный небольшой кластер (самый большой размер собственного кластера исторических личностей - 5)

cluster_analysis <- V(subgraph) |>
  data.frame() |>
  mutate(
    louvain_group = V(subgraph)$louvain_group,
    group = V(subgraph)$group
  ) |>
  group_by(louvain_group, group) |>
  summarise(
    n = n(),
    avg_degree = mean(degree(subgraph)),
    .groups = 'drop'
  ) |>
  group_by(louvain_group) |>
  mutate(
    total_in_cluster = sum(n),
    group_ratio = n / total_in_cluster
  ) |>
  ungroup() |>
  arrange(desc(n))

top_20_cluster_groups <- cluster_analysis |>
  slice_head(n = 20)

cat("\nТоп-20 тематических групп по количеству:\n")

Топ-20 тематических групп по количеству:
print(top_20_cluster_groups, n = Inf)
# A tibble: 20 × 6
   louvain_group group                 n avg_degree total_in_cluster group_ratio
   <membrshp>    <chr>             <int>      <dbl>            <int>       <dbl>
 1  6            Greek.mythology     125       4.76              196      0.638 
 2  8            Greek.mythology      69       4.76               82      0.841 
 3 23            The.New.Testament    57       4.76              111      0.514 
 4  3            The.Old.Testament    48       4.76               59      0.814 
 5  6            Roman.mythology      48       4.76              196      0.245 
 6  7            Greek.mythology      38       4.76               71      0.535 
 7 23            Saints               32       4.76              111      0.288 
 8  1            The.Old.Testament    30       4.76               37      0.811 
 9  7            Roman.mythology      15       4.76               71      0.211 
10  7            Historical.figur…    14       4.76               71      0.197 
11 13            The.New.Testament    13       4.76               30      0.433 
12 13            Saints               12       4.76               30      0.4   
13 23            Historical.figur…    12       4.76              111      0.108 
14  6            Historical.figur…    11       4.76              196      0.0561
15  6            The.Old.Testament    11       4.76              196      0.0561
16 23            The.Old.Testament     9       4.76              111      0.0811
17  8            Roman.mythology       8       4.76               82      0.0976
18 10            The.Old.Testament     7       4.76                7      1     
19  3            Greek.mythology       5       4.76               59      0.0847
20  9            The.Old.Testament     5       4.76                5      1

Визуализируем кластеризацию Лувена, чтобы наглядно увидеть эти кластеры, посмотреть кто в них пападает и какие связи имеет. Цветовую палитру выберем другую, теперь цвета - это не предопределнные нами группы, а класетры.

cluster_palette <- rainbow(length(cluster_sizes))

nodes <- data.frame(
  id = V(subgraph)$name,
  label = V(subgraph)$name,
  group = V(subgraph)$group,
  louvain_cluster = V(subgraph)$louvain_group,
  color = cluster_palette[V(subgraph)$louvain_group],
  title = paste0(
    "Персонаж: ", V(subgraph)$name,
    "<br>Кластер: ", V(subgraph)$louvain_group,
    "<br>Тематическая группа: ", V(subgraph)$group,
    "<br>Центральность: ", degree(subgraph)
  ),
  stringsAsFactors = FALSE
)

edges <- get.data.frame(subgraph) |>
  mutate(width = log(weight) + 1)

visNetwork(nodes, edges, main = "Кластеризация Лувена") |> 
  visNodes(
    shape = "dot",
    scaling = list(min = 10, max = 30),
    font = list(size = 12, color = "black")
  ) |>
  visEdges(
    color = list(opacity = 0.3),
    smooth = FALSE
  ) |>
  visPhysics(
    stabilization = TRUE,
    forceAtlas2Based = list(
      gravitationalConstant = -30,
      springLength = 100
    )
  ) |>
  visOptions(
    highlightNearest = list(enabled = TRUE, degree = 1),
    selectedBy = list(
      variable = "louvain_cluster",
      style = "width: 180px;"
    )
  ) 
clusters_to_analyze <- c(6, 8, 23)

for(cl in clusters_to_analyze) {
  cluster_members <- V(subgraph)[V(subgraph)$louvain_group == cl]
  
  cat("\n--- Кластер", cl, "---")
  
  cat("\nТоп персонажей (по степени центральности):\n")
  top_characters <- sort(degree(subgraph)[cluster_members], decreasing = TRUE)
  print(head(top_characters, 3))
  
  cat("\nТоп тематических групп:\n")
  top_groups <- sort(table(V(subgraph)$group[cluster_members]), decreasing = TRUE)
  print(names(top_groups)[1:3])
}

--- Кластер 6 ---
Топ персонажей (по степени центральности):
  Cupid Jupiter   Venus 
     60      56      42 

Топ тематических групп:
[1] "Greek.mythology"    "Roman.mythology"    "Historical.figures"

--- Кластер 8 ---
Топ персонажей (по степени центральности):
 Ulysses Achilles   Athena 
      52       27       24 

Топ тематических групп:
[1] "Greek.mythology"    "Roman.mythology"    "Historical.figures"

--- Кластер 23 ---
Топ персонажей (по степени центральности):
Christ  angel Virgin 
   120    112     73 

Топ тематических групп:
[1] "The.New.Testament"  "Saints"             "Historical.figures"

Рассмотрим поближе и визуализируем кластер 7, который отражает греческую мифологию (и возвращаем цвета узлов по преодпределенным группам).

eigen_vals <- eigen_centrality(subgraph, scale = FALSE)$vector

V(subgraph)$eigen_vector <- eigen_vals

cluster_6_nodes <- V(subgraph)[V(subgraph)$louvain_group == 6]
cluster_6_subgraph <- induced_subgraph(subgraph, cluster_6_nodes)

eigen_values <- V(cluster_6_subgraph)$eigen_vector
normalized_sizes <- scales::rescale(eigen_values, to = c(15, 50))

nodes <- data.frame(
  id = V(cluster_6_subgraph)$name,
  label = V(cluster_6_subgraph)$name,
  group = V(cluster_6_subgraph)$group,
  color = color_palette[V(cluster_6_subgraph)$group],
  value = normalized_sizes,  # Используем нормализованные значения
  title = paste0(
    "Персонаж: ", V(cluster_6_subgraph)$name,
    "<br>Группа: ", V(cluster_6_subgraph)$group,
    "<br>Собственный вектор: ", round(eigen_values, 3)
  ),
  stringsAsFactors = FALSE
)

edges <- get.data.frame(cluster_6_subgraph, what = "edges") |> 
  mutate(
    width = scales::rescale(weight, to = c(1, 8))
  )

vis_graph <- visNetwork(nodes, edges, main = "Кластер 6") |>
  visNodes(
    shape = "dot",
    scaling = list(
      min = 15,
      max = 50,
      label = list(
        enabled = TRUE,
        min = 14,
        max = 20,
        maxVisible = 10000
      )
    ),
    font = list(
      size = 16,
      color = "black",
      strokeWidth = 2,
      strokeColor = "white"
    ),
    color = list(
      background = nodes$color,
      border = "black",
      highlight = list(
        background = nodes$color,
        border = "darkred"
      )
    )
  ) |>
  visEdges(
    color = list(color = "rgba(100,100,100,0.7)", highlight = "red"),
    smooth = list(enabled = TRUE, type = "horizontal"),
    scaling = list(min = 1, max = 8),
    hoverWidth = 0
  ) |>
  visPhysics(
    stabilization = list(
      iterations = 5000,
      updateInterval = 50
    ),
    forceAtlas2Based = list(
      gravitationalConstant = -35,
      centralGravity = 0.01,
      springLength = 150,
      avoidOverlap = 0.5
    )
  ) |>
  visOptions(
    highlightNearest = list(
      enabled = TRUE,
      degree = 1,
      algorithm = "hierarchical"
    ),
    nodesIdSelection = list(
      enabled = TRUE,
      style = "width: 200px; font-size: 14px;"
    )
  ) |>
  visInteraction(
    hover = TRUE,
    tooltipDelay = 0
  )

vis_graph

Кластер действительно содержит персонажей греческой мифологии, персонажей других групп почти нет. Выделяется группа Соломона и связаная с ним Царица Савская; Вирсавия - мать Соломона, чьи действия повлияли на его восхождение на престол; Садок - первосвященник, обеспечивший легитимность правления Соломона; Адония - брат-соперник Соломона; Античные и мифологические связи: Марцелл (предположительно Марк Клавдий Марцелл, римский полководец); Овидий - римский поэт; Юпитер и Купидон

Посмотрим поближе на более маленькие группы, для этого снова кластеризуем алгоритмом Лувена

louvain_clusters <- cluster_louvain(cluster_6_subgraph)
V(cluster_6_subgraph)$louvain_group <- membership(louvain_clusters)

cluster_sizes <- sizes(louvain_clusters)
cat("Размеры кластеров:\n")
Размеры кластеров:
print(cluster_sizes)
Community sizes
 1  2  3  4  5  6  7  8  9 10 11 12 13 
21 20 28 30 10 21 13 27  6  3  3 10  4

Получаем довольно высокую модулярность

cat("\nМодулярность:", modularity(louvain_clusters), "\n")

Модулярность: 0.5265156

Многие кластеры выглядят интересно, рассмотрим кластер 4, в нем 26 из 30 персонажей относятся к греческой мифологии.

cluster_analysis <- V(cluster_6_subgraph) |>
  data.frame() |> 
  mutate(
    louvain_group = V(cluster_6_subgraph)$louvain_group,
    group = V(cluster_6_subgraph)$group
  ) |>
  group_by(louvain_group, group) |>
  summarise(
    n = n(),
    avg_degree = mean(degree(cluster_6_subgraph)),
    .groups = 'drop'
  ) |>
  group_by(louvain_group) |>
  mutate(
    total_in_cluster = sum(n),
    group_ratio = n / total_in_cluster
  ) |>
  ungroup() |>
  arrange(desc(n))

top_20_cluster_groups <- cluster_analysis |>
  slice_head(n = 20)

cat("\nТоп-20 тематических групп по количеству:\n")

Топ-20 тематических групп по количеству:
print(top_20_cluster_groups, n = Inf)
# A tibble: 20 × 6
   louvain_group group                 n avg_degree total_in_cluster group_ratio
   <membrshp>    <chr>             <int>      <dbl>            <int>       <dbl>
 1  4            Greek.mythology      26       4.95               30       0.867
 2  3            Greek.mythology      25       4.95               28       0.893
 3  8            Greek.mythology      16       4.95               27       0.593
 4  6            Greek.mythology      14       4.95               21       0.667
 5  1            Greek.mythology      11       4.95               21       0.524
 6  2            Greek.mythology      11       4.95               20       0.55 
 7  8            Roman.mythology       8       4.95               27       0.296
 8  1            Roman.mythology       7       4.95               21       0.333
 9  2            Roman.mythology       7       4.95               20       0.35 
10  6            Roman.mythology       7       4.95               21       0.333
11  5            The.Old.Testament     6       4.95               10       0.6  
12  7            Greek.mythology       6       4.95               13       0.462
13  7            Roman.mythology       6       4.95               13       0.462
14  9            Greek.mythology       5       4.95                6       0.833
15 12            Roman.mythology       5       4.95               10       0.5  
16 12            Historical.figur…     4       4.95               10       0.4  
17  1            The.Old.Testament     3       4.95               21       0.143
18  4            Roman.mythology       3       4.95               30       0.1  
19  5            Greek.mythology       3       4.95               10       0.3  
20 13            Greek.mythology       3       4.95                4       0.75 
eigen_vals <- eigen_centrality(cluster_6_subgraph, scale = FALSE)$vector

V(cluster_6_subgraph)$eigen_vector <- eigen_vals

cluster_4_nodes <- V(cluster_6_subgraph)[V(cluster_6_subgraph)$louvain_group == 4]
cluster_4_subgraph <- induced_subgraph(cluster_6_subgraph, cluster_4_nodes)

eigen_vals <- eigen_centrality(cluster_4_subgraph, scale = FALSE)$vector
eigen_vals[is.na(eigen_vals)] <- 0
normalized_sizes <- scales::rescale(eigen_vals, to = c(15, 50))

nodes <- data.frame(
  id = V(cluster_4_subgraph)$name,
  label = V(cluster_4_subgraph)$name,
  group = V(cluster_4_subgraph)$group,
  color = color_palette[V(cluster_4_subgraph)$group],
  value = normalized_sizes,
  title = paste0(
    "Персонаж: ", V(cluster_4_subgraph)$name,
    "<br>Группа: ", V(cluster_4_subgraph)$group,
    "<br>Собственный вектор: ", round(eigen_vals, 3)
  ),
  stringsAsFactors = FALSE
)

edges <- if (ecount(cluster_4_subgraph) > 0) {
  get.data.frame(cluster_4_subgraph, what = "edges") |> 
    mutate(width = scales::rescale(weight, to = c(1, 8)))
} else {
  data.frame(from = character(), to = character())
}

vis_graph <- visNetwork(nodes, edges, main = "Кластер 4 кластера 6") |>
  visNodes(
    shape = "dot",
    scaling = list(
      min = 15,
      max = 50,
      label = list(
        enabled = TRUE,
        min = 14,
        max = 20,
        maxVisible = 10000
      )
    ),
    font = list(
      size = 16,
      color = "black",
      strokeWidth = 2,
      strokeColor = "white"
    ),
    color = list(
      background = nodes$color,
      border = "black",
      highlight = list(
        background = nodes$color,
        border = "darkred"
      )
    )
  ) |>
  visEdges(
    color = list(color = "rgba(100,100,100,0.7)", highlight = "red"),
    smooth = list(enabled = TRUE, type = "horizontal"),
    scaling = list(min = 1, max = 8),
    hoverWidth = 0
  ) |>
  visPhysics(
    stabilization = list(
      iterations = 5000,
      updateInterval = 50
    ),
    forceAtlas2Based = list(
      gravitationalConstant = -35,
      centralGravity = 0.01,
      springLength = 150,
      avoidOverlap = 0.5
    )
  ) |>
  visOptions(
    highlightNearest = list(
      enabled = TRUE,
      degree = 1,
      algorithm = "hierarchical"
    ),
    nodesIdSelection = list(
      enabled = TRUE,
      style = "width: 200px; font-size: 14px;"
    )
  ) |>
  visInteraction(
    hover = TRUE,
    tooltipDelay = 0
  )

vis_graph

Центральными узлами на графе являются брат и сестра - Аполлон и Диана, рассмотрим связи подробнее. Связи Аполлона:

  • Гиацинт, возлюбленный Аполлона.

  • Марсий, сатир, вызвавший Аполлона на музыкальное состязание, судьей выступил Тмол, а царь Царь Мидас осмелился оспорить вердикт.

  • Кипарис, юноша, случайно убивший своего оленя. От горя превращён Аполлоном в кипарис - символ скорби.

  • Дафна, дочь речного бога Пенея, с которым и связана на графе

  • Прометей, титан, похитивший огонь для людей

  • Гигиея, богиня здоровья, дочь Асклепия (сына Аполлона)

  • Кадм, основатель Фив

  • Эвринома и Левкотея

  • Ниоба и ее дети. Ниоба потеряла всех детей от стрел Аполлона и Дианы.

  • Латона - мать Аполлона и Дианы, оскорбленная Ниобой.

Свзяи Дианы:

  • Ифигения, Агамемнон и Диана. Ифигения, дочь Агамемнона, была принесена в жертву ради попутного ветра в Трою. Диана спасла её, сделав жрицей.

  • Аретуза нимфа, превращаенная Дианой в источник, чтобы она могла убежать от преследования Альфея.

  • Хиона и Дедалион. Хиона, возгордившаяся красотой, была убита Дианой. Её отец Дедалион, охваченный горем, стал ястребом.

  • Актеон превращаенная Дианой в оленя, за то что случайно увидел её. Бауэр, также связанный с ними, был ошибочно определен как историческая личность.

  • Каллисто бывшая спутница Дианы, которая была превращаена в медведицу, сын Каллисто Аркас и Океан

Аполлон и Диана выступают не только как центральные фигуры в графе, но и как смысловые «хабы», объединяющие разнородные мифологические сюжеты.

cat("Класс:", class(cluster_4_subgraph))
Класс: igraph
cat("\nКоличество узлов:", vcount(cluster_4_subgraph))

Количество узлов: 30
cat("\nКоличество ребер:", ecount(cluster_4_subgraph))

Количество ребер: 42

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

cat("Плотность:", edge_density(cluster_4_subgraph))
Плотность: 0.09655172

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

cat("Диаметр:\n")
Диаметр:
lgc <- largest_component(cluster_4_subgraph)
diameter(lgc, directed = FALSE)
[1] 13
get_diameter(lgc)
+ 7/30 vertices, named, from 196088f:
[1] Arcas    Oceanus  Callisto Diana    Latona   Apollo G Coronis

Значение транзитивности ниже, чем в основном графе, что свидетельствует о слабой локальной кластеризации. Это согласуется с доминированием радиальных связей от центральных узлов.

cat("Транзитивность:", transitivity(cluster_4_subgraph))
Транзитивность: 0.1714286

Точки сочленения: Диана, Аполлон, Царь Мидаз, Каллисто. Их удаление фрагментирует подграф, что подчёркивает их роль «мостов» между группами.

cat("Точки сочленения:\n")
Точки сочленения:
articulation_points(cluster_4_subgraph)
+ 4/30 vertices, named, from 194d60a:
[1] Diana      Apollo G   King Midas Callisto

Клика из 4 узлов: Ниоба, Аполлон, Диана- отражает миф о наказании Ниобы, чьи дети были убиты стрелами Аполлона и Дианы.

cat("Количество клик:\n")
Количество клик:
clique_num(cluster_4_subgraph)
[1] 4
largest_cliques(cluster_4_subgraph)
[[1]]
+ 4/30 vertices, named, from 194d60a:
[1] Niobe    Apollo G Niobids  Diana

Подграф с Дианой и Аполлоном представляет собой тематически сфокусированную сеть, где связи отражают мифологические циклы (метаморфозы, наказание, семейные драмы). Его разреженность и низкая транзитивность объясняются линейной организацией сюжетов вокруг ключевых персонажей.

Заключительная часть

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

Небольшое заключение
Исследование культурных нарративов через призму теории графов позволило визуализировать сложные взаимосвязи между античными, библейскими и историческими элементами.

Анализ кластеров, модулярности и центральности продемонстрировал, что мифология и религия не существуют изолированно, а образуют динамичную систему, где античные боги и христианские святые взаимодействуют через аллегории, исторические параллели и художественные интерпретации. Гравюры из коллекции Слоана, словно зашифрованные карты, стали ключом к расшифровке этой многовековой паутины, раскрывая, как Юпитер перекликается с библейскими царями, а Купидон - с духовными исканиями средневековых мистиков.

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