Домашняя работа по визуализации графов

Загрузка пакетов

library(udpipe)
library(tidyverse)
library(igraph)
library(ggraph)
library(visNetwork)

Загрузка и подготовка данных

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

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

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

Построение графа

Создаём граф и добавляем атрибуты вершинам: размер и частоту леммы во всём корпусе.

g <- graph_from_data_frame(cooc, directed = FALSE)

# Размер вершины от степени
V(g)$size <- log(degree(g) + 1) * 3

# Частота леммы
freq <- caesar_nouns |> count(lemma, name = "freq")
V(g)$freq <- freq$freq[match(V(g)$name, freq$lemma)]

Статическая визуализация

Подписи расположены со смещением вниз. Узлы окрашены от розового (редкие) до красного (частые)

set.seed(123)
static_plot <- ggraph(g, layout = "fr") +  
  geom_edge_link(aes(alpha = cooc, width = cooc), color = "grey30") +
  scale_edge_width(range = c(0.5, 3), name = "Частота связи") +
  scale_edge_alpha(range = c(0.4, 1), name = "Частота связи") +
  
  geom_node_point(aes(size = size, fill = freq), 
                  shape = 21, color = "black", stroke = 0.2) +
  scale_size_continuous(range = c(2, 10), name = "Степень вершины") +
  scale_fill_gradient(low = "pink", high = "red", name = "Частота\nлеммы") +
  
  geom_node_text(aes(label = name), 
                 size = 3.5, color = "black", 
                 nudge_y = 0.4, check_overlap = TRUE) +
  
  theme_graph(base_family = "sans") +
  theme(legend.position = "bottom", 
        legend.box = "horizontal",
        legend.title = element_text(size = 9),
        legend.text = element_text(size = 8),
        plot.margin = margin(10, 30, 10, 10)) +
  labs(title = "Существительные в 'Записках Цезаря'",
       subtitle = "Совместная встречаемость в предложениях (порог > 19)")

print(static_plot)

Интерактивная визуализация с visNetwork

vis_data <- toVisNetworkData(g)

# Всплывающие подсказки
vis_data$nodes$title <- paste0("<b>", vis_data$nodes$id, "</b><br>",
                                "Частота: ", round(vis_data$nodes$freq, 0), "<br>",
                                "Степень: ", vis_data$nodes$size)
vis_data$edges$title <- paste0("Совместно: ", vis_data$edges$cooc, " раз")

color_pal <- colorRampPalette(c("pink", "red"))
freq_range <- range(vis_data$nodes$freq, na.rm = TRUE)
vis_data$nodes$color <- color_pal(100)[
  findInterval(vis_data$nodes$freq, 
               seq(freq_range[1], freq_range[2], length.out = 100))
]

# Масштабирование узлов
vis_data$nodes$size <- vis_data$nodes$size * 2

visNetwork(nodes = vis_data$nodes, edges = vis_data$edges,
           width = "100%", height = "600px") |>
  visOptions(highlightNearest = list(enabled = TRUE, degree = 1, hover = TRUE),
             nodesIdSelection = TRUE) |>
  visPhysics(stabilization = TRUE, enabled = FALSE) |>  # стабилизация + отключение физики
  visLayout(randomSeed = 123) |>
  visLegend()