В этот раз задачей данной работы был анализ сушествующих тем в рецензиях на романтическую и боевую мангу. Необходимо было провести тематическое моделирование коллекции текстов, проинтерпретировать получившиеся темы и проверить, есть ли темы, которые неравномерно распределены в двух классах текстов, выделенных внутри коллекции рецензий на мангу.
В качестве данных я загружаю рецензии на мангу и манхву с сайта Readmanga.ru. В данных у меня находятся рецензии на манги двух жанров - боевик и романтика. Всего наблюдений получилось 1626: 1199 рецензий на романтическую мангу и 427 на боевую. Дополнительного деления текстов не проводилась, за единицы анализа были приняты исходные документы. Единственное, что было сделано с данными - это удаление тех рецензий, число слов в которых было меньше 50 или больше 1000. При токенизации рецензий и после удаления стоп-слов в наблюдениях осталось 276860 слов. Этого количества достаточно для создания тематической модели и для того, чтобы она получилась не бесмыссленной. В качестве метода построения модели я выбрала LDA.
Перемнные внутри датасетов:
options(java.parameters = "-Xmx1g")
library(rJava)
library(mallet)
library(dplyr)
library(readr)
library(tidyverse)
library(stringr)
library(tidytext)
library(stopwords)
library(tidyr)
library(textclean)
library(tm)
library(textmineR)
library(DT)
library(LDAvis)
library(servr)
# Загружаю данные
fight <- read_csv("~/Documents/КМАТ/Лабораторная 1/fight.csv")
romance <- read_csv("~/Documents/КМАТ/Лабораторная 1/romance.csv")
fight = fight[,-1]
romance = romance[,-1]
reviews = full_join(fight,romance)
reviews$review = str_replace_all(reviews$review, '\r', '')
russtopword = data.frame(words = c(stopwords::stopwords("ru"), "это", "в", "с", "и", "который", "свой", "весь", "хотя", "вообще", "т д", "ох", "очень", "просто", "ага", "аля", "ах", "ай", "эм"), stringsAsFactors = FALSE)
textcleaner <- function(x){
x$review = str_trim(x$review)
document_length <- sapply(strsplit(x$review, " "), length)
x = x %>% slice(which(document_length > 50)) %>% slice(which(document_length < 1000)) %>% mutate(id = row_number()) %>% unnest_tokens(word,lem) %>%
dplyr::filter(!word %in% russtopword$words) %>%
filter(!str_detect(word, '[[:punct:]]+')) %>%
filter(!str_detect(word, '[[:digit:]]')) %>%
filter(!str_detect(word, "[a-z]")) %>%
filter(!str_detect(word, "[^\\s]*[0-9][^\\s]*")) %>%
filter(str_length(word) > 2)
}
# Датасет для поиска оптимального числа топиков
reviews_words <- textcleaner(reviews)
# Датасеты для финальной модели
reviews1 = reviews_words %>%
group_by(id) %>%
mutate(text = paste0(word, collapse = " ")) %>% dplyr::select(id, title, review, genre1, text) %>% unique()
В первую очередь было необходимо определиться с оптимальным количеством тем для модели. В описании к лаборотной работе, а также на других изученных мною сайтах, все советовали исходить из обычной эвристики и оценки модели “на глаз”. То есть, надо разумно подойти к тому какое количество тем будет оптимальным для моего числа документов. Всего в моем датасе представлены рецензии на 707 манг и манхв. Однако, только на 282 произведения написано больше 2-х отзывов, больше 5 рецензий на 65 манг, а больше 10 рецензий написано только на 26 манг. На этом этапе я предаположила, что оптимальное число тем могло бы быть как раз в диапазоне от 25 до 65 тем.
# Смотрю на какое количество манг были написаны рецензии
reviews %>% group_by(title) %>% dplyr::summarise(n = n()) %>% filter(n>=5) %>% inner_join(reviews, by = "title") %>% arrange(-n) %>% select(title, genre1, n) %>% unique() %>% datatable(colnames = c('Название' = 2, 'Жанр' = 3, 'Кол-во рецензий' = 4), options = list(pageLength=10, scrollX='400px', scrollY='400px'))
Также, я изучила некоторую информацию и нашла код, который якобы позволяет найти с помощью показателя согласованности (coherence) оптимальное число тем. Я решила изучить этот код и постараться с его помощью также посмотреть на оптимальное число моделей. Я взяла диапазон от 5 до 50 с разрывом в 5 значений. Таким образом, LDA строил модели с количеством тем равным 5, 10, 15, 20…50. В ходе прогонки модели и установки set.seed, получился график, который указывает, что наибольшая согласованность наблюдается у модели с 30-ю темами.
# reviews.dtm = reviews_words %>% dplyr::count(id, word) %>% cast_dtm(id, word, n)
#
# dtm_lda <- Matrix::Matrix(as.matrix(reviews.dtm), sparse = T)
# k_list <- seq(5, 50, by = 5)
# set.seed(1234)
# model_list <- TmParallelApply(X = k_list, FUN = function(k){
# set.seed(1234)
# m <- FitLdaModel(dtm = dtm_lda,
# k = k,
# iterations = 200,
# burnin = 180,
# calc_coherence = TRUE)
#
# m <- mean(m$coherence)
#
# return(m)
# },
# cpus = 4
# )
#
# iter_k <- data.frame(
# k = k_list,
# coherence = model_list %>% unlist()
# )
#write.csv(iter_k, "~/Documents/КМАТ/iter_k30.csv")
iter_k = read.csv("~/Documents/КМАТ/iter_k30.csv")
iter_k %>% as.data.frame() %>% arrange(-coherence) %>%
mutate(max_k = head(k,1)) %>%
ggplot(aes(k, coherence)) +
geom_vline(aes(xintercept = max_k), alpha = 0.5, lty = "dashed") +
geom_line(color = "skyblue4") +
geom_point() +
scale_x_continuous(breaks = seq(0, 50, 5)) +
labs(x = "Number of Topics", y = "Coherence", title = "Coherence Score over Number of Topics") +
theme_minimal() +
theme(panel.grid.minor = element_blank())
Конечно, я проверила разные варианты моделей эмперическим путем, перебрав разные значения при построении и оценивая их качество и ясность топиков. Действительно, хорошие модели начали получаться только после 20-25 тем. При попытке поставить число тем больше 30 результаты не сильно отличались, просто выделялись дополнительные новые темы, через которые можно было понять, что топик относится к конкретной манге или манхве. В случае с 30 топикам некоторые из них включали в себя как бы слова из рецензий к нескольким мангам, но так даже интереснее, так как манги можно было разобрать, а вот почему в них был большой процент какого-то топика - это уже другой, но не менее интересный вопрос! В итоге, я решила оставить модель на 30 тем, так как она была самой адекватной и описываемой.
Наконец-то самая красочная часть отчета: визуализация выбранной модели на 30 тем. Визуализация производилась с помощью пакета mallet. Полученная визуализация представляет общий вид тематической модели. Круги - это темы, где размер круга - это общая распространенность темы (т. е. 1 топик самый распространенный). Центры каждой темы определяются путем вычисления расстояния между ними. РС1 указывает на поперечную ось, а РС2 - на продольную ось. Как я понимаю PC1 и PC2 - это некие сущности, компоненты, которые появляются при свертывании многомерной плоскости в двумерное пространство. Если темы расположены рядом, или находятся в одной плоскости, то они якобы должны быть похожи. Однако это достаточно сложно оценить при таком первичном поверхностном анализе, учитывая тот факт, что большое скопление небольших по значимости для всего датасета тем, находится примерно в одном месте, но при этом они не похожи на друг друга.
# doc.length <- str_count(reviews1$review, boundary("word"))
# doc.length[doc.length==0] <- 0.000001 # avoid division by zero
# json <- createJSON(phi = topic.words, theta=doc.topics, doc.length=doc.length, vocab=vocabulary, term.frequency=word.freqs$term.freq)
# serVis(json, out.dir="lda50", open.browser=TRUE)
A caption
При описании тем и их анализа, я столкнулась с одной проблемой: номера тем с визуализации не совпадали с номерами темам из финального датасета. Позже, я обнаружила, что темы в модели визуаилизированной с помощью LDAvis нумеруются исходя из их значимости. Таким образом, тема 1 на рисунке была в моем документе 13-ей темой, также было со всеми остальными темами. Так как мне хотелось, чтобы темы совпадали, я пыталась придумать как это можно организовать с помощью кода. Однако мои попытки не увенчались успехом, так как самые первые темы может и совпадали, но дальше начиналась какая-то путаница после где-то 10-го топика. Поэтому пришлось вручную прописывать темы.
Также я создала две таблицы: в одной указаны топики, топ-слова для каждого из них и выведены в сокращенном виде первые 10 документов, в которых топик больше всего представлен.
table_topic = function(doc.topics, x, data, c, topic.model, topic.words){
a = doc.topics %>% as.data.frame() %>% mutate(id = row_number())
a = a[,c(x,31)]
a = data %>% inner_join(a, by = c("id" = "id")) %>% dplyr::select(-text)
a = a %>% mutate(topic = c) %>% dplyr::rename(value = colnames(a[,5]))
top <- paste(mallet.top.words(topic.model, topic.words[x,], 10)$words,collapse=", ")
a = a %>% mutate(topic_words = top)
a = a %>% dplyr::select(topic, topic_words, genre1, title, review, value, id)
}
V1 = table_topic(doc.topics, 1, reviews1, "V1", topic.model, topic.words)
V2 = table_topic(doc.topics, 2, reviews1, "V2", topic.model, topic.words)
V3 = table_topic(doc.topics, 3, reviews1, "V3", topic.model, topic.words)
V4 = table_topic(doc.topics, 4, reviews1, "V4", topic.model, topic.words)
V5 = table_topic(doc.topics, 5, reviews1, "V5", topic.model, topic.words)
V6 = table_topic(doc.topics, 6, reviews1, "V6", topic.model, topic.words)
V7 = table_topic(doc.topics, 7, reviews1, "V7", topic.model, topic.words)
V8 = table_topic(doc.topics, 8, reviews1, "V8", topic.model, topic.words)
V9 = table_topic(doc.topics, 9, reviews1, "V9", topic.model, topic.words)
V10 = table_topic(doc.topics, 10, reviews1, "V10", topic.model, topic.words)
V11 = table_topic(doc.topics, 11, reviews1, "V11", topic.model, topic.words)
V12 = table_topic(doc.topics, 12, reviews1, "V12", topic.model, topic.words)
V13 = table_topic(doc.topics, 13, reviews1, "V13", topic.model, topic.words)
V14 = table_topic(doc.topics, 14, reviews1, "V14", topic.model, topic.words)
V15 = table_topic(doc.topics, 15, reviews1, "V15", topic.model, topic.words)
V16 = table_topic(doc.topics, 16, reviews1, "V16", topic.model, topic.words)
V17 = table_topic(doc.topics, 17, reviews1, "V17", topic.model, topic.words)
V18 = table_topic(doc.topics, 18, reviews1, "V18", topic.model, topic.words)
V19 = table_topic(doc.topics, 19, reviews1, "V19", topic.model, topic.words)
V20 = table_topic(doc.topics, 20, reviews1, "V20", topic.model, topic.words)
V21 = table_topic(doc.topics, 21, reviews1, "V21", topic.model, topic.words)
V22 = table_topic(doc.topics, 22, reviews1, "V22", topic.model, topic.words)
V23 = table_topic(doc.topics, 23, reviews1, "V23", topic.model, topic.words)
V24 = table_topic(doc.topics, 24, reviews1, "V24", topic.model, topic.words)
V25 = table_topic(doc.topics, 25, reviews1, "V25", topic.model, topic.words)
V26 = table_topic(doc.topics, 26, reviews1, "V26", topic.model, topic.words)
V27 = table_topic(doc.topics, 27, reviews1, "V27", topic.model, topic.words)
V28 = table_topic(doc.topics, 28, reviews1, "V28", topic.model, topic.words)
V29 = table_topic(doc.topics, 29, reviews1, "V29", topic.model, topic.words)
V30 = table_topic(doc.topics, 30, reviews1, "V30", topic.model, topic.words)
full = rbind(V1, V2, V3, V4, V5, V6, V7, V8, V9, V10, V11, V12, V13, V14, V15, V16, V17, V18, V19, V20, V21, V22, V23, V24, V25, V26, V27, V28, V29, V30)
full$topic = as.factor(full$topic)
full$title = as.factor(full$title)
full$genre1 = as.factor(full$genre1)
full$topic = gsub("V13", "Топик 1", full$topic)
full$topic = gsub("V30", "Топик 3", full$topic)
full$topic = gsub("V25", "Топик 4", full$topic)
full$topic = gsub("V23", "Топик 6", full$topic)
full$topic = gsub("V14", "Топик 11", full$topic)
full$topic = gsub("V27", "Топик 14", full$topic)
full$topic = gsub("V18", "Топик 15", full$topic)
full$topic = gsub("V12", "Топик 17", full$topic)
full$topic = gsub("V24", "Топик 18", full$topic)
full$topic = gsub("V29", "Топик 19", full$topic)
full$topic = gsub("V19", "Топик 20", full$topic)
full$topic = gsub("V28", "Топик 21", full$topic)
full$topic = gsub("V10", "Топик 22", full$topic)
full$topic = gsub("V15", "Топик 23", full$topic)
full$topic = gsub("V26", "Топик 24", full$topic)
full$topic = gsub("V21", "Топик 25", full$topic)
full$topic = gsub("V22", "Топик 26", full$topic)
full$topic = gsub("V16", "Топик 27", full$topic)
full$topic = gsub("V20", "Топик 28", full$topic)
full$topic = gsub("V11", "Топик 29", full$topic)
full$topic = gsub("V17", "Топик 30", full$topic)
full$topic = gsub("V8", "Топик 2", full$topic)
full$topic = gsub("V3", "Топик 7", full$topic)
full$topic = gsub("V4", "Топик 8", full$topic)
full$topic = gsub("V5", "Топик 9", full$topic)
full$topic = gsub("V6", "Топик 10", full$topic)
full$topic = gsub("V9", "Топик 12", full$topic)
full$topic = gsub("V7", "Топик 13", full$topic)
full$topic = gsub("V2", "Топик 16", full$topic)
full$topic = gsub("V1", "Топик 5", full$topic)
full$topic = as.factor(full$topic)
full$review = ifelse(nchar(full$review) > 403, paste0(substring(full$review, 1, 400), "..."), full$review)
full %>% as.data.frame() %>% arrange(desc(value)) %>% group_by(topic) %>% slice(1:10) %>% dplyr::select(-id, -value) %>% datatable(colnames = c('Номер топика' = 2, 'Топ слова' = 3, 'Жанр' = 4, 'Название' = 5,'Текст рецензии' = 6), filter = 'top', options = list(pageLength=10, scrollX='400px', scrollY='350px'))
Для оценки того, какой топик преобладает в каком жанре я составила таблицу, в которой указан вес топика относительно всех топиков, а также вес топика в жанре. Делала я это следующим образом: 1. Задала условие, что если вероятность нахождения топика в документе больше или равно 0.1 записать это как 1, и если меньше 0.1, то заменить на 0. 2. После чего я посчитала общую абстрактную сумму по всем топикам 3. Высчитала сумму для каждого топика 4. Высчитала сумму для каждого топика и жанра в нем 5. Поделила переменные из 3 и 4 пункта на общую сумму по всем топикам и умножила на 100.
full$value[full$value >= 0.1] = 1
full$value[full$value < 0.1] = 0
full %>% as.data.frame() %>% select(-id) %>% mutate(sum_all = sum(value)) %>% group_by(topic) %>% mutate(sum_topic = sum(value)) %>% group_by(topic, genre1) %>% mutate(sum_topic_genre = sum(value)) %>% select(topic, genre1, sum_all, sum_topic, sum_topic_genre) %>% unique() %>% mutate(imp_topic = round((sum_topic/sum_all)*100,2), imp_genre = round((sum_topic_genre/sum_all)*100,2)) %>% select(topic, genre1, imp_topic, imp_genre) %>% datatable(colnames = c('Топик' = 2, 'Жанр' = 3, 'Вес топика %' = 4, 'Вес топика в жанре %' = 5), filter = 'top', options = list(pageLength=10, scrollX='400px', scrollY='400px'))
После проведенного анализа у меня получиличь следцющие выводы касательно каждого топика: