Эмоциональная окраска топонимов в «Игре престолов» Дж. Р. Мартина

Аннотация

smth

О чём этот проект

Главная задача этого проекта — проанализировать, как в художественном тексте эмоционально окрашены упомянутые в нем лексемы, обозначающие место. Книги из цикла «Песнь льда и пламени» Джорджа Мартина хорошо подходят для этого, поскольку, во-первых, все главы в книгах написаны от лица различных персонажей (а это значит, что подобный анализ можно провести в контексте восприятия места отдельных героев), а во-вторых, сама географическая местность играет большую роль в сюжете практически наравне с людьми и часто подвергается субъективной оценке с их стороны.

Здесь я буду анализировать эмоциональную окраску только одной локации — Винтерфелла — через призму центральных героев этой книги (семьи Старков).

Что я собираюсь делать: 1. Собрать необходимые данные 2. Лемматизировать и векторизовать текст (последнее нужно для поиска «соседей» слова, которое я собираюсь анализировать) 3. Провести непосредственно анализ эмоциональной окраски.

Код целиком и данные можно посмотреть в репозитории.

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

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

library(rvest)
library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.6.0
✔ ggplot2   4.0.0     ✔ tibble    3.3.0
✔ lubridate 1.9.4     ✔ tidyr     1.3.1
✔ purrr     1.2.0     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter()         masks stats::filter()
✖ readr::guess_encoding() masks rvest::guess_encoding()
✖ dplyr::lag()            masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(polite)
library(stringi)
library(xml2)
library(repurrrsive)

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

text_agot <- read_html('a_game_of_thrones.html') |> 
  html_elements("h2.chapter, p") |> 
  html_text2() |> 
  stri_unescape_unicode()

После этого соединяем весь текст в один вектор. Выведем начало получившегося вектора на экран:

text_agot <- str_c(text_agot, collapse = " ")
str_trunc(text_agot, 300)

[1] "Scanned 3/5/02 by sliph; Proofed by Nadie PROLOGUE We should start back,\u0094 Gared urged as the woods began to grow dark around them. \u0093The wildlings are dead.\u0094 \u0093Do the dead frighten you?\u0094 Ser Waymar Royce asked with just the hint of a smile. Gared did not rise to the bait. He was an old man, past fi..."

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

text_agot <- str_replace_all(text_agot, "\\x{0092}", "'")
text_agot <- str_replace_all(text_agot, "\\x{0093}", "“")
text_agot <- str_replace_all(text_agot, "\\x{0094}", "”")
text_agot <- str_replace_all(text_agot, "\\x{0097}", " — ")
text_agot <- str_replace(text_agot, 
                         "Scanned 3/5/02 by sliph; Proofed by Nadie ", "")
str_trunc(text_agot, 300)

[1] "PROLOGUE We should start back,” Gared urged as the woods began to grow dark around them. “The wildlings are dead.” “Do the dead frighten you?” Ser Waymar Royce asked with just the hint of a smile. Gared did not rise to the bait. He was an old man, past fifty, and he had seen the lordlings come an..."

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

title <- paste(c("PROLOGUE", "BRAN", "CATELYN", "DAENERYS",
                 "EDDARD", "JON", "ARYA", "TYRION", "SANSA"), collapse = '|')

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

agot_tbl <- tibble(text_agot = str_split_1(text_agot, 
                                           regex(paste0('(?=', title, ')'))))
agot_tbl

# A tibble: 74 × 1
   text_agot                                                                    
   <chr>                                                                        
 1 ""                                                                           
 2 "PROLOGUE We should start back,” Gared urged as the woods began to grow dark…
 3 "BRAN The morning had dawned clear and cold, with a crispness that hinted at…
 4 "CATELYN Catelyn had never liked this godswood. She had been born a Tully, a…
 5 "DAENERYS Her brother held the gown up for her inspection. “This is beauty. …
 6 "EDDARD The visitors poured through the castle gates in a river of gold and …
 7 "JON There were times — not many, but a few — when Jon Snow was glad he was …
 8 "CATELYN Of all the rooms in Winterfell's Great Keep, Catelyn's bedchambers …
 9 "ARYA Arya's stitches were crooked again. She frowned down at them with dism…
10 "BRAN The hunt left at dawn. The king wanted wild boar at the feast tonight.…
# ℹ 64 more rows

Теперь добавим к нашей таблице столбец с заголовком. Кроме того, уберем 1 строку, которая осталась пустой, и добавим id к каждой главе, чтобы различать главы одних и тех же персонажей (в целом, можно обойтись и без этого, поскольку конкретно здесь номер главы не играет особой роли):

agot_tbl <- agot_tbl |> 
  filter(text_agot != '') |> 
  mutate(chapter = str_extract(text_agot, title),
         id = row_number(),
         text = str_remove(text_agot, title)) |> 
  select(-text_agot) |> 
  unite('chapter_id', chapter:id, sep='_')
agot_tbl

# A tibble: 73 × 2
   chapter_id text                                                              
   <chr>      <chr>                                                             
 1 PROLOGUE_1 " We should start back,” Gared urged as the woods began to grow d…
 2 BRAN_2     " The morning had dawned clear and cold, with a crispness that hi…
 3 CATELYN_3  " Catelyn had never liked this godswood. She had been born a Tull…
 4 DAENERYS_4 " Her brother held the gown up for her inspection. “This is beaut…
 5 EDDARD_5   " The visitors poured through the castle gates in a river of gold…
 6 JON_6      " There were times — not many, but a few — when Jon Snow was glad…
 7 CATELYN_7  " Of all the rooms in Winterfell's Great Keep, Catelyn's bedchamb…
 8 ARYA_8     " Arya's stitches were crooked again. She frowned down at them wi…
 9 BRAN_9     " The hunt left at dawn. The king wanted wild boar at the feast t…
10 TYRION_10  " Somewhere in the great stone maze of Winterfell, a wolf howled.…
# ℹ 63 more rows

Лемматизация текста

Прежде чем приступить к этому пункту, загрузим модель Udpipe для английского языка:

library(udpipe)

# udpipe_download_model(language = "english-ewt")
model <- udpipe_load_model("english-ewt-ud-2.5-191206.udpipe")

Аннотируем текст и сразу же создадим из него tibble:

agot_annotaded <- udpipe_annotate(model, agot_tbl$text, 
                                  doc_id = agot_tbl$chapter_id)

agot_anno_tbl <-  agot_annotaded |> 
  as_tibble() |> 
  select(-paragraph_id)

Загрузка модели для анализа эмоциональности

Займёмся этим сразу же, чтобы не отвлекаться потом. Установим модель lexicon для английского языка, а после загрузим модель SO-CAL Google:

# remotes::install_github("cran/lexicon")

library(lexicon)
library(dplyr)

set.seed(0211)
socal <- hash_sentiment_socal_google
socal <- socal |> 
  rename(token = x, value = y)

Векторизация

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

named_tbl <- function(tbl, name) {
  new_tbl <- tbl |> 
    filter(str_detect(doc_id, name)) |> 
    filter(upos != 'PUNCT') |> 
    select(doc_id, lemma) |> 
    nest(lemma = c(lemma))
}

eddard <- named_tbl(agot_anno_tbl, 'EDDARD')
catelyn <- named_tbl(agot_anno_tbl, 'CATELYN')
sansa <- named_tbl(agot_anno_tbl, 'SANSA')
arya <- named_tbl(agot_anno_tbl, 'ARYA')
bran <- named_tbl(agot_anno_tbl, 'BRAN')
jon <- named_tbl(agot_anno_tbl, 'JON')

После этого приступаем к векторизации. Сперва зададим функцию для скользящих окон:

library(stopwords)
library(widyr)
library(uwot)

Loading required package: Matrix

Attaching package: 'Matrix'

The following objects are masked from 'package:tidyr':

    expand, pack, unpack

library(word2vec)
library(text)

This is text (version 1.7.0).
Newer versions may have improved functions and updated defaults to reflect current understandings of the state-of-the-art.

MacOS detected: Setting OpenMP environment variables to avoid potential crash due to libomp conflicts. 
When using the L-BAM library, be aware that models may be downloaded from external sources. Using models may carry security risks, including the possibility of malicious code in RDS files. Always review and trust the source of any model you load.  
The text package is provided 'as is' without any warranty of any kind. 

For more information about the package see www.r-text.org and www.r-topics.org.

library(slider)

Warning: package 'slider' was built under R version 4.5.2

slide_windows <- function(tbl, window_size) {
  skipgrams <- slider::slide(
    tbl, 
    ~.x, 
    .after = window_size - 1, 
    .step = 1, 
    .complete = TRUE
  )
  
  safe_mutate <- safely(mutate)
  
  out <- map2(skipgrams,
              1:length(skipgrams),
              ~ safe_mutate(.x, window_id = .y))
  
  out  |> 
    transpose()  |> 
    pluck("result")  |> 
    compact()  |> 
    bind_rows()
}

Сделав это, мы можем приступить к созданию эмбеддингов. Снова зададим функцию:

named_emb <- function(nested_tbl) {
  tbl_windows <- nested_tbl |> 
    mutate(lemma = map(lemma, slide_windows, 8L)) |> 
    unnest(lemma) |> 
    unite(window_id, doc_id, window_id)
  
  # расчитываем pmi
  tbl_pmi <- tbl_windows |> 
    pairwise_pmi(lemma, window_id)
  tbl_pmi |> 
    arrange(-abs(pmi))
  
  # расчитываем ppmi
  tbl_ppmi <- tbl_pmi |> 
    mutate(ppmi = case_when(pmi < 0 ~ 0, 
                            .default = pmi)) 
  tbl_ppmi |> 
    arrange(pmi)
  
  # создаем эмбеддинги
  set.seed(123)
  tbl_emb <- tbl_ppmi |> 
    widely_svd(item1, item2, ppmi,
               weight_d = FALSE, nv = 100)
}

eddard_emb <- named_emb(eddard)
catelyn_emb <- named_emb(catelyn)
sansa_emb <- named_emb(sansa)
arya_emb <- named_emb(arya)
bran_emb <- named_emb(bran)
jon_emb <- named_emb(jon)

Поиск соседей

Теперь, после создания эмбеддингов, мы можем найти ближайших соседей к слову «Винтерфелл» у каждого персонажа. Зададим для этого функцию:

neighbors <- function(df, token) {
  df %>%
    widely(
      ~ {
        y <- .[rep(token, nrow(.)), ]
        res <- rowSums(. * y) / 
          (sqrt(rowSums(. ^ 2)) * sqrt(sum(.[token, ] ^ 2)))
        
        matrix(res, ncol = 1, dimnames = list(x = names(res)))
      },
      sort = TRUE
    )(item1, dimension, value) %>%
    select(-item2)
}

Выведем полученные результаты для каждого героя.

Эддард

eddard_winterfell <- eddard_emb |> 
  neighbors("Winterfell") |> 
  rename(token = item1) |> 
  filter(token != 'Winterfell') |> 
  arrange(-value) |> 
  select(-value) |> 
  inner_join(socal)

Joining with `by = join_by(token)`

head(eddard_winterfell, n = 10)

# A tibble: 10 × 2
   token     value
   <chr>     <dbl>
 1 vengeful -4.07 
 2 flat      2.84 
 3 sandy     1.56 
 4 dead     -1.19 
 5 higher    2.33 
 6 cold      0.137
 7 unable    0.757
 8 first     3.79 
 9 clean     1.90 
10 unhappy  -2.84 

Кейтилин

catelyn_winterfell <- catelyn_emb |> 
  neighbors("Winterfell") |> 
  rename(token = item1) |> 
  filter(token != 'Winterfell') |> 
  arrange(-value) |> 
  select(-value) |> 
  inner_join(socal)

Joining with `by = join_by(token)`

head(catelyn_winterfell, n = 10)

# A tibble: 10 × 2
   token       value
   <chr>       <dbl>
 1 safe       0.924 
 2 remote     2.52  
 3 welcome    3.02  
 4 sorry     -0.891 
 5 ugly      -2.18  
 6 squat     -1.83  
 7 unknown    0.536 
 8 lonely    -1.93  
 9 own        2.04  
10 identical -0.0271

Санса

sansa_winterfell <- sansa_emb |> 
  neighbors("Winterfell") |> 
  rename(token = item1) |> 
  filter(token != 'Winterfell') |> 
  arrange(-value) |> 
  select(-value) |> 
  inner_join(socal)

Joining with `by = join_by(token)`

head(sansa_winterfell, n = 10)

# A tibble: 10 × 2
   token      value
   <chr>      <dbl>
 1 fine       2.79 
 2 noble     -0.837
 3 courteous  1.86 
 4 gorgeous  -0.763
 5 grey      -1.16 
 6 man        0.236
 7 numb      -2.52 
 8 safe       0.924
 9 paramount -0.128
10 hateful   -1.08 

Арья

arya_winterfell <- arya_emb |> 
  neighbors("Winterfell") |> 
  rename(token = item1) |> 
  filter(token != 'Winterfell') |> 
  arrange(-value) |> 
  select(-value) |> 
  inner_join(socal)

Joining with `by = join_by(token)`

head(arya_winterfell, n = 10)

# A tibble: 10 × 2
   token        value
   <chr>        <dbl>
 1 extra       1.86  
 2 safe        0.924 
 3 angry      -2.97  
 4 dangerous  -1.03  
 5 weary      -2.69  
 6 grey       -1.16  
 7 thoughtful  0.0158
 8 ill        -1.60  
 9 ready       2.32  
10 wistful    -2.62  

Бран

bran_winterfell <- bran_emb |> 
  neighbors("Winterfell") |> 
  rename(token = item1) |> 
  filter(token != 'Winterfell') |> 
  arrange(-value) |> 
  select(-value) |> 
  inner_join(socal)

Joining with `by = join_by(token)`

head(bran_winterfell, n = 10)

# A tibble: 10 × 2
   token       value
   <chr>       <dbl>
 1 welcome     3.02 
 2 cavernous  -1.13 
 3 standard    0.939
 4 secret     -1.26 
 5 respectful -0.228
 6 favorite    3.30 
 7 scarce     -0.168
 8 long        1.08 
 9 sick       -2.26 
10 slight     -0.885

Джон

jon_winterfell <- jon_emb |> 
  neighbors("Winterfell") |> 
  rename(token = item1) |> 
  filter(token != 'Winterfell') |> 
  arrange(-value) |> 
  select(-value) |> 
  inner_join(socal)

Joining with `by = join_by(token)`

head(jon_winterfell, n = 10)

# A tibble: 10 × 2
   token          value
   <chr>          <dbl>
 1 bittersweet   -0.744
 2 stray         -1.16 
 3 great          1.55 
 4 bored         -1.05 
 5 safe           0.924
 6 uncomfortable -2.01 
 7 skeleton      -1.65 
 8 fourth         3.12 
 9 drunken       -2.00 
10 correct        3.28 

Выводы

У нас получились смешанные результаты: во многих случаях позитивные и негативные ассоциации поделились практически поровну. Отчасти это связано с проблемами модели для оценки тональности. Некоторые слова (к примеру, noble или gorgeous) имеют, согласно ей, негативную коннотацию, другие, как unable, наоборот, почему-то оказываются позитивно окрашенными.

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