Plato_s Symposium

Подготовка датасета

Скачаем датасет Diorisis Ancient Greek corpus, распакуем архив и загрузим в окружение файл “Пир”, представляющий собой XLM документ с морфологической разметкой диалога. Извлечём из документа узлы отдельных предложений и применим к ним функцию extract_lemmas, чтобы получить список лемм входящих в каждое из предложений слов.

doc <- read_xml("Diorisis\\Plato (0059) - Symposium (011).xml")
sentence_nodes <- xml_find_all(doc, "//sentence")

extract_lemmas <- function(sentence_node) {
  lemma_nodes <- xml_find_all(sentence_node, ".//word/lemma")
  lemmas <- xml_attr(lemma_nodes, "entry")
  return(lemmas)
}

sentence_lemmas <- lapply(sentence_nodes, extract_lemmas)

Создадим тиббл из всех возможных пар слов, встречающихся в одном предложении. Для этого применим функцию combn для генерации всех возможных комбинаций заданного размера (в нашем случае - 2) из элементов вектора.

table_of_pairs <- tibble(lemma_1 = character(), lemma_2 = character())

for (i in seq_along(sentence_lemmas)) {
  lemmas <- sentence_lemmas[[i]]

  if (length(lemmas) > 1) {
    cooccurrences <- combn(lemmas, 2, simplify = FALSE)
    
    for (cooccurrence in cooccurrences) {
      lemma_1 <- sort(cooccurrence)[1] 
      lemma_2 <- sort(cooccurrence)[2]
      table_of_pairs <- table_of_pairs |>
        add_row(lemma_1 = lemma_1, lemma_2 = lemma_2)
    }
  }
}

Скачаем список древнегреческих стоп-слов и удалим их из полученного тиббла. Также преверим столбцы на наличие NA значений и удалим пары повторяющихся слов. Оставим пары, встречающиеся вместе не менее 10 раз в одном предложении, для визуализации.

stopwords <- readLines("stopwords_greek.txt")
stopwords <- as.list(stopwords)

table_of_pairs_filtered <- table_of_pairs |>
  filter(!lemma_1 %in% stopwords & !lemma_2 %in% stopwords) |>
  filter(!is.na(lemma_1) & !is.na(lemma_2)) |>
  filter (! lemma_1 == lemma_2)

lemma_cooccurrences <- table_of_pairs_filtered |>
  group_by(lemma_1, lemma_2) |>
  summarize(count = n()) |> 
  filter (count >= 10) |>
  arrange(desc(count)) 

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

Построим граф, закодируем ширину рёбер количеством случаев совместной встречаемости.

i_graph_pairs <- graph_from_data_frame(lemma_cooccurrences)
E(i_graph_pairs)$width <- lemma_cooccurrences$count


data <- toVisNetworkData(i_graph_pairs)

data$edges$width <- data$edges$width / 7

graph <- visNetwork(nodes = data$nodes, 
                        edges = data$edges, 
                        main = list(text = "Совместная встречаемость слов в 'Пире' Платона", style = "font-family:serif;color:#555555;font-size:18px;text-align:center;"), 
                        width = "100%", 
                        height = 600)


visOptions(graph, 
           highlightNearest = list(enabled = T, degree = 1, hover = T), 
           nodesIdSelection = F)  |> 
  visPhysics(maxVelocity = 50, stabilization = F)  |>  
  visInteraction(dragNodes = T) |>
  visLayout(randomSeed = 0603)

graph