library(rvest)
library(tidyverse)
library(stringr)
library(xml2)
library(udpipe)
library(stopwords)
library(DT)
library(tidytext)
library(irlba)
library(uwot)
# udpipe_download_model(language = "russian-syntagrus")
<- udpipe_load_model(file = "russian-syntagrus-ud-2.5-191206.udpipe") syntagrus
Секрет популярных песен
Или нет никакого секрета?
Создание датасета
(описание взято из прошлой домашки, где я уже работала с этими данными)
Я буду обкачивать сайт AmDm – это сайт с аккордами к песням. Это неоднозначный выбор для подобного исследования.
Потенциальные недостатки:
вполне возможно, не для всех песен сделали аккорды, то есть не все песни представлены (но нам нужна по сути только некоторая выборка песен исполнителя, обязательно включающая самые популярные, которые там как раз есть, так что сильно это повлиять не должно);
нужно будет очищать текст от аккордов (эта проблема решилась относительно просто, но возникло несколько схожих, о них в разделе “Чистим данные”).
Но этот сайт не блокирует автоматические запросы, и на нём присутствует достаточно песен выбранных мной исполнителей, так что попробуем.
Установка библиотек
Парсим страницу исполнителя
Здесь нам понадобится две основные функции. Функция get_songdata
позволит нам извлечь из строки таблицы на сайте информацию о песне: название и ссылку.
<- function(song){
get_songdata
<- html_elements(song, "td")
song_data
# в каждой строке есть три столбца: название песни, есть ли к ней видео-разбор и количество просмотров
names(song_data) = c('song', 'video', 'views')
# название песни
<- html_text2(song_data['song'])
name
# ссылка на текст и аккорды к песне
<- song_data['song'] |>
link html_element("a") |>
html_attr("href")
<- html_text2(song_data['views'])
views <- as.numeric(gsub(",", "", views))
views
return(tibble(title = name,
url = link,
views = views))
}
Функция get_songlist
парсит страницу исполнителя и с помощью функции выше извлекает необходимые данные и складывает в датафрейм.
<- function(link){
get_songlist
<- read_html(link) |>
my_html html_element(".artist-profile-song-list") |> #выделили таблицу с информацией о песнях
html_elements("tr") #разделили на строчки
<- my_html[-1] #убрали первую строку таблицы (названия столбцов)
my_html
<- map_df(my_html, get_songdata)
songs_df
return(songs_df)
}
Парсим страницу с текстом
Теперь необходимо пройти по собранным ссылкам и собрать данные. Для этого создадим ещё пару функций.
Функция get_songtext
выкачивает текст со страницы, дополнительно проходя семь кругов ада множество этапов очищения. Amdm достаточно беспроблемно даёт себя обкачивать, но иногда может разорваться соединение, поэтому если песня вдруг не скачалась, просто идём дальше (выборка достаточно большая, можем пожертвовать и не скачивать всё заново).
<- function(link){
get_songtext
tryCatch(
expr = {
<- read_html(link) |>
song_html html_element(".b-podbor__text")
<- song_html |>
toRemove_style html_nodes(css = "style")
<- song_html |>
toRemove_chords html_nodes("div[class='podbor__chord']")
<- song_html |>
toRemove_format html_nodes("div[class='podbor-format']")
<- song_html |>
toRemove_script html_nodes(css = "script")
# удаляем то, что может прилипнуть к тексту: аккорды и код html-страницы
map(list(toRemove_style, toRemove_chords, toRemove_format, toRemove_script), xml_remove)
<- html_text2(song_html) |>
song_text str_replace_all("(\\n)|(\\t)|( +)", " ") |> # очищаем текст от лишних символов
str_replace_all("([а-я])([А-Я])", "\\1, \\2") |> # расклеиваем склеившиеся строчки
str_remove_all("(\\[.+?\\])|Вступление|Куплет|Припев|Интро|Проигрыш|Бридж|([a-zA-Z]+)") # дополнительно убираем слова, не входящие в текст песни
return(song_text)
},
error = function(e){
print("Не смог скачать песню :(")
return(" ")
}
) }
И наконец наша главная функция: get_data
принимает список песен, удаляет все дубликаты (так как это разборы аккордов, то для одной и той же песни может быть масса “дублей” с разными вариантами аккордов, нам нужно от них избавиться), извлекает все тексты и аннотирует их при помощи udpipe.
<- function(songs_df){
get_data
<- songs_df |>
songs_df mutate(title = tolower(title)) |>
mutate(title = str_replace_all(title, "ё", "е")) |>
mutate(title = str_replace_all(title, " ?\\(.+\\)", "")) |>
arrange(-views) |>
distinct(title, .keep_all = TRUE)
<- songs_df |>
songs_df_texts mutate(text = map(url, get_songtext)) |>
mutate(text = as.character(text))
# аннотируем
<- udpipe_annotate(syntagrus,
songs_annotate $text,
songs_df_texts$title)
songs_df_texts<- as_tibble(songs_annotate)
pos_data
return(pos_data)
}
Применим же все эти функции на практике! Мы скачаем песни групп Аквариум, Сплин, Пилот и ДДТ. Выбор групп был произведен по таким признакам: нам нужны исполнители одного и того же жанра и примерно одного поколения, чтобы их популярные песни тоже могли бы быть похожи. Все представленные исполнители, кроме ДДТ, из Петербурга, интересно, повлияет ли это. Группа ДДТ была выбрана по той причине, что мне всегда казалось, что она похожа на группу Пилот, и интересно, подтвердится ли это.
```{r}
ddt_df <- get_songlist("https://amdm.ru/akkordi/ddt/") |>
get_data()
pilot_df <- get_songlist("https://amdm.ru/akkordi/pilot/") |>
get_data()
akvarium_df <- get_songlist("https://amdm.ru/akkordi/akvarium/") |>
get_data()
splin_df <- get_songlist("https://amdm.ru/akkordi/splin/") |>
get_data()
save(ddt_df, file = "ddt_df.RData")
save(pilot_df, file = "pilot_df.RData")
save(akvarium_df, file = "akvarium_df.RData")
save(splin_df, file = "splin_df.RData")
```
Или же можем загрузить скачанные загодя данные, чтобы не ждать ещё раз.
load(file="ddt_df.RData")
load(file="pilot_df.RData")
load(file="akvarium_df.RData")
load(file="splin_df.RData")
Пример данных:
Подготавливаем данные
Необходимо подготовить данные к дальнейшей работе. Функция prepare_df
оставляет только основные значимые части речи (существительные, глаголы, прилагательные, наречия), фильтрует мусор и стопслова, убирает редкие (меньше 10 вхождений) леммы, пишет в начале документа название группы, чтобы было легче ориентироваться, когда будем сравнивать документы между собой.
<- function(band_df, band){
prepare_df
<- band_df |>
band_df select(doc_id, token, lemma, upos) |>
filter(upos %in% c("VERB", "ADJ", "NOUN", "ADV")) |>
filter(str_detect(lemma, "^\\w+$")) |>
filter(!lemma %in% stopwords('ru')) |>
select(doc_id, lemma) |>
add_count(lemma) |>
filter(n > 10) |>
select(-n) |>
count(lemma, doc_id) |>
mutate(doc_id = str_glue("{band}_{doc_id}"))
}
Применяем и объединяем все данные в один датасет.
<- prepare_df(ddt_df, "ddt")
ddt_df <- prepare_df(pilot_df, "pilot")
pilot_df <- prepare_df(akvarium_df, "akvarium")
akvarium_df <- prepare_df(splin_df, "splin")
splin_df
<- bind_rows(ddt_df, pilot_df, akvarium_df, splin_df) bands_df
Вычисляем tf-idf:
<- bands_df |>
bands_tf_idf bind_tf_idf(lemma, doc_id, n) |>
arrange(tf_idf) |>
select(-n, -tf, -idf)
Сейчас наши данные выглядят так:
::datatable(head(bands_tf_idf, n = 20)) DT
LSA
Создаём LSA-модель.
<- bands_tf_idf |>
dtm cast_sparse(lemma, doc_id, tf_idf)
<- 50
k set.seed(20122024)
<- irlba(dtm, nv = k, maxit = 500)
lsa_space
rownames(lsa_space$v) <- colnames(dtm)
colnames(lsa_space$v) <- paste0("dim", 1:k)
Пространство документов:
<- lsa_space$v |>
doc_emb as.data.frame()
Подсчёт расстояния между документами (будем использовать евклидово расстояние)
<- doc_emb |>
dist_mx ::distance(method = "euclidean", use.row.names = TRUE) philentropy
<- function(dist_mx, doc, number = 10) {
nearest_doc sort(dist_mx[doc, ], decreasing = FALSE) |>
head(number) |>
names()
}
Анализ результатов
Проверим ближайших соседей у самых популярных песен:
ДДТ - Что такое осень
nearest_doc(dist_mx, "ddt_что такое осень")
[1] "ddt_что такое осень" "ddt_осень"
[3] "ddt_в последнюю осень" "ddt_последняя осень"
[5] "ddt_осень - мертвые дожди" "splin_сын"
[7] "akvarium_моллой пришел" "ddt_за тобой пришли"
[9] "splin_кит" "pilot_голова-фонарь"
Видимо, у них действительно хорош получается писать песни про осень :))
Посмотрим на другую популярную песню того же исполнителя
ДДТ - Просвистела
nearest_doc(dist_mx, "ddt_просвистела")
[1] "ddt_просвистела"
[2] "pilot_гурта"
[3] "pilot_кошки пустынь"
[4] "ddt_бродяга"
[5] "pilot_безмятежность"
[6] "ddt_дай хоть на секунду испытать святую милость"
[7] "ddt_вальс"
[8] "pilot_встретились на счастье"
[9] "pilot_по мостовой"
[10] "akvarium_блюз для кита"
На этот раз аж две самых близких песни принадлежат другому исполнителю! Это больше похоже на изначальную гипотезу, продолжим проверять.
Популярная песня группы Сплин - Выхода нет
nearest_doc(dist_mx, "splin_выхода нет")
[1] "splin_выхода нет" "splin_дверной глазок"
[3] "ddt_родившимся этой ночью" "ddt_в хрупкой суете"
[5] "ddt_белый поезд" "splin_гимн"
[7] "splin_винсент" "ddt_падал мертвый дождь"
[9] "ddt_дрон" "ddt_последний адам"
Интересно, что помимо других песен Сплина встречаются исключительно песни ДДТ. Но их здесь примерно поровну (причём среди близких песен много непопулярного, что тоже не совсем соответствует нашей гипотезе)
Проверим на следующем исполнителе:
Аквариум - Город Золотой
nearest_doc(dist_mx, "akvarium_город золотой")
[1] "akvarium_город золотой" "akvarium_город"
[3] "akvarium_альтернатива" "akvarium_вятка - сан-франциско"
[5] "akvarium_25 к 10" "pilot_в аду"
[7] "akvarium_4d" "akvarium_центр циклона"
[9] "pilot_снайпер" "ddt_звезда"
Опять наблюдаем практически полную монополию исполнителя искомой песни.
Перейдём к последнему исполнителю.
Пилот - Шнурок
nearest_doc(dist_mx, "pilot_шнурок")
[1] "pilot_шнурок" "pilot_небо"
[3] "ddt_черно-белые танцы" "pilot_100 000 номеров"
[5] "pilot_100 000 номеров квартир" "splin_кофейня"
[7] "ddt_в раю одиноко" "pilot_роза ветров"
[9] "pilot_ершалаим" "pilot_учитель"
Тоже большинство похожих песен принадлежат тому же исполнителю.
Кстати, проверим, похожа ли его песня “Осень” на песни про осень ДДТ!
Пилот - Осень
nearest_doc(dist_mx, "pilot_осень")
[1] "pilot_осень" "pilot_просто новая песня"
[3] "ddt_когда един" "ddt_хич"
[5] "ddt_эх, распущу-ка я волосы" "ddt_ленинград"
[7] "akvarium_дитя рассвета" "akvarium_из сияющей пустоты"
[9] "ddt_антонина обернулась" "pilot_сестренка лето"
Не похожа совсем! Видимо, они очень по-разному представляют себе осень :)
Но можно заметить, что для этой песни наоборот мало песен того же исполнителя.
Для непопулярных песен я тоже просмотрела различные примеры и в каждом из них можно найти свою логику, но общей закономерности не наблюдается.
Попробуем визуализировать:
set.seed(20122024)
<- umap(lsa_space$v , n_neighbors = 15, n_threads = 2) viz_lsa
tibble(doc = rownames(viz_lsa),
V1 = viz_lsa[, 1],
V2 = viz_lsa[, 2]) |>
separate(doc, c("band", "title"), sep = "_") |>
ggplot(aes(x = V1, y = V2, label = title, color = band)) +
geom_text(size = 2, alpha = 0.8, position = position_jitter(width = 1.5, height = 1.5)) +
theme_light()
Визуализация тоже ожидаемо не радует. Эх.
Выводы
Итак, никакой закономерности обнаружить не удалось. С чем это может быть связано?
- Популярность песни - очень сложное понятие, и точно складывается не только из текста, но и из музыки, продвижения и т.д.
- Видимо, сигнал “эпохи” всё-таки сильнее: для многих песен среди похожих на них абсолютно разные по популярности и исполнителям песни, так что возможно, у всех этих исполнителей есть некоторый “общий код”. В целом, они с таким расчётом и выбирались (так как у кардинально разных исполнителей скорее всего и слова бы слишком различались), но теперь, конечно, постфактум хочется добавить к сравнению какого-то совершенно другого исполнителя, чтобы посмотреть, проявится ли разница хотя бы здесь.
- Возможно, используемый метод всё-таки не вполне соответствует исследовательской задаче.
Однако некотоыре выводы сделать можно: - Популярные песни (по крайней мере, в жанре русского рока примерно 1990х-2000х) не ограничиваются каким-то узким кругом тем - Интересно, что алгоритм хорошо увидел песни одного исполнителя на одну и ту же тему (5 песен ДДТ про осень оказались близко), но при этом, видимо, у разных исполнителей разное видение одной и той же темы. Интересно было бы подробнее сравнить песни на одну и ту же тему у разных исполнителей и посмотреть, какие кластеры они образуют