options(warn = -1)
library(xml2)
library(dplyr)
library(stringr)
library(tidytext)
library(tm)
library(ggplot2)
library(text2vec)
library(wordcloud2)
library(udpipe)
library(irlba)
library(uwot)
library(rvest)
library(tidyverse)
library(widyr)Tyler, the Creator: пространство слов и смыслов в альбоме IGOR
Введение
Данный проект является продолженнием исследования, посвященного исполнителю Tyler, the Creator и его альбому IGOR (с первой частью проекта можно ознакомиться, перейдя по ссылке), представляющему собой мозаику, собранную из гудящих бас-линий, выдающихся клавишных проигрышей и расстроенных синтов (и, безусловно, голоса самого Тайлера).
В этом проекте я продолжила анализировать альбом одного из моих любимых исполнителей, посвященный прошедшей (или еще нет) любви и горькому расставанию, и решила узнать, насколько близки песни данного альбома относительно тех слов, которые использует Тайлер, а также какие слова наиболее близки слову, которое ознаменовало главный мотив данного альбома, — love.
Для осуществления описанных выше задач я построила визуализировала топики данного альбома, а также построила визуализацию пространства песен альбома.
А теперь перейдем к деталям…
Этап 0. Подготовимся к работе с альбомом
Для анализа 12 песен альбома IGOR я использую следующие библиотеки:
- xml2
- dplyr
- stringr
- tidytext
- rvest
- tidyverse
- tm
- ggplot2
- text2vec
- wordcloud2
- udpipe
- irlba
- uwot
- widyr
Этап 1. Загрузим необходимые библиотеки
Этап 2. Загрузим XML-документ с песнями альбома
Для анализа песен я решила сама собрать XML-документ, в котором хранятся названия песен, а также их текст. Я положила данный документ с текстами песен в рабочую директорию и на его основе построила тиббл, в котором также решиал посчитать количество слов в каждой песне.
xml_data <- read_xml("igor_lyrics.xml")
titles <- xml_find_all(xml_data, ".//title")
lyrics <- xml_find_all(xml_data, ".//lyrics")
titles_text <- xml_text(titles)
lyrics_text <- xml_text(lyrics)
songs_tibble <- tibble(
title = titles_text,
lyrics = lyrics_text)
count_words <- function(text) {
words <- unlist(strsplit(text, "\\s+"))
length(words)
}
songs_tibble <- songs_tibble %>%
mutate(number_of_words = sapply(lyrics, count_words))
songs_tibble# A tibble: 12 × 3
title lyrics number_of_words
<chr> <chr> <int>
1 IGOR'S THEME "What? What? Wh… 272
2 EARFQUAKE "For real, for … 367
3 I THINK "(Four, four, f… 403
4 EXACTLY WHAT YOU RUN FROM YOU END UP CHASING "Exactly what y… 31
5 RUNNING OUT OF TIME "Running out of… 260
6 NEW MAGIC WAND "Sometimes you … 481
7 A BOY IS A GUN "No, don't shoo… 589
8 PUPPET "I wanna talk, … 363
9 WHAT’S GOOD "Turn my lights… 540
10 GONE, GONE / THANK YOU "Comparing scar… 604
11 I DON’T LOVE YOU ANYMORE "See, heavy fee… 265
12 ARE WE STILL FRIENDS? "Dream\n … 250Этап 3. Предобработаем данные
Для дальнейшего анализа текстов песен Тайлера я решила обработать его данные: привести текст к нижнему регистру и удалить лишние символы, провести токенизацию, удалить стоп-слова с помощью уже собранного списка слов, а также провести частотный анализ.
Стоит отметить, что сета слов stop_words было недостаточно для того, чтобы очистить тексты песен Тайлера и далее их проанализировать, поэтому потребовалось дополнительно очищать тексты песен от тех слов, которые были нерелевантны для анализа и которые были отобраны мной самостоятельно при анализе текстов песен.
# Приведем текст к нижнему регистру и удалим лишние символы
clean_lyrics <- songs_tibble %>%
mutate(
clean_lyrics = str_to_lower(lyrics),
clean_lyrics = str_replace_all(clean_lyrics, "[^a-z\\s]", ""),
clean_lyrics = str_squish(clean_lyrics)
)
# Токенизируем
lyrics_tokens <- clean_lyrics %>%
unnest_tokens(word, clean_lyrics)
# Удаляем стоп-слова
data("stop_words")
# Создаем свой набор стоп-слов
additional_stop_words <- tibble(word = c("dont", "im", "youre", "ill", "aint", "shes", "hes", "ive"))
# Объединяем стандартные стоп-слова и дополнительные
all_stop_words <- bind_rows(stop_words, additional_stop_words)
# Фильтруем токены, удаляя все стоп-слова
filtered_tokens <- lyrics_tokens %>%
anti_join(all_stop_words, by = "word")
# Проведем частотный анализ
word_counts <- filtered_tokens %>%
count(word, sort = TRUE)
# Выведем топ-10 наиболее часто встречающихся слов
print(head(word_counts, 10))# A tibble: 10 × 2
word n
<chr> <int>
1 love 60
2 time 47
3 skate 32
4 friends 31
5 leave 30
6 running 30
7 magic 26
8 real 22
9 fuck 20
10 light 19Также я решила вспомнить красивую визуализацию наиболее частотных слов в песнях альбома IGOR и добавить в данную работу облако слов.
song_tokens <- songs_tibble %>%
unnest_tokens(word, lyrics) %>%
anti_join(stop_words, by = "word") %>%
count(word, sort = TRUE)
song_tokens <- song_tokens %>%
rename(word = word, freq = n)
wordcloud2(
song_tokens[1:30, ],
size = 1,
color = c("lightpink", "pink", "hotpink", "deeppink", "black",
"mediumvioletred", "orchid", "palevioletred", "violetred",
"grey", "lavender", "lightcoral", "darkviolet"),
backgroundColor = "white",
minRotation = 0,
maxRotation = 0
)Этап 4. Основной этап: TF-IDF, DTM, SVD
На данном этапе я посчитала TF-IDF, а также создала матрицу DTM и сделала сингулярное выражение матрицы.
counts <- filtered_tokens |>
count(word, title)
# Считаем tf_idf
tf_idf <- counts |>
bind_tf_idf(word, title, n) |>
arrange(tf_idf) |>
select(-n, -tf, -idf)
# Создаем матрицу термин-документ
dtm <- tf_idf |>
cast_sparse(word, title, tf_idf)
# Делаем сингулярное разложение матрицы
lsa_space <- irlba(dtm, nv = 11)Этап 5. Эмбеддинги слов
Посмотрим на эмбеддинги слов в песнях Тайлера.
rownames(lsa_space$u) <- rownames(dtm)
colnames(lsa_space$u) <- paste0("dim", 1:11)
word_emb <- lsa_space$u |>
as.data.frame() |>
rownames_to_column("word") |>
as_tibble()
word_emb# A tibble: 537 × 12
word dim1 dim2 dim3 dim4 dim5 dim6 dim7 dim8
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 fuck -6.00e-5 -6.86e-4 -2.65e-2 -2.03e-3 -0.0143 0.0138 -7.16e-2 -0.0138
2 time -5.14e-5 -1.19e-3 -4.41e-2 -2.59e-2 -0.0311 0.133 -1.00e-1 0.0103
3 call -9.39e-5 -1.73e-4 -1.10e-2 -6.75e-4 -0.0150 0.00336 -1.31e-2 -0.0140
4 god -2.33e-5 -1.84e-4 -7.54e-4 -1.23e-3 -0.00459 0.00963 -1.51e-2 -0.0169
5 bitch -2.77e-6 -1.51e-4 -1.21e-2 -2.07e-3 -0.00894 0.0398 3.77e-3 -0.0274
6 wanna -1.72e-4 -9.49e-3 -1.12e-3 -8.06e-4 -0.0270 0.0237 -1.22e-2 0.0104
7 car -9.02e-5 -8.98e-5 -1.36e-2 -9.67e-4 -0.0172 0.00123 9.11e-5 -0.0200
8 fall -2.39e-6 -1.90e-2 -1.34e-3 -1.42e-3 -0.00548 0.0157 5.75e-4 -0.0254
9 found -8.97e-5 -9.48e-5 -1.39e-3 -3.45e-3 -0.0200 0.0417 7.26e-3 0.0158
10 hate -1.17e-4 -1.89e-2 -3.21e-4 -3.05e-4 -0.0159 0.00112 3.25e-4 0.00292
# ℹ 527 more rows
# ℹ 3 more variables: dim9 <dbl>, dim10 <dbl>, dim11 <dbl>Преобразуем данные в длинный формат.
word_emb_long <- word_emb |>
pivot_longer(-word, names_to = "dimension", values_to = "value") |>
mutate(dimension = as.numeric(str_remove(dimension, "dim")))
word_emb_long# A tibble: 5,907 × 3
word dimension value
<chr> <dbl> <dbl>
1 fuck 1 -0.0000600
2 fuck 2 -0.000686
3 fuck 3 -0.0265
4 fuck 4 -0.00203
5 fuck 5 -0.0143
6 fuck 6 0.0138
7 fuck 7 -0.0716
8 fuck 8 -0.0138
9 fuck 9 -0.0110
10 fuck 10 -0.0130
# ℹ 5,897 more rowsЭтап 6. Визуализируем топики
library(forcats)
library(viridis)
word_emb_long |>
filter(dimension < 10) |>
group_by(dimension) |>
arrange(dimension, desc(abs(value))) |>
slice_head(n = 10) |>
ungroup() |>
mutate(word = reorder_within(word, value, dimension)) |>
ggplot(aes(word, value, fill = value)) +
geom_col(alpha = 0.8, show.legend = FALSE) +
facet_wrap(~dimension, scales = "free_y", ncol = 3) +
scale_x_reordered() +
coord_flip() +
labs(
x = NULL,
y = "Value",
title = "Первые 9 главных компонент",
subtitle = "Топ-10 слов"
) +
scale_fill_gradientn(colors = c("#ffcccc", "#ff99cc", "#ff66cc", "#ff33cc", "#ff00cc")) +
theme_minimal(base_size = 14) +
theme(
strip.background = element_rect(fill = "#ffcce6", color = "black"),
strip.text = element_text(color = "black", face = "bold"),
panel.background = element_rect(fill = "#ffe6f2"),
axis.text.y = element_text(size = 8, hjust = 1)
)
Исходя из полученной визуализации можно выделить основные мотивы произведения: love (что довольно очевидно), movement, или мотив движения, который реализуется через многочисленные глаголы (bouncing, running, riding, shaking и др.), suffering, реализующийся через такие слова, как die, drained, wasted time, а также мотив manipulation (puppet, magic wand, gun, bouncing и др.).
Этап 7. Эмбеддинги песен
Теперь посмотрим на эмбеддинги песен.
rownames(lsa_space$v) <- colnames(dtm)
colnames(lsa_space$v) <- paste0("dim", 1:11)
doc_emb <- lsa_space$v |>
as.data.frame() |>
rownames_to_column("doc") |>
as_tibble()
doc_emb# A tibble: 12 × 12
doc dim1 dim2 dim3 dim4 dim5 dim6 dim7 dim8
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 NEW … -1.48e-2 -2.20e-3 -2.80e-3 -2.47e-2 -0.977 -0.168 5.15e-2 1.11e-1
2 A BO… -4.03e-5 -1.59e-2 -5.38e-3 -3.31e-3 -0.0681 0.145 -9.77e-1 5.03e-2
3 GONE… -4.03e-5 -5.34e-3 -2.75e-2 -8.99e-3 -0.0445 0.172 1.14e-2 -3.54e-2
4 PUPP… -2.83e-3 -1.15e-3 -1.04e-2 -6.31e-4 -0.0330 0.0482 -4.86e-2 5.12e-2
5 RUNN… -2.98e-5 -1.45e-3 -2.22e-2 -1.81e-1 -0.0198 0.181 -6.44e-2 9.42e-2
6 WHAT… -2.45e-5 -1.67e-3 -2.52e-3 -1.97e-2 -0.0142 0.0314 -4.41e-2 -5.78e-3
7 EARF… -1.23e-4 -1.36e-3 -4.26e-2 -7.53e-2 -0.146 0.230 -7.15e-3 -9.54e-1
8 ARE … -2.67e-5 -1.00e+0 3.96e-3 1.31e-3 0.00375 -0.00386 1.54e-2 -4.01e-5
9 I TH… -3.89e-5 -3.59e-3 -9.98e-1 2.54e-2 0.0149 -0.0524 1.63e-4 2.85e-2
10 I DO… -2.35e-5 -6.28e-4 -3.72e-2 -8.37e-3 -0.114 0.909 1.83e-1 2.44e-1
11 IGOR… -1.23e-4 -8.62e-4 -1.78e-2 -9.80e-1 0.0419 -0.0587 1.37e-2 5.20e-2
12 EXAC… -1.00e+0 6.41e-5 1.20e-4 5.04e-4 0.0146 0.00230 -5.90e-4 -1.70e-3
# ℹ 3 more variables: dim9 <dbl>, dim10 <dbl>, dim11 <dbl>Преобразуем данные в длинный формат.
doc_emb_long <- doc_emb |>
pivot_longer(-doc, names_to = "dimension", values_to = "value") |>
mutate(dimension = as.numeric(str_remove(dimension, "dim")))
doc_emb_long# A tibble: 132 × 3
doc dimension value
<chr> <dbl> <dbl>
1 NEW MAGIC WAND 1 -0.0148
2 NEW MAGIC WAND 2 -0.00220
3 NEW MAGIC WAND 3 -0.00280
4 NEW MAGIC WAND 4 -0.0247
5 NEW MAGIC WAND 5 -0.977
6 NEW MAGIC WAND 6 -0.168
7 NEW MAGIC WAND 7 0.0515
8 NEW MAGIC WAND 8 0.111
9 NEW MAGIC WAND 9 0.0281
10 NEW MAGIC WAND 10 0.00574
# ℹ 122 more rowsЭтап 7. Отправляемся на поиски ближайших соседей…
nearest_neighbors <- function(df, feat, doc=F) {
inner_f <- function() {
widely(
~ {
y <- .[rep(feat, nrow(.)), ]
res <- rowSums(. * y) /
(sqrt(rowSums(. ^ 2)) * sqrt(sum(.[feat, ] ^ 2)))
matrix(res, ncol = 1, dimnames = list(x = names(res)))
},
sort = TRUE
)}
if (doc) {
df |> inner_f()(doc, dimension, value) }
else {
df |> inner_f()(word, dimension, value)
} |>
select(-item2)
}Соседи слова love — основного мотива в альбоме
nearest_neighbors(word_emb_long, "love")# A tibble: 537 × 2
item1 value
<chr> <dbl>
1 love 1
2 wasted 0.864
3 hard 0.863
4 peace 0.839
5 feelings 0.820
6 anymore 0.807
7 beat 0.807
8 bumping 0.807
9 chuck 0.807
10 eczema 0.807
# ℹ 527 more rowsИсходя из анализа, слово love близко к словам, являющимся частями чувственных метафов, а также к словам, обозначающим движения и, что довольно очевидно, чувства.
Этап 7. Визуализируем пространство песен
library(ggplot2)
library(viridis)
viz_lsa <- umap(lsa_space$v, n_neighbors = 3)
tibble(
doc = rownames(viz_lsa),
V1 = viz_lsa[, 1],
V2 = viz_lsa[, 2]
) |>
ggplot(aes(x = V1, y = V2, label = doc)) +
geom_text(
aes(label = doc),
size = 3.5,
color = "black",
fontface = "bold",
position = position_jitter(width = 1.2, height = 1.2)
) +
theme_minimal(base_size = 15) +
theme(
panel.background = element_rect(fill = "#fff0f5", color = NA),
panel.grid.major = element_line(color = "#ffd6e7"),
panel.grid.minor = element_line(color = "#ffe6f2"),
plot.background = element_rect(fill = "#ffe6f2", color = NA),
plot.title = element_text(size = 20, face = "bold", color = "#ff66cc"),
axis.title = element_text(color = "#ff3399", face = "bold"),
axis.text = element_text(color = "#ff99cc")
)
Выводы и сторителлинг
Латентно-семантический анализ альбома IGOR показал, что наиболее частотными мотивами, которые связаны с основной темой данного альбома love являются следующие:
- движение, выраженное в том, что лирический герой постоянно ищет что-то, преследует счастье, которым для него когда-то был его близкий человек
- контроль и манипуляции, вероятно, наполнявшие их отношения ранее
- страдания
А вот и наш забавный Тайлер
