Визуализация графов в тексте «Записки Цезаря»

Подзаголовок

Установка пакетов

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

library(ggraph)
library(paletteer)
library(igraph)
library(rdracor)
library(tidyverse)
library(ggraph)
library(igraph)
library(ggimage)
library(visNetwork)
library(networkD3)
library(udpipe)

Работа с текстом и поиск коллокаций

Скачиваю необходимый для работы текст:

caesar <- udpipe_read_conllu("https://github.com/locusclassicus/text_analysis_2024/raw/main/files/bg_latinpipe.conllu")

Выясняю, какие существительные встречаются в одном предложении:

caesar_subset <-  caesar |> 
  filter(upos == "NOUN")

cooc <- cooccurrence(caesar_subset, term = "lemma", 
                     group = c("doc_id", "sentence_id")) |>
  as_tibble() |> 
  filter(cooc > 17) 

DT::datatable(cooc[1:10,])

Порог filter(cooc > 15) был выбран для того, чтобы осталось сбалансированное количество терминов.

Чтобы узнать, какие слова чаще стоят рядом, используем ту же функцию, но с другими аргументами:

cooc2 <- cooccurrence(caesar_subset$lemma, 
                      relevant = caesar_subset$upos %in% c("NOUN", "ADJ"),
                      skipgram = 1) |> 
  as_tibble() |> 
  filter(cooc > 10)

DT::datatable(cooc2[1:10,])

caesar_g <- graph_from_data_frame(cooc2, directed = F)
caesar_g

IGRAPH 81d044f UN-- 29 67 -- 
+ attr: name (v/c), cooc (e/n)
+ edges from 81d044f (vertex names):
 [1] res     --res       castra  --hostis    castra  --locus    
 [4] castra  --dies      castra  --copia     res     --hostis   
 [7] castra  --hostis    res     --dies      res     --locus    
[10] tribunus--miles     res     --locus     res     --castra   
[13] res     --civitas   castra  --locus     res     --consilium
[16] pars    --pars      pars    --flumen    res     --causa    
[19] castra  --legio     hostis  --numerus   res     --causa    
[22] locus   --hostis    castra  --legio     locus   --hostis   
+ ... omitted several edges

v_count <- vcount(caesar_g)
stringr::str_glue("Число вершин в графе: {v_count}")

Число вершин в графе: 29

e_count <- ecount(caesar_g)
stringr::str_glue("Число ребер в графе: {e_count}")

Число ребер в графе: 67

d <- as.numeric(degree(caesar_g))
V(caesar_g)$degree <- d
caesar_g

IGRAPH 81d044f UN-- 29 67 -- 
+ attr: name (v/c), degree (v/n), cooc (e/n)
+ edges from 81d044f (vertex names):
 [1] res     --res       castra  --hostis    castra  --locus    
 [4] castra  --dies      castra  --copia     res     --hostis   
 [7] castra  --hostis    res     --dies      res     --locus    
[10] tribunus--miles     res     --locus     res     --castra   
[13] res     --civitas   castra  --locus     res     --consilium
[16] pars    --pars      pars    --flumen    res     --causa    
[19] castra  --legio     hostis  --numerus   res     --causa    
[22] locus   --hostis    castra  --legio     locus   --hostis   
+ ... omitted several edges

E(caesar_g)$weight <- E(caesar_g)$cooc


V(caesar_g)$group <- ifelse(V(caesar_g)$degree > 5, "important", "other")
top_nodes <- names(sort(degree(caesar_g), decreasing = T))[1:5]

set.seed(13032018)
ggraph(caesar_g, layout = "fr") +
  # тип линии вместо цвета, убираем стрелку
  geom_edge_arc(aes(width = cooc),
              color = "grey50",
              strength = 0.2) +
scale_edge_width(range = c(0.2, 2)) + 
  geom_node_point(aes(size = degree, fill = group),
                shape = 21,
                color = "black") +
  # чуть подвинем
  geom_node_text(aes(label = name), nudge_y = 0.3) +
  scale_fill_manual(values = c("important" = "#8D1D2C", "other" = "#B7D9B1")) +
  labs(
    title = "Граф корреляций в тексте «Записки Цезаря»"
  ) +
  # тип линии для ребер
  scale_size(guide = 'none') +
  theme(legend.position = "bottom") +
theme_graph(base_family = "Arial Narrow") +
theme(text = element_text(size = 11, color = "black"))

В данной визуализации использована библиотека ggraph. Перед выбором итогового layout, я проанализировала результаты всех доступных вариантов и остановилась на fr — силовой алгоритм размещения Фрюхтермана-Рейнгольда. Варианты типа lgl или drl оказались менее подходящими, так как граф имеет относительно небольшое число узлов.

Рубиново-красным цветом выделены наиболее важные узлы, у которых степень соединений превышает пять, а бело-зеленым — все остальные узлы.

Среди ключевых слов выделяются: dies (день), hostis (враг), pars (доля, сторона, отношение), res (вещь, предмет), locus (место, положение), castra (укрепление, военный лагерь), legio (легион).

Интерактивный граф

В качестве упражнения и для расширения навыков была построена интерактивная версия графа.

top5 <- names(sort(degree(caesar_g), decreasing = T))[1:5]
data <- toVisNetworkData(caesar_g)

data$nodes$color <- ifelse(data$nodes$id %in% top5, "#8D1D2C", "#B7D9B1")  
data$nodes$label <- data$nodes$id
data$nodes$group <- ifelse(data$nodes$id %in% top5, "important", "other")


# Визуализация
visNetwork(nodes = data$nodes, edges = data$edges,
           width = "100%", height = 600) |> 
  visGroups(groupname = "important", color = "#8D1D2C") |>
  visGroups(groupname = "other", color = "#B7D9B1")  |>  
  visLegend(width = 0.2, position = "right", main = "Group") |> #  Добавляю легенду
  visOptions(highlightNearest = list(enabled = T, degree = 1, hover = T),
             nodesIdSelection = T) |> 
  visPhysics(stabilization = T, maxVelocity = 20) |> 
  visInteraction(dragNodes = T) |> # Добавляю возможность интерактива
  visInteraction(hideEdgesOnDrag = T) |> 
  visLayout(randomSeed = 123) |> 
  visPhysics(solver = "barnesHut") # Добавляю физику