Сообщества героев драмы ‘Маскарад’ М.Ю. Лермонтова: мой путь

Введение

Добрый день! Прошу, не закрывайте сразу, как только увидите название. Текст драмы ‘Маскарад’ уже имеется в замечательном Dracor, но поскольку впечатление от произведения велико и еще очень живо, мы позволили себе самостоятельно пройти путь от сбора данных до построения социальной сети. Заранее, мы не знали, как собирался, размечался корпус, какие метрики использовались для подсчета связей. Но, источник один и тот же (Библиотека Алексея Комарова), чтобы была возможность сравнить результаты Д. Скоринкина и Ф. Фишера с нашими. Результаты получились немного разные. Путь был тернист и временами наваливалось отчаяние, но что-то да вышло, давайте смотреть.

Немного о драме…

Драма в 4-х действиях была написана М.Ю. Лермонтовым в 1835-1836 гг. Опубликована в 1842 г. М.Ю. несколько раз переписывал произведение из-за цензуры. До нас дошла только вторая редакция (в первой все заканчивалось смертью Нины).

Аннотация: Дворянин Е. А. Арбенин, профессиональный игрок в карты, решает оставить прежний образ жизни и начать степенную жизнь. Но не так легко уйти от Судьбы. В центре драмы – человек, который решает «выбраться» на светлую сторону, преодолевая препятствия, попадая в ловушки, и все в земной жизни подталкивает его на темную сторону. Это драма о пути человеческой души, способна ли она выжить в «темном» обществе, найти спасение. Это произведение М.Ю. Лермонтов написал специально для постановки на сцене, но при его жизни этого так и не случилось. Теперь же, это можно сказать классика русского театра

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

Подгружаем необходимые библиотеки. Парсим текст по действиям.

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

url <- "https://ilibrary.ru/text/1247/index.html" # сохраняем ссылку на текст
html = read_html(url) # читаем ссылку
toc <- html |> 
  html_elements(".d2 a") # достаем названия и ссылки на действия

actions <- tibble(
  title = toc |>
    html_attr("target"),
  href = toc |> 
    html_attr("href")
) |> 
  filter(!is.na(title)) # кладем ссылки в таблицу

actions <- actions |> 
  mutate(link = paste0("https://ilibrary.ru", href)) |> 
  select(-href)

urls <- actions |> 
  pull(link) # сохраняем ссылки отдельно

get_text <- function(url) {
  read_html(url) |> 
    html_elements("psb , v") |> 
    html_text2() |> 
    paste(collapse= " ")
} # эта функция поможет нам запарсить тексты каждого действия
actions_text <- map(urls, get_text)
actions_text <- actions_text |>
  flatten_chr() |> 
  as_tibble()

maskarad <- actions |> 
  bind_cols(actions_text) # соединяем таблицы с названиями и текстами

Сделаем наш датасет более презентабельным.

maskarad <- maskarad |> 
  mutate(title_1 = c("Действие первое", "Действие второе", "Действие третье", "Действие четвертое"))
maskarad <- maskarad |> 
  select(title_1, value)
maskarad <- maskarad |> 
  rename(title = title_1, text = value)
maskarad

# A tibble: 4 × 2
  title              text                                                       
  <chr>              <chr>                                                      
1 Действие первое    1-й понтер Иван Ильич, позвольте мне поставить. Банкомет И…
2 Действие второе    Баронесса Подумаешь: зачем живем мы? для того ли, Чтоб веч…
3 Действие третье    Хозяйка Я баронессу жду, не знаю: Приедет ли — мне, право,…
4 Действие четвертое Арбенин Я ослабел в борьбе с собой Среди мучительных усили…

Стратегия 1: отчаяние и поиск нового решения

Идея 1

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

# udpipe_download_model(language = "russian-syntagrus")
syntagrus <- udpipe_load_model(file = "russian-syntagrus-ud-2.5-191206.udpipe")
maskarad_annotate <- udpipe_annotate(syntagrus, maskarad$text)
maskarad_pos <- as_tibble(maskarad_annotate)

Идея провалилась, т.к. есть некоторые персонажи под тегами прилагательного и др., а также некоторые имеют несколько имен в тексте (Арбенин, Евгений, Евгений Александрович т.п.) или имеют составное имя (1-й гость, князь Звездич и т.п.). При лемматизации все это разбивается на отдельные слова.

Идея 2

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

characters <- c("князь", "Звездич", "Арбенин", "Евгений", "баронесса", "Шприх", "Казарин", "Нина", "гость", "Банкомет", "маска", "доктор", "дама", "игрок", "хозяйка", "хозяин", "чиновник", "понтер", "Штраль", "племянница", "слуга", "служанка", "Иван") # создаю список нужных лиц
# Считаем совместную встречаемость героев в пределах предложения.
maskarad_subset <-  subset(maskarad_pos, lemma %in% characters)
cooc <- cooccurrence(maskarad_subset, term = "lemma", group = c("sentence_id")) |>
  as_tibble()
cooc

# A tibble: 100 × 3
   term1     term2      cooc
   <chr>     <chr>     <dbl>
 1 Арбенин   князь        46
 2 Арбенин   Нина         38
 3 князь     Нина         30
 4 Арбенин   баронесса    19
 5 Казарин   князь        18
 6 Казарин   Нина         16
 7 Арбенин   Казарин      15
 8 баронесса князь        14
 9 баронесса Нина         13
10 гость     князь        10
# ℹ 90 more rows

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

Стратегия 2: немножечко ура

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

text <- gsub("1-й игрок", "1йигрок", maskarad$text)
text <- gsub("2-й игрок", "2йигрок", text)
text <- gsub("1-й понтер", "1йпонтер", text)
text <- gsub("2-й понтер", "2йпонтер", text)
text <- gsub("3-й понтер", "3йпонтер", text)
text <- gsub("4-й понтер", "4йпонтер", text)
text <- gsub("5-й понтер", "5йпонтер", text)
text <- gsub("1-й гость", "1йгость", text)
text <- gsub("2-й гость", "2йгость", text)
text <- gsub("3-й гость", "3йгость", text)
text <- gsub("4-й гость", "4йгость", text)
text <- gsub("5-й гость", "5йгость", text)
text <- gsub("6-й гость", "6йгость", text)
text <- gsub("1-я маска", "1ямаска", text)
text <- gsub("2-я маска", "2ямаска", text)
text <- gsub("1-я дама", "1ядама", text)
text <- gsub("Иван Ильич", "ИванИльич", text)
text_maskarad <- as_tibble(text)

Делим текст драмы на токены и предложения.

text_tokens <- text_maskarad |> 
  unnest_tokens("word", "value")
sentences <- text_maskarad  |> 
  unnest_tokens(sentence, value, token = "sentences")
characters_1 <- c("1йигрок", "2йигрок", "1йпонтер", "2йпонтер", "3йпонтер",
                  "4йпонтер", "5йпонтер", "1йгость", "2йгость", "3йгость",
                  "4йгость", "5йгость", "6йгость", "арбенин", "нина", "князь",
                  "баронесса", "казарин", "шприх", "хозяин", "хозяйка", "банкомет",
                  "многие", "маска", "дама", "племянница", "слуга", "доктор", "старик", "игроки", "чиновник", "1ямаска", "2ямаска", "1ядама", "иван", "служанка")# создаем список героев для фильтрации по токенам.
maskarad_char_token <- subset(text_tokens, word %in% characters_1)#отбираем наших героев

Считаем совместную встречаемость персонажей в рамках предложения.

co_occurrence <- cooccurrence(maskarad_char_token$word, group = sentences$sentence)
maskarad_relation <- as_tibble(co_occurrence)
maskarad_relation

# A tibble: 138 × 3
   term1     term2      cooc
   <chr>     <chr>     <int>
 1 нина      арбенин      71
 2 арбенин   нина         70
 3 князь     арбенин      58
 4 арбенин   князь        51
 5 арбенин   казарин      31
 6 казарин   арбенин      27
 7 баронесса князь        26
 8 князь     князь        23
 9 князь     баронесса    23
10 князь     маска        22
# ℹ 128 more rows

Ура, что-то похожее на правду получилось! Заметим, что он посчитал и однонапрвленные и двунаправленные связи. А также, встречается, что некоторые персонажи взаимодействуют сами с собой. Это тоже, кажется, недалеко от истины, ведь герои часто ведут монологи или рассуждают “про себя”. Однако, это может нам помешать при создании графа, поэтому избавимся от них.

maskarad_relation <- maskarad_relation |> 
  mutate(number = row_number()) |> 
  filter(number != 8) |> 
  filter(number != 16) |> 
  filter(number != 25) |> 
  filter(number != 29) |> 
  filter(number != 33) |> 
  filter(number != 35) |> 
  filter(number != 50) |>
  filter(number != 101)
maskarad_relation[126, "term1"] <- "дама_1"
maskarad_relation[127, "term2"] <- "дама_1"

maskarad_relation <- maskarad_relation |> 
  rename(Person_1 = term1) |> 
  rename(Person_2 = term2) |> 
  rename(Weight = cooc) |> 
  select(Person_1, Person_2, Weight)# совместную встречаемость мы закодировали, как вес ребра.
maskarad_relation

# A tibble: 130 × 3
   Person_1  Person_2  Weight
   <chr>     <chr>      <int>
 1 нина      арбенин       71
 2 арбенин   нина          70
 3 князь     арбенин       58
 4 арбенин   князь         51
 5 арбенин   казарин       31
 6 казарин   арбенин       27
 7 баронесса князь         26
 8 князь     баронесса     23
 9 князь     маска         22
10 маска     князь         22
# ℹ 120 more rows

Создание социальной сети

• создаем объект igraph
• делаем граф ненаправленным
• считаем модулярность и выявляем сообщества
• добавляем атрибут принадлежности к сообществу и кодируем цветом
• делаем граф интерактивным

maskarad_graph <- graph_from_data_frame(maskarad_relation)
degrees <- degree(maskarad_graph)
V(maskarad_graph)$degree <- degrees

# выбираем наиболее подходящий алгоритм для выявления сообществ
cw_4 <- cluster_optimal(maskarad_graph)
modularity(cw_4)

[1] 0.343432

V(maskarad_graph)$community <- membership(cw_4)# создаем новый атрибут
community_colors <- c("brown", "skyblue", "green", "orange", "purple", "grey")
V(maskarad_graph)$color <- community_colors[V(maskarad_graph)$community] # назначаем цвет сообществу

Демонстрируем…

data <- toVisNetworkData(maskarad_graph)
maskarad_3d <- visNetwork(nodes = data$nodes, 
                        edges = data$edges,
                        color = data$nodes$color,
                        width = "100%", 
                        height = 600,
                        main = list(text = "Сообщества и связи героев драмы 'Маскарад'"))
visOptions(maskarad_3d, 
           highlightNearest = list(enabled = TRUE, degree = 1, hover = TRUE), 
           nodesIdSelection = FALSE)  |> 
  visPhysics(maxVelocity = 20, stabilization = FALSE)  |>  
  visInteraction(dragNodes = TRUE)

У нас выделилось 6 сообществ. Некоторые из них выглядят не так осмысленно, как если бы мы воспользовались данными Dracor (ниже увидим). Например, А.П. Шприх (ростовщик) оказался ближе к сообществу Князя Звездича и Баронессы Штраль, а не к банкомету и игрокам (см. ниже мир Денег и мир Карточной игры). Хотя, это можно интерпретировать иначе, ведь, как следует из контекста Шприх давний знакомый Баронессы. Князь Звездич оказался отдельно от сообщества, где находятся Нина и Арбенин (см. ниже мир Любви и Дружбы).

Как это выглядит с Dracor

library(rdracor)
lermontov <- get_net_cooccur_igraph(play = "lermontov-maskarad", corpus = "rus")

cw <- cluster_optimal(lermontov)
modularity(cw)

[1] 0.4194836

V(lermontov)$community <- membership(cw)
g <- ggraph(lermontov, layout = "kk") + 
  geom_edge_link() + 
  geom_node_point(aes(color = as.factor(community)), size = 5) +
  geom_node_text(aes(filter = degree > 8, label = name), repel = TRUE) +
  theme_void() +
  labs(title = "Сеть персонажей 'Маскарад' Лермонтова",
       color = "Сообщество")
g

Наблюдения: Четко выделяются 5 сообществ-миров, которые переплетаются вокруг судьбы главного героя Е.А. Арбенина. Это мир Карточной игры, мир Денег, мир Высшего общества 1830-х гг., мир Любви и Дружбы, мир странных дальних родственников, которые приезжают только на крестины и похороны. М.Ю. Лермонтов счел, что выжить добрым и светлым чувствам в окружении таких миров практически невозможно.

Сравнительный анализ

maskarad_graph

IGRAPH 7ed7c0a DN-- 35 130 -- 
+ attr: name (v/c), degree (v/n), community (v/n), color (v/c), Weight
| (e/n)
+ edges from 7ed7c0a (vertex names):
 [1] нина     ->арбенин   арбенин  ->нина      князь    ->арбенин  
 [4] арбенин  ->князь     арбенин  ->казарин   казарин  ->арбенин  
 [7] баронесса->князь     князь    ->баронесса князь    ->маска    
[10] маска    ->князь     нина     ->князь     казарин  ->шприх    
[13] шприх    ->казарин   князь    ->нина      шприх    ->арбенин  
[16] арбенин  ->шприх     арбенин  ->слуга     арбенин  ->баронесса
[19] слуга    ->арбенин   баронесса->арбенин   баронесса->шприх    
+ ... omitted several edges

vertex.attributes(maskarad_graph)

$name
 [1] "нина"       "арбенин"    "князь"      "казарин"    "баронесса" 
 [6] "маска"      "шприх"      "слуга"      "дама"       "служанка"  
[11] "доктор"     "1йпонтер"   "банкомет"   "3йпонтер"   "4йпонтер"  
[16] "2йпонтер"   "1йигрок"    "чиновник"   "2йгость"    "4йгость"   
[21] "старик"     "игроки"     "хозяин"     "2йигрок"    "5йпонтер"  
[26] "1ямаска"    "многие"     "иван"       "хозяйка"    "1йгость"   
[31] "3йгость"    "5йгость"    "6йгость"    "дама_1"     "племянница"

$degree
 [1] 15 30 29 18 14  5 13  9  9  5  8  6  5  6  4  7  4  2  7  7  3  4  9  3  2
[26]  2  5  4  7  2  6  4  2  2  2

$community
 [1] 1 1 2 3 2 2 2 3 1 1 2 3 3 4 4 4 3 2 1 5 2 3 3 3 4 2 1 2 1 1 5 5 5 6 6

$color
 [1] "brown"   "brown"   "skyblue" "green"   "skyblue" "skyblue" "skyblue"
 [8] "green"   "brown"   "brown"   "skyblue" "green"   "green"   "orange" 
[15] "orange"  "orange"  "green"   "skyblue" "brown"   "purple"  "skyblue"
[22] "green"   "green"   "green"   "orange"  "skyblue" "brown"   "skyblue"
[29] "brown"   "brown"   "purple"  "purple"  "purple"  "grey"    "grey"   

lermontov

IGRAPH 81b546d UNW- 48 187 -- 
+ attr: name (v/c), isGroup (v/l), gender (v/c), numOfScenes (v/n),
| numOfSpeechActs (v/n), numOfWords (v/n), degree (v/n), weightedDegree
| (v/n), closeness (v/n), betweenness (v/n), eigenvector (v/n),
| community (v/n), weight (e/n)
+ edges from 81b546d (vertex names):
[1] 1-й понтер (I/1/1)--Банкомет          
[2] 1-й понтер (I/1/1)--2-й понтер (I/1/1)
[3] 1-й понтер (I/1/1)--3-й понтер (I/1/1)
[4] 1-й понтер (I/1/1)--4-й понтер (I/1/1)
[5] 1-й понтер (I/1/1)--Князь Звездич     
+ ... omitted several edges

vertex.attributes(lermontov)

$name
 [1] "1-й понтер (I/1/1)"  "Банкомет"            "2-й понтер (I/1/1)" 
 [4] "3-й понтер (I/1/1)"  "4-й понтер (I/1/1)"  "Князь Звездич"      
 [7] "Шприх"               "Арбенин"             "Казарин"            
[10] "Игроки"              "1-й понтер (I/1/2)"  "1-й игрок (I/1/2)"  
[13] "2-й игрок (I/1/2)"   "3-й понтер (I/1/2)"  "4-й понтер (I/1/2)" 
[16] "5-й понтер (I/1/2)"  "1-й игрок (I/1/3)"   "2-й игрок (I/1/3)"  
[19] "Слуга (I/1/3)"       "Хозяин"              "Женская маска"      
[22] "Маска (Неизвестный)" "Слуга Арбенина"      "Нина"               
[25] "Баронесса"           "Чиновник"            "Иван"               
[28] "Хозяин (N.)"         "Хозяйка"             "1-й гость (Бал)"    
[31] "2-й гость (Бал)"     "Многие"              "Дама (III/1/1)"     
[34] "3-й гость (III/1/1)" "4-й гость (III/1/1)" "5-й гость (III/1/1)"
[37] "6-й гость (III/1/1)" "Дама (III/1/3)"      "Петков"             
[40] "Дама (III/1/3)"      "Гость (III/1/4)"     "2-й Гость (III/1/4)"
[43] "3-й Гость (III/1/4)" "Служанка"            "Дама"               
[46] "Племянница"          "Старик"              "Доктор"             

$isGroup
 [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE
[13] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
[25] FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE
[37] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE

$gender
 [1] "MALE"    "MALE"    "MALE"    "MALE"    "MALE"    "MALE"    "MALE"   
 [8] "MALE"    "MALE"    "MALE"    "MALE"    "MALE"    "MALE"    "MALE"   
[15] "MALE"    "MALE"    "MALE"    "MALE"    "MALE"    "MALE"    "FEMALE" 
[22] "MALE"    "MALE"    "FEMALE"  "FEMALE"  "MALE"    "MALE"    "MALE"   
[29] "FEMALE"  "MALE"    "MALE"    "UNKNOWN" "FEMALE"  "MALE"    "MALE"   
[36] "MALE"    "MALE"    "FEMALE"  "MALE"    "FEMALE"  "MALE"    "MALE"   
[43] "MALE"    "FEMALE"  "FEMALE"  "FEMALE"  "MALE"    "MALE"   

$numOfScenes
 [1]  1  1  1  1  1 16  8 25  8  1  1  1  1  1  1  1  1  1  1  1  3  5  4 11 10
[26]  1  1  2  2  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  3

$numOfSpeechActs
 [1]   2   4   5   3   2 134  43 214  58   2   2   2   1   1   1   1   1   1   1
[20]   1  23  31  10 100  56   2   4   3   4   1   3   1   1   3   4   2   1   1
[39]   1   1   1   1   1   4   2   1   2  11

$numOfWords
 [1]    7    5   39   12   15 1349  492 5001 1305   14   17    6   19    8    1
[16]    1    6    8    2    7  441  821   45 1212  978   17   63   24   47    4
[31]   15    4    9   15   17    7    5    6    6    8   13   16   18   12   45
[46]    9   21   90

$degree
 [1]  6  6  6  6  6 31 20 21 12 10 10 10 10 10 10 10  4  4  4  4  1  7  3 22  5
[26]  3  1  3 13 10 10 10 10 10 10 10 10  4  4  4  5  5  5  2  1  1  1  4

$weightedDegree
 [1]  6  6  6  6  6 45 25 41 20 10 10 10 10 10 10 10  4  4  4  4  2 11  5 32 10
[26]  3  1  5 14 10 10 10 10 10 10 10 10  4  4  4  5  5  5  2  1  1  1  4

$closeness
 [1] 0.4583522 0.4583522 0.4583522 0.4583522 0.4583522 0.7302560 0.5822312
 [8] 0.6244218 0.5254281 0.5129179 0.5129179 0.5129179 0.5129179 0.5129179
[15] 0.5129179 0.5129179 0.3746531 0.3746531 0.3746531 0.3746531 0.4183020
[22] 0.4952311 0.4396439 0.5902069 0.5009896 0.4632807 0.3812841 0.4535274
[29] 0.5190977 0.5009896 0.5009896 0.5009896 0.5009896 0.5009896 0.5009896
[36] 0.5009896 0.5009896 0.3779395 0.3779395 0.3779395 0.4488032 0.4488032
[43] 0.4488032 0.4352031 0.0212766 0.0212766 0.3144898 0.4632807

$betweenness
 [1] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.392614863
 [7] 0.186478569 0.173142152 0.012180080 0.000000000 0.000000000 0.000000000
[13] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
[19] 0.000000000 0.000000000 0.000000000 0.010098674 0.001002158 0.164276904
[25] 0.007940179 0.000000000 0.000000000 0.000000000 0.033765032 0.000000000
[31] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
[37] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
[43] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.040703053

$eigenvector
 [1] 8.158032e-02 8.158032e-02 8.158032e-02 8.158032e-02 8.158032e-02
 [6] 3.971192e-01 2.375539e-01 2.591409e-01 1.995410e-01 1.891693e-01
[11] 1.891693e-01 1.891693e-01 1.891693e-01 1.891693e-01 1.891693e-01
[16] 1.891693e-01 2.705687e-02 2.705687e-02 2.705687e-02 2.705687e-02
[21] 3.371220e-02 9.787064e-02 5.989716e-02 2.468893e-01 1.022141e-01
[26] 6.334840e-02 2.199883e-02 7.265029e-02 1.834543e-01 1.731243e-01
[31] 1.731243e-01 1.731243e-01 1.731243e-01 1.731243e-01 1.731243e-01
[36] 1.731243e-01 1.731243e-01 4.400435e-02 4.400435e-02 4.400435e-02
[41] 6.175058e-02 6.175058e-02 6.175058e-02 4.295789e-02 3.170922e-23
[46] 3.170922e-23 5.474168e-03 6.448416e-02

$community
 [1] 1 1 1 1 1 2 1 2 3 3 3 3 3 3 3 3 1 1 1 1 2 2 2 2 2 2 2 2 4 4 4 4 4 4 4 4 4 4
[39] 4 4 2 2 2 2 5 5 2 2

Как видно, у нас меньше узлов и связей. Значит, все-таки некоторых героев нам уловить таким способом не удалось. С другой стороны, в тексте, некоторые герои, как дамы или гости не всегда имеют отличительные признаки (1-я дама, или дама N.), поэтому, т.н. дальнее чтение, скорее всего без внимательного изучения контекста будет очень сложным. Кроме того, у нас получилось разное кол-во сообществ. Скорее всего, потому что нами не были обнаружены некоторые важные связи.