Итоговый проект
Группа N24
Предобработка и загрузка данных
load("books_g_6.RData")
load("reviews_g_6.RData")
library(igraph)
library(recommenderlab)
library(data.table)
library(dplyr)
library(tidyr)
library(ggplot2)
library(stringr)
library(DT)
library(knitr)
library(grid)
library(gridExtra)
library(corrplot)
library(tidyverse)
library(ggpubr)
library(coin)
library(tidygraph)
library(tidytext)
library(tidytext) # обработка текста
library(ggplot2) # графики
library(tidyr) # переформатирование таблиц (длинный - широкий формат, например)
library(stringr) # обработка строк (удаление, поиск, замена символов)
library(dplyr) # преобразование данных
library(LDAvis) # визуализация LDA
library(topicmodels)
library(kableExtra)
library(skimr)
goodread_comics$num_pages = as.numeric(goodread_comics$num_pages)
goodread_comics$average_rating = as.numeric(goodread_comics$average_rating)
goodread_comics$ratings_count = as.numeric(goodread_comics$ratings_count)
goodread_comics$publication_year = as.numeric(goodread_comics$publication_year)
goodread_comics$series = as.numeric(goodread_comics$series)
joined_df = goodread_comics %>% inner_join(goodread_reviews)
goodread_comics = goodread_comics %>% mutate(series = str_extract(title,'[[:digit:]]+'))
goodread_comics = goodread_comics %>% mutate(tseries = case_when(!is.na(series)~'yes', T~'no'))
goodread_comics$tseries = as.factor(goodread_comics$tseries)Разведывательный анализ
На данном этапе работы были сделаны:
(отvетим плюсом те части анализа, которые были использованы при построении рекомендательных систем, а дпльше опишем всю процедуру в соответствующих частях отчёта)
Анализ распрелелений (+)
Корреляционный анализ (+)
Сеть 1
Сеть 2 (+)
Sentiment Analysis
Частотности биграмм и слов
Анализ PMI для биграмм
Анализ тональности по готовым словарям (+)
Цель: Выявление закономерностей в данных, который были использованы при построении систем content-based и collaborative filtering.
Конечно, не все гипотезы оправдали надежды, но были выявлены интересные факты почти в каждой части разведывательного анализа.
Количественные распределения
Мы решили обратить особенное внимание на переменные, которые являются типичными для данного датасета, в частности, на распределение комиксов на печатные и электронные издания.
Не трудно заметить, что абсолютное большинство комиксов печатные
goodread_comics %>%
ggplot(aes(x = is_ebook)) + geom_bar(fill = "cadetblue3", color = "grey20") +ggtitle('Распределение электронный и печатных изданий') %>% labs(x = 'Электронная книга',y = 'Количество')
Рассмотрим, есть ли содержательная закономерность в распределении электронных книг в зависимости от года.
goodread_comics %>%
ggplot(aes(x = publication_year, width=10, fill=is_ebook)) +
geom_bar(stat = "count") +
ggtitle("Распределение выпуска книг по годам") +coord_flip()+labs(y = 'Количество книг', x ='Год публикации')
Как мы видим из графика, изображенного выше, электронные издания наблюдаются без какой-ли закономерности. Однако мы можем отметить, что достаточно большое количество комиксов электронного формата занесены в датасет без указания года издания.
Важным фактором при выборе литературы является язык написания. Из данного распределения количеств книг, написанных на различных языках, можно заметить, что более 2/3 всех книг написаны на английском языке.
goodread_comics %>% count(language_code) %>% ggplot(aes(reorder(language_code, n), n)) + geom_bar(stat='identity', fill = "cadetblue3", color = "grey20") + coord_flip()+ guides(fill = FALSE)+ggtitle('Распредение комиксов по языку')+labs(y = 'Количество книг', x ='Язык комикса')
Давайте посмотрим, есть ли разлчичия в средних рейтингах книг, написанных на разных языках:
Во-первых, сделаем это с помощью аналога теста ANOVA для неномрально распределенных выборок - тест Краскела-Уоллиса. Заметим, что различия значимы по двум выборкам(joined_df, goodread_comics)
kruskal_test(average_rating~as.factor(language_code), data = goodread_comics)##
## Asymptotic Kruskal-Wallis Test
##
## data: average_rating by
## as.factor(language_code) (, ara, cze, en-CA, en-GB, en-US, eng, fre, ind, ita, jpn, spa)
## chi-squared = 41.557, df = 11, p-value = 1.932e-05kruskal_test(rating~as.factor(language_code), data = joined_df)##
## Asymptotic Kruskal-Wallis Test
##
## data: rating by
## as.factor(language_code) (, ara, cze, en-CA, en-GB, en-US, eng, fre, ind, ita, jpn, spa)
## chi-squared = 137.16, df = 11, p-value < 2.2e-16Во-вторых, построим ящичковую диаграмму для того, чтобы посмотреть на то, в какую сторону наблюдаются эти различия
- Можем заметить, что комиксы, написанные на японском языке в своих масштабах ценятся выше, нежели те, что на различных английских языках, а остальные языки (именно арабский, итальянский, чешский) не очень популярны в данной нам выборке, и ящики не показывают нам достаточно информации по причине малого количества наблюдений.
ggplot(data = goodread_comics)+geom_boxplot(mapping = aes(x = as.factor(language_code), y=as.numeric(average_rating)), na.rm =T) + labs(title = "Соотношение различных языков и средний рейтингов комиксов в группе", y = "Язык издания", x = "Рейтинг") + theme_bw() + theme(text = element_text(size=10), axis.text.x = element_text(angle=40, hjust=1), plot.background = element_rect())
Следующим шагом мы решили рассмотреть распределение оценок пользователей для фильмов на основании датасета с их отзывами. В нашем случае, оценки наиболее всего напоминают хи-квадрат распределение со скошенностью влево. Из этого мы можем сделать вывод, что в отзывах преобладают положительные оценки. Причем, наблюдаются крайне небольшое количество оценок 1-2. По нашему преположению, это может быть связано с тем фактом, что люди склонны отмечать в не слишком понравившемся комиксе его положительные стороны, а оценкой 0-1 награждать только те комиксы, которые им не понравились в корне.
goodread_reviews %>%
ggplot(aes(x = rating)) +
geom_bar(fill = "cadetblue3", color = "grey20") + scale_fill_brewer(palette = "YlGnBu") + guides(fill = FALSE) + geom_density(adjust = 1, colour = '#cc99ff', alpha = 0.5)+ggtitle('Распределение пользовательских оценок')+labs(x = 'Оценка', y ='Количество оценок')
Естественно, имеет смысл посмотреть на то, распределение количеств отзывов пользователей. Для начала мы решили посмотреть, какой процент пользователей оставил 1-2 отзыва.
a = goodread_reviews %>% group_by(user_id) %>% mutate(n = n())
a$n %>% summary()## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 1.00 3.00 8.21 8.00 116.00nrow(a%>% filter(n<=2))/nrow(a) #то есть половина датасета состоит из тех, кто оценил 1 или 2 книги -- наверное не можем удалить их ## [1] 0.4720932К нашему удивлению оказалось, что такие пользователи составляют более 47% от всех людей, поставивших оценку. Сейчас речь идет о goodread_reviews. Изначально мы хотели удалить таковых пользователей, так как для них не будет работать user-based коллаборативная система рекомендаций. Однако пока что мы их оставим, но будем иметь в виду данный факт.
Посмотрим также на вcю картину распределения, исключив из нее юзеров, поставивших меньше 3 отзывов. (Об их количестве в общей массе мы и так знаем достаточно).
Как видно из графика ниже, наблюдается достаточно мало пользователей, поставивших больше 15 оценок. Однако наблюдаются “комиксоманы”, которые поставили более 40 оценок. Рекордсменом в данном высчтупил пользователь, поставивший 116 оценок
nums = goodread_reviews %>%
group_by(user_id) %>%
summarize(number_of_ratings_per_user = n())
nums%>% filter(number_of_ratings_per_user > 2)%>%
ggplot(aes(number_of_ratings_per_user)) +
geom_bar(fill = "cadetblue3", color = "grey20")+coord_cartesian(c(1, 50))+ggtitle('Распределение пользователей по количеству отзывов \n (для пользователей с более чем 2 отзывами)')+labs(x = 'Количество отзывов каждого пользователя', y ='Количество пользователей')
Построив график распределения оценок к одной книге, можем заметить, что в данной выборке нет книг, которые были оценены более чем 50 раз. В генеральной совокупонсти (стобец ratings_count),очевидно, большие значениям, но мы работает с выборкой и по этой причине решил рассмотреть именно данное распрделение.
goodread_reviews %>%
group_by(book_id) %>%
summarize(number_of_ratings_per_book = n()) %>%
ggplot(aes(number_of_ratings_per_book)) +
geom_bar(fill = "cadetblue3", color = "grey20", width = 1)+ggtitle('Распределение количества отзывов на комикс')+labs(x = 'Количество оценок на книгу', y ='Количество книг')
Корреляционный анализ
На данном этапе работы, мы хотим определить те количественные переменные, которые каким-то образом влияют на средний рейтинг комиксов, и отобрать их при построении content-based системы. Очевидно, не все переменные будут включены в систему, что мы посмотрим ниже.
Для получения тех графиков, что мы хотим построить нам нужна была функция для расчета корреляции (не та, что есть в готовых библиотеках). Написав данную функцию, мы перешли к анализу связей меджду средним рейтингом и переменными (ratings_count, num_pages,series).
Давайте перейдём к более детальному анализу этих переменных.
1.Связь между рейтингом и количеством оценок (на платформе goodreads)
Первое, что явно бросатается в глаза – сосредоточенность наблюдений ближе к оси ординат и выбросы, которые икажают линию регрессии и значение корреляции. По этой причине, требуется проверка значимости корреляции между этими переменными с помощью коэффициента ранговой корреляции Кендалла. В силу большого количества выбросов, что видно на графике и на квартильном разбиении данных в консоли, эта переменная была исключена из рекомендательной системы, несмотря на то, что корреляционный тест показал немного лучший чем в остальных случаях коэффициент Кендалла.
get_cor <- function(df){
m <- cor(df$x,df$y, use="pairwise.complete.obs");
eq <- substitute(italic(r) == cor, list(cor = format(m, digits = 2)))
as.character(as.expression(eq));
}
goodread_comics %>%
ggplot(aes(ratings_count, average_rating)) + scale_fill_distiller(palette = "Spectral") +stat_bin_hex(bins = 50)+ stat_smooth(method = "lm", color = "orchid", size = 2, se = FALSE) + ggplot2::annotate("text", x = 15000, y = 1.9, label = get_cor(data.frame(x = goodread_comics$ratings_count, y = goodread_comics$average_rating)), color = "orchid", size = 7, parse = TRUE)+ggtitle('Корреляция среднего рейтинга и количества оценок')+labs(x = 'Количество отзывов', y ='Средний рейтинг')
summary(as.numeric(goodread_comics$ratings_count))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 50 326 755 2541 1983 58475Можем заметить, что значение этого коэффициента равно 0,3 на уровне значимости 1%. Следовательно, можем сделать вывод о наличии слабой связи.
Вообще, похожая ситуация наблюдается во всех трёх случаях. Низкие значения коэффициент Кендалла и искаженные выбросами значения коэффициентов корреляции.
cor.test(goodread_comics$ratings_count, goodread_comics$average_rating, method = "kendall")##
## Kendall's rank correlation tau
##
## data: goodread_comics$ratings_count and goodread_comics$average_rating
## z = 10.021, p-value < 2.2e-16
## alternative hypothesis: true tau is not equal to 0
## sample estimates:
## tau
## 0.3006664- Связь между количеством страниц и средним рейтингом
Гипотезой для проверки корреляции между этими переменными стали формальные границы, существующие в реальном мире. Например, комиксы могут иметь меньше страниц чем стреднестатистические манги. Но, в данной нам выборке это слабо характеризует отдельную книгу, что привело к исключению данной переменной из рекомендательной системы.
goodread_comics %>%
ggplot(aes(num_pages, average_rating)) + scale_fill_distiller(palette = "Spectral") +stat_bin_hex(bins = 50)+ stat_smooth(method = "lm", color = "orchid", size = 2, se = FALSE) +
ggplot2::annotate("text", x = 80, y = 1.9, label = get_cor(data.frame(x = goodread_comics$num_pages, y = goodread_comics$average_rating)), color = "orchid", size = 7, parse = TRUE)+ggtitle('Корреляция среднего рейтинга и количества страниц в комиксе')+labs(x = 'Количество страниц', y ='Средний рейтинг')
Коэффициент Кендалла равен 0.18 и корреляция равная 0.27 -> очень слабая связь
cor.test(goodread_comics$num_pages, goodread_comics$average_rating, method = "kendall")##
## Kendall's rank correlation tau
##
## data: goodread_comics$num_pages and goodread_comics$average_rating
## z = 5.5865, p-value = 2.317e-08
## alternative hypothesis: true tau is not equal to 0
## sample estimates:
## tau
## 0.1799732- Связь между количеством серий и средним рейтингом
Количества страниц не были даны в исходном датасете, но мы получили эти данные самыми простыми действиями над названиями книг. Конечно, может возникнуть мысль о бессмысленности такого извлечения серий книг, но мы исходили только из данных, присутствующих в выборке, а точнее - после извлечения цифр из названий книг, была проведена небольшая фильтрация, с помощью которой мы исключили значения выше 100. Выбрали 100 методом разглядывания, т.к. выше сотни были только данные, не относящиеся к сериям, а до сотни вроде всё нормально.
Информацию о сериях мы включили в рекомендательную систему, т.к. информация может характеризовать отдельный комикс. Кроме этого, в выборке очень много (2/3 от общего числа) серийных книг.
goodread_comics$series = as.numeric(goodread_comics$series)
goodread_comics$series = ifelse(goodread_comics$series>=100,NA, goodread_comics$series)
goodread_comics %>%
ggplot(aes(series, average_rating)) + scale_fill_distiller(palette = "Spectral") +stat_bin_hex(bins = 50)+ stat_smooth(method = "lm", color = "orchid", size = 2, se = FALSE) +
ggplot2::annotate("text", x = 10, y = 1.9, label = get_cor(data.frame(x = goodread_comics$series, y = goodread_comics$average_rating)), color = "orchid", size = 7, parse = TRUE)+ggtitle('Корреляция среднего рейтинга и серийности комикса')+labs(x = 'Количество серий', y ='Средний рейтинг')
Коэффициент Кендалла равен 0.28 b корреляция равна 0.27->слабая связь
cor.test(goodread_comics$series, goodread_comics$average_rating, method = "kendall")##
## Kendall's rank correlation tau
##
## data: goodread_comics$series and goodread_comics$average_rating
## z = 6.9237, p-value = 4.4e-12
## alternative hypothesis: true tau is not equal to 0
## sample estimates:
## tau
## 0.2804373Давайте теперь посмотрим на то, как отличаются рейтинги серийных и единичных комиксов. Есть заметная разница в медианах - у серийных комиксов рейтинг в выше, но надо оценить значимость этого различия.
ggplot(data = goodread_comics)+geom_boxplot(mapping = aes(x = as.factor(tseries), y=as.numeric(average_rating)), na.rm =T) + labs(title = "", x = "Наличие томов", y = "Рейтинг") + theme_bw() + theme(text = element_text(size=10), axis.text.x = element_text(angle=40, hjust=1), plot.background = element_rect())+ggtitle("Соотношение рейтингов комиксов, состоящих из отного тома, \n и многосерийных книг")
По резульатам t-test можно сделать вывод о значимости этого различия
t.test(average_rating~tseries, goodread_comics)##
## Welch Two Sample t-test
##
## data: average_rating by tseries
## t = -5.2119, df = 295.18, p-value = 3.518e-07
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.2530962 -0.1143480
## sample estimates:
## mean in group no mean in group yes
## 3.820248 4.003971Корреляционная матрица
Суммируя всю иноформацию о корреляциях, можно посмоотреть всю нужную о корреляциях на наглядном графике с матрицей, в которой показано больше информации о коррелициях, т.к. выделены значения корреляций не только между рейтингом и переменными. но и между самими переменными, которые нас в данном случае не очень интересуют.
tmp <- goodread_comics %>%
select(one_of(c('average_rating', 'num_pages','ratings_count','publication_year','series'))) %>%
as.matrix()
corrplot(cor(tmp, use = 'pairwise.complete.obs'), type = "lower")
В матрице можно заметить отрицательную (но слабую) связь между средним рейтингом и годом выпуска. Но, исходя из коэффициента Кендалла, можно сделать вывод о наличии слабой связи. Несмотря на очень слабую связь, мы решили добавить эту переменную в рекомендательную систему, т.к. год выпуска может характериховать отдельную книгу, выпуск из какой-то серии.
cor.test(goodread_comics$publication_year, goodread_comics$average_rating, method = "kendall") #связи толком нет ##
## Kendall's rank correlation tau
##
## data: goodread_comics$publication_year and goodread_comics$average_rating
## z = -3.4262, p-value = 0.000612
## alternative hypothesis: true tau is not equal to 0
## sample estimates:
## tau
## -0.1109071Сетевой анализ
Сеть 1 (по косинусному расстоянию)
Из этой сети мы не смогли извлечь полезной информации, но мы указали причину немного ниже.
Построим первую сеть на основе косинусного расстояния по матрице оценок “realRatingMatrix”.
Принцип работы написанного кода достаточно понятен на интуитивном уровне, но стоит описать один момент:
- Т.к. мы строилии граф на adjacency matrix, нужно было получить матрицу из нулей и единиц. Так, мы присвоили единицы значениям меньшу 0,93 и нули в других случаях
data = goodread_reviews %>% select(user_id, book_id, rating)
rates = pivot_wider(data, names_from = book_id, values_from = rating)
userNames = rates$user_id
rates = select(rates, -user_id)
# преобразование таблицы данных в матрицу
rates = as.matrix(rates)
rownames(rates) = userNames
# преобразование матрицы в realRatingMatrix
r = as(rates, "realRatingMatrix")
similarity_users10 <- recommenderlab::similarity(r, method = "cosine", which = "items")
matrix.similarity = as.matrix(similarity_users10)
df.similarity = data.frame(matrix.similarity)
#очистка
df.similarity[df.similarity>=0.93] = NA
df.similarity[df.similarity<0.93] = 1
df.similarity[is.na(df.similarity)] <- 0
colnames = colnames(df.similarity)
colnames = colnames %>% str_replace_all('X','')
colnames(df.similarity) = colnames
#преобразования
matrix.similarity <- as.matrix.data.frame(df.similarity)
ggg <- graph_from_adjacency_matrix(adjmatrix = matrix.similarity, mode = "undirected") %>% igraph::simplify()
name= goodread_comics$book_id[order(match(goodread_comics$book_id,V(ggg)$name))]
name = data.frame(book_id = name)
df = name %>% left_join(goodread_comics)Подготовим параметры (сообщества, размеры вершин)
fgcommune <- fastgreedy.community(ggg)
mod = modularity(fgcommune)
size = degree(ggg)
V(ggg)$size = log(size+1)+6
names = V(ggg)$name
V(ggg)$name = ifelse((V(ggg)$size > quantile(V(ggg)$size, 0.999)),names , NA)
last_membership = membership(fgcommune)Далее, мы решили визуализировать, построенный граф с помощью методов из пакета “igraph” и параметров из предыдущего пункта.
Можем заметить, что сообществ у нас 115 - это не очень хорошо, учитывая то, что есть очень много комиксов без связей. Кроме этого, значение модулярности до 0,4 не является высоким индикатором.
Проверим значения ассортативности по различным переменным и заметим, что эти ассортативности мень 0.1 и можем сделать вывод об отсутствии склонности основания связей на основании этих переменных даже без проверки статистической значимости.
#слишком низкие значения ассортативности, нет смысла рассматривать на значимость
V(ggg)$publisher = df$publisher
assortativity_nominal(ggg, as.factor(V(ggg)$publisher), directed = F) ## [1] 0.07018977V(ggg)$language_code = df$language_code
assortativity_nominal(ggg, as.factor(V(ggg)$language_code), directed = F) ## [1] 0.02216209V(ggg)$average_rating = df$average_rating
assortativity(ggg ,V(ggg)$average_rating, directed = F) ## [1] 0.07438533Вывод по первой сети:
очень низкие значения ассортативностей (менее 10%), что указывает на очень низкую склонность к формированию связей между рассмотренными переменными.(издатель, язык, средний рейтинг на goodreads.com)
мы не смогли выявить интересных связей, которые могли стать очень важны при построении рекомендательных систем. Конкретнее, это могло бы пригодиться для построения CF систем, которые основываются на рейтинговой информации.
Сеть 2
Из этой сети была выявлена полезная для построения рекомендательных систем связь/закономерность по причине которой мы решили включить переменную publisher в рекомендательную систему CB, но подробнее увидим это немного ниже.
В прошлом домашнем задании была дана сеть с похожими переменными и даннымы, мы решили воспользоваться данными из одной из тех сетей.
Загрузили данные
Некоторыми нехитрыми преобразованиями получили общие книги проектного датасета и сети из ДЗ.(таких книг оказалось 56 штук ~10%)
load("books_net_info.RData")
c = goodread_comics %>% inner_join(books_net_info, by = 'book_id')
comics_net = read_graph("book_net.hml", format = "graphml")
compg.vertices <- as.data.frame(get.vertex.attribute(comics_net))
books_net_info$book_id = as.character(books_net_info$book_id)
compg.vertices$name = as.numeric(compg.vertices$name)
compg.vertices2 = compg.vertices %>% filter(name %in% c$book_id)
newcomics = delete_vertices(comics_net,!(V(comics_net)$name %in% compg.vertices2$name)) #сеть, основанная на 56 комиксах - это чуть больше 10%
goodread_comics_edited = compg.vertices2 %>% left_join(goodread_comics, by =c('name'='book_id'))Оставили в исходной сети только общие вершины и присвоили атрибуты из датасета goodread_comics_edited, который был построен на основе вершин сети из Дз и датасета goodread_comics с учётом последовательности book_id, как в исходном датасете goodread_comics.
Посчитали ассортативности по различным переменным, и получили самую высокую ассортативность по переменной publisher. Далее, надо будет проверить статистическую значимость этого значения ассортативности.
V(newcomics)$publisher = goodread_comics_edited$publisher
aaa = goodread_comics_edited %>% filter(!is.na(publication_year))
newcomics1 = delete_vertices(newcomics,!(V(newcomics)$name %in% aaa$name))
V(newcomics1)$pubyear = aaa$publication_year
assortativity_nominal(newcomics, as.factor(V(newcomics)$publisher), directed = F) ## [1] 0.414966#assortativity(newcomics, V(newcomics)$publication_year, directed = F)
V(newcomics)$rating = goodread_comics_edited$average_rating
assortativity(newcomics, V(newcomics)$rating, directed = F)## [1] 0.2692412V(newcomics)$count = goodread_comics_edited$ratings_count
assortativity(newcomics, V(newcomics)$count, directed = F)## [1] 0.2996325Оценка значимости
Получили p-value = 0 -> статистически значимое значение ассортативности. Это может являться индикатором важности переменной publisher при при построении рекомендательных систем.
g = newcomics
number_of_permutations = 2000
assortativity_shuffled <- rep(NA, number_of_permutations)
for(i in 1:number_of_permutations){
V(g)$attr_shuffled = sample(V(g)$publisher, replace = F)
assortativity_shuffled[i] = assortativity_nominal(g,as.factor(V(g)$attr_shuffled))
}
assortativity_real = assortativity_nominal(g, as.factor(V(g)$publisher), directed = T)
pvalue = sum(abs(assortativity_shuffled) >= abs(assortativity_real)) / number_of_permutations
pvalue## [1] 0Исходя из наблюдений ассортативности, можем сделать предположение о том, что можно построить сеть на основе издательств(publisher) для того, чтобы увидеть то, как выглядят сообщества по переменной publisher, и проверим показатели модулярности и центральности.
Преобразования
data = goodread_comics %>% select(book_id, publisher)
data$pubs_v = 1
data$publisher[data$publisher==""] <- NA
pubs = pivot_wider(data, names_from = publisher, values_from = pubs_v, values_fill = 0)
rownames = pubs$book_id
rates = select(pubs,-book_id)
rownames(rates) = rownames
ecount(ggg)## [1] 2368sim = lsa::cosine(t(as.matrix(rates)))
ggg <- graph_from_adjacency_matrix(adjmatrix = sim, mode = "undirected") %>% igraph::simplify()
size = degree(ggg)
V(ggg)$size = log(size+1)+6
names = V(ggg)$name
V(ggg)$name = ifelse((V(ggg)$size > quantile(V(ggg)$size, 0.999)),names , NA)
V(ggg)$publisher = goodread_comics$publisher
last_membership = V(ggg)$publiseher
last_membership = as.factor(goodread_comics$publisher)Нарисуем данный граф и заметим, что он состоит из подгрупп, которые непосредственно относятся к издательствам. Значение модулярности равно 0,76 что является достаточно высоким показателем для утверждения о качественности разбиения, но мы так не думаем по причине сильной зависимости этой сети только от одной переменной, что заметно завышает значение показателя модулярности.
plot(ggg, layout = layout.fruchterman.reingold, edge.arrow.size = 0,vertex.color = last_membership, vertex.frame.color = 'grey',vertex.label.color = 'black' ,margin = -0.1, )
value_cnt = tibble::enframe(last_membership) %>% count(value)
fgcommune <- fastgreedy.community(ggg)
mod = modularity(fgcommune)Посмотрим на распредление значений центральности и выявим максимальное количество связей - 74.
summary(degree(ggg))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00 2.00 28.00 30.75 65.00 74.00После сдачи черновика нашего отчета мы получили один вопрос относительно этой сети: В чем смысл построения сети по издательствам - можно просто посчитать все харакетристики, сгоруппировав по издательству?
Ответ:
Да, расчет каких-то показателей по отдельным издателям не составляет никакого труда - он даже проще построения сети. С помощью этой стети, как было отмечено немного выше, мы хотели посмотреть на структуру связей между книгами, а эта гипотеза возникла после проверки значений модулярностей по уже существующей сети из домашнего задания. Получив высокую модулярность по той сети, мы могли обойтись и без построения дополнительной сети, но не хотелось распространять наблюдение, полученное на ~10% данных на всю выборку. Именно по этой причине, мы построили сеть. В целом, исходя из всего анализа в разделе Сеть 1, мы смогли выделить важную переменную.
Сентимент-анализ
Как было отмечено выше, данный раздел состоит из трёх частей, первые две из которых не были использованы при построении сети, но имеют важную роль для подсознательного разделения плохого и хорошего.
Анализ тональностей по PMI
Хотим изучить переменную description для того, чтобы понять, как устроены описания книг - какие слова словосочетания характеризуют определенную тональность. По этой причине, сначала обработаем данные(приведём к поддающемуся к анализу виду).
enstopwords = data.frame(words=c(stopwords::stopwords("english"), NA), stringsAsFactors=FALSE)
eng_df = goodread_comics
eng_df$description = str_to_lower(eng_df$description)
eng_df$description = eng_df$description %>% str_replace_all("[:punct:]+","")
eng_df$description = eng_df$description%>% str_replace_all("[:digit:]+","") %>% str_to_lower()
eng_df$description = eng_df$description %>% str_replace_all('\n',' ')
eng_df$description=textstem::lemmatize_strings(eng_df$description, dictionary = lexicon::hash_lemmas)
reviews_tokens = eng_df %>%
unnest_tokens(words, description, token = 'ngrams', n = 2) %>% anti_join(enstopwords)
word_counts <- reviews_tokens %>%
count(book_id, words, sort = TRUE) %>% ungroup() #for LDA
reviews.bifiltered = reviews_tokens %>%
separate(words, c("word1", "word2"), sep = " ") %>%
dplyr::filter(!word1 %in% enstopwords$words) %>%
dplyr::filter(!word2 %in% enstopwords$words)
reviews.bifiltered$words <-
paste(reviews.bifiltered$word1, reviews.bifiltered$word2, sep = " ")Построим график биграмм по показателю PMI и увидим, какие словосочетания характеризуют определенные уровни тональности.
Таким образом можно выделить словосочетания age watchmens, astro city, new york time, bestselling series и т.д как характеристику положительности среди пользователей. Но, кроме этого наблюдения, можно заметить словосочетание “2 astro”, которого не должно быть в силу того, что для всей процедуры анализа текста мы удалили все цифры из описаний.
rating_df = joined_df %>% group_by(book_id) %>% summarize(avgRat = mean(rating))
goodread_comics = rating_df %>% inner_join(goodread_comics)
positive = reviews.bifiltered %>%
filter(book_id %in% goodread_comics$book_id[goodread_comics$avgRat>4]) %>%
mutate(sent = "positive")
#можно дополнительно отфильтровать по полезности отзыва (stars == 5)
negative = reviews.bifiltered %>%
filter(book_id %in% goodread_comics$book_id[goodread_comics$avgRat<3]) %>%
mutate(sent = "negative")
reviews.pmi = bind_rows(positive, negative) %>% dplyr::select(words,book_id ,sent)
reviews.pmi = reviews.pmi %>%
dplyr::count(words ,sent) %>%
pivot_wider(names_from = sent, values_from = n, values_fill = 0)
freq_p = reviews.pmi$positive
freq_n = reviews.pmi$negative
sum_p = sum(reviews.pmi$positive)
sum_n = sum(reviews.pmi$negative)
pmi_p = log((freq_p/sum_p)/((freq_p+freq_n)/(sum_p+sum_n)*sum_p/(sum_p+sum_n))+1)
reviews.pmi$PMI_p = pmi_p
pmi_n = log((freq_n/sum_n)/((freq_p+freq_n)/(sum_p+sum_n)*sum_n/(sum_p+sum_n))+1)
reviews.pmi$PMI_n = pmi_n
reviews.pmi %>%
ggplot(aes(x=log(positive+negative), y=PMI_p-PMI_n, color=5*PMI_p-PMI_n, label=words)) +
scale_color_gradient2(low="red", high="blue") +
geom_text(check_overlap = TRUE)+ggtitle('Распредение слов по метрике PMI') 
Встречаемость слов и словосочетаний
Найдем наиболее частые слова, которые попадаются в описаниях комиксов, перед этим исключив стоп-слова. Взглянем на получившиеся слова. Слова не дают особо зацепок, так как все они относятся к типичным описаниям сюжетов из комиксов.
#переводим в отдельные слова
description_tokens = eng_df %>% unnest_tokens(words, description) %>% anti_join(enstopwords)
description_word_counts <- description_tokens %>% count(book_id, words, sort = TRUE) %>% ungroup()
description_word_counts= description_word_counts %>% select(-book_id)
description_word_counts= description_word_counts %>% dplyr::count(words, sort = TRUE) %>% filter ( n > 5 & n < 100)
description_word_counts %>% top_n(10, n) %>%
kbl() %>%
kable_paper("hover", full_width = F)| words | n |
|---|---|
| take | 99 |
| series | 92 |
| now | 89 |
| story | 89 |
| first | 83 |
| good | 81 |
| comic | 80 |
| time | 78 |
| make | 71 |
| just | 70 |
Разделим часто повторяющиеся слова на две категории - те комиксы, которые получили оценку 4 и выше, и те, которые получили оценку менее 3.5. Таким образом мы четко разграничим любимчиков от тех, которые больше тянут на оценку 3. Мы получили два списка слов, однако некоторые слова попали сразу в оба списка. Выделим такие слова в отдельную группу и исключим их из конечных списков.
#резделяем слова для хороших и плохих отзывов
words_descrip_good = description_tokens %>% filter(average_rating > 3.99)
words_descrip_good = words_descrip_good %>% dplyr::count(words, sort = TRUE)
words_descrip_good = filter(words_descrip_good, n > 4)
words_descrip_bad = description_tokens %>% filter(average_rating < 3.5)
words_descrip_bad = words_descrip_bad %>% dplyr::count(words, sort = TRUE)
words_descrip_bad = filter(words_descrip_bad, n > 3)#слова которые попали в оба списка
join_bad_good_words = inner_join(words_descrip_bad,words_descrip_good, by ="words")
#уберем повторяющиеся слова
anti_words_descrip_bad= anti_join(words_descrip_bad,join_bad_good_words, by ="words" )
anti_words_descrip_good= anti_join(words_descrip_good,join_bad_good_words, by ="words" )Посмотрим на топ 15 слов по хорошим и по плохим комиксам. Из получившихся слов можем предположить,что Лига Справедливости не особо нравится людям (из-за слова Juctice, хотя возможен вариант что просто комиксы про справедливость меньше нравятся людям) , как и комиксы про аквамена,халка, женщину-кошку и инопланетян.
Высокие оценки получили комиксы со словом “york” в описании - что можно объяснить двумя способами. Возможно, журнал New York Times хорошо оценивал этот комикс, что было указано в описании. Либо же действия комикса проиходят в самом Нью-йорке. По остальным словам затруднительно сказать что-то конкретное.
top_good_words_desc <- anti_words_descrip_good %>%
top_n(15, n) %>%
ungroup() %>%
arrange(-n)
top_good_words_desc <- top_good_words_desc[-c(16,17,18,19),]
top_bad_words_desc <- anti_words_descrip_bad %>%
top_n(15, n) %>%
ungroup() %>%
arrange(-n)
top_bad_words_desc = top_bad_words_desc[-c(16,17,18,19),]
words = top_good_words_desc <- top_good_words_desc[-c(16,17,18,19),]
colnames(words) <- c("Good","Bad")
words$Bad = top_bad_words_desc$words
words %>%
kbl() %>%
kable_paper("hover", full_width = F)| Good | Bad |
|---|---|
| discover | captain |
| school | league |
| day | apocalypse |
| york | carol |
| may | horror |
| true | justice |
| help | alien |
| start | aquaman |
| thing | catwoman |
| battle | corner |
| turn | crisis |
| boy | fantastic |
| finally | hulk |
| force | mission |
| right | ringside |
Попробуем провести такой же анализ но для биграм. Возможно, он покажет что-то интересное.
#делаем биграмы с двойной фильтрацией для Описаний
description.bigrams = eng_df%>%
unnest_tokens(bigram, description, token = "ngrams", n = 2)
description.bifiltered = description.bigrams %>%
separate(bigram, c("word1", "word2"), sep = " ") %>%
dplyr::filter(!word1 %in% enstopwords$words) %>%
dplyr::filter(!word2 %in% enstopwords$words)
description.bifiltered = description.bifiltered %>% unite("bigram", word1:word2, sep = ' ' , remove = FALSE)
description.bigrams_counts = description.bifiltered %>% dplyr::count(bigram, sort = TRUE)#резделяем биграмы для хороших и плохих отзывов
bigrams_descrip_good = description.bifiltered %>% filter(average_rating > 3.99)
bigrams_descrip_good = bigrams_descrip_good %>% dplyr::count(bigram)
bigrams_descrip_good = filter(bigrams_descrip_good, n > 3)
bigrams_descrip_bad = description.bifiltered %>% filter(average_rating < 3.5)
bigrams_descrip_bad = bigrams_descrip_bad %>% dplyr::count(bigram)
bigrams_descrip_bad = filter(bigrams_descrip_bad, n > 2)
#биграмы которые попали в оба списка
join_bad_good = inner_join(bigrams_descrip_bad,bigrams_descrip_good, by ="bigram")
#уберем повторяющиеся биграмы
anti_bigrams_descrip_bad= anti_join(bigrams_descrip_bad,join_bad_good, by ="bigram" )
anti_bigrams_descrip_good= anti_join(bigrams_descrip_good,join_bad_good, by ="bigram" )Биграммы показывают, что комиксы, описания которых содержат фразы “Нью-Йорк Таймс Бестселлер” - более высоко оценены. Опять же, это не удивительно. Журнал Таймс часто делает ревью для наиболее успешных или же имеющих потенциал произведений, а возможно и освещает произведения высоко оцененные критиками. Лига Справедливости в очередной раз попала в “плохие” комиксы.Также туда попала Фантастическая Четверка, Зеленый Фонарь, Капитан Марвел, поджанр комиксов “Лавкрафтовские ужасы”, серия комиксов “Супермен/Бетмен” и другие. Также отметим, что в “хорошие” биграмы попало сочетание yes yes, что произошло из-за повторения в одном предложени слова yes несколько раз подряд.
#Топ 15 биграм по хорошим и плохим отзывам
top_good_bigrams_desc <- anti_bigrams_descrip_good %>%
top_n(10, n) %>%
ungroup() %>%
arrange(-n)
top_good_bigrams_desc <- top_good_bigrams_desc[-c(13,14,15,16),]
top_bad_bigrams_desc <- anti_bigrams_descrip_bad %>%
top_n(10, n) %>%
ungroup() %>%
arrange(-n)
bigrams = top_good_bigrams_desc %>%
top_n(10, n) %>%
ungroup() %>%
arrange(-n)
top_bad_bigrams_desc = top_bad_bigrams_desc[-c(13,14,15,16,17),]
colnames(bigrams) <- c("Good","Bad")
bigrams$Bad = top_bad_bigrams_desc$bigram
bigrams %>%
kbl() %>%
kable_paper("hover", full_width = F)| Good | Bad |
|---|---|
| new york | captain marvel |
| last man | justice league |
| york time | final crisis |
| year ago | chill tale |
| yes yes | green lantern |
| critically acclaim | collect captain |
| final volume | fantastic four |
| york timesbestselling | great hero |
| dark knight | greg pak |
| dave gibbon | lovecraftian horror |
| eisner award | superman batman |
| high school | twilight zone |
Подводя итог, мы можем заметить, что есть определенные герои и слова, которые чаще встречаются в хороших или же плохих комиксах. Тем не менее, на данном этапе анализа мы не можем быть уверены, что стоит как-то особенно работать с комиксами, где они встречаются. Также есть вариант, что эти слова и словосочетания попали случайно, например, если в каком-то плохом комиксе часто использовалось имя героя, и оно попало в самые частые биграмы/слова, хотя остальные комиксы с этим героем были довольно хороши.
Пропорциональное соотношение плохих и хороших слов
На данном этапе выделили хорошие и плохие из словаря ‘bing’, и каждому описанию присвоили пропорцию хороших слов. Выбрали именно этот словарь по той причине, что он представляет более обобщенную характеристику по тональности, и содержит больше слов, которые встречаются в нашей выборке. То есть после объединения датасетов остается большее количество наблюдений.
Переменная, полученная из исследования пропорций хороших слов является характеристикой, с помощью которой можно характеризовать отдельно взятый комикс. Будет очевидным тот факт, что в детском комиксе будет больше положительных слов, чем в каком-нибудь “Hellblazer”-е.
Есть один большой недостаток этого подхода - не все книги из выборки получили характеристику тональности, но с помощью других библиотек мы не смогли получить больше 400 оцененных наблюдений.
reviews_tokens = eng_df %>%
unnest_tokens(words, description, token = 'words') %>% anti_join(enstopwords)
reviews_tokens = reviews_tokens %>% select(book_id, title, words)
sentdict = get_sentiments("bing") %>% rename(words = word)
sent = reviews_tokens %>% inner_join(sentdict)
sent$sentiment = ifelse(sent$sentiment=='negative',0,1)
sent_count = sent %>% count(book_id) %>% filter(n>2)
sent_s = sent %>% group_by(book_id) %>% summarize(s = sum(sentiment))
sent_sj = sent_s %>% inner_join(sent_count)
sent_sj = sent_sj %>% mutate(prp_pos = s/n)
sent_sj = sent_sj %>% mutate(sentiment = case_when(prp_pos>=0.5~'1', T~'0'))
sent_sj$sentiment = as.numeric(sent_sj$sentiment)Коллаборативная фильтрация
goodread_reviews =goodread_reviews%>% select(book_id, user_id, rating)
user_item = goodread_reviews %>%
pivot_wider(names_from = book_id,values_from = rating) %>%
as.data.frame()
rownames(user_item) = user_item$user_id
user_item$user_id = NULL
user_item = as.matrix(user_item)функция для рекомендации CF
Для того, чтобы описать функцию, удобнее всего визализировать то, каким образом она выбирает решение для каждого отдельного пользователя, включая нового.
A caption
Однако перейдем непосредственно к функции,а не вопросам, которые она задает пользователю для определения некоторых параметров.
Функция состоит из 3 критериев, с помощью которых нам удается определить, какой из способов рекомендации был бы оптимален для конкретного пользователя.
1 тип: Пользотель у котрого более 10 рекомендаций.
Для такого пользователя мы выдаем рекомендацию по средствам UBCF. Мы посчитали, что 10 - достаточное количество отзывов, которое позволит нам определить другого пользователя похожего на данного достаточно точно.
2 тип: Пользователь у которого менее 10 оценок, но среди них есть оценки выше 3, то есть 4 и 5, которые можно расценивать как позитивные.
Для этого вида пользователей мы спользуем IBCF применительно к комиксам, которые получили оценки 4 и 5. (Мы не можем достаоверно определить является ли оценка 4 положительной, ввиду того, что люди порой имеют достаточно необычные внутринние шкалы оценивания, однако в целом оценка 4 является индикатором позитивного впечатления).
3 тип: Пользователь не относящийся ни к одному из выше описанных.
Что можно сказать о человеке, который оценил 1 фильм и это единственному фильму поставил 2? Пока что ничего, ведь мы совсем знаем предпочтения данного пользователя. Выход из этой ситуации один - порекомендовать топ. Проверка показала, что этот вариант работает значительно лучше, чем рандом.
user_recommendation_col=function(user_ID, quantity, review_matrix=goodread_reviews, n_recom = 20, user_item_matrix = user_item,
ratings_matrix = goodread_reviews,
n_recommendations = 20,
threshold = 1,
nearest_neighbors = 20){
###################################### 1111
cos_similarity = function(A,B){
num = sum(A *B, na.rm = T)
den = sqrt(sum(A^2, na.rm = T)) * sqrt(sum(B^2, na.rm = T))
result = num/den
return(result)
if(count(goodread_reviews%>% filter(user_id == user_ID))>10){
user_index = which(rownames(user_item_matrix) == user_ID)
}
similarity = apply(user_item_matrix, 1, FUN = function(y)
cos_similarity(user_item_matrix[user_index,], y))
similar_users = tibble(user_id = names(similarity),
similarity = similarity) %>%
filter(user_id != user_ID) %>%
arrange(desc(similarity)) %>%
top_n(nearest_neighbors, similarity)
readed_books_user = ratings_matrix$book_id[ratings_matrix$user_id == user_ID]
recommendations = ratings_matrix %>%
filter(
user_id %in% similar_users$user_id &
!(book_id %in% readed_books_user)) %>%
group_by(book_id) %>%
summarise(
count = n(),
rating = mean(rating)
) %>%
filter(count > threshold) %>%
arrange(desc(rating), desc(count))
recommendations= recommendations%>% left_join(goodread_comics)%>% select(title, average_rating, book_id)
###### 1.2
rates = pivot_wider(goodread_reviews, names_from = book_id, values_from = rating)
userNames = rates$user_id
rates = select(rates, -user_id)
rates = as.matrix(rates)
rownames(rates) = userNames
r = as(rates, "realRatingMatrix")
ratings_comics <- r[rowCounts(r) > 5, colCounts(r) > 10]
set.seed(100)
test_ind <- sample(1:nrow(ratings_comics), size = nrow(ratings_comics)*0.2)
recc_data_train <- ratings_comics[-test_ind, ]
recc_data_test <- ratings_comics[test_ind, ]
recc_model <- Recommender(data = recc_data_train, method = "IBCF")
model_details <- getModel(recc_model)
recc_predicted <- predict(object = recc_model, newdata = recc_data_test, n = 20)
recc_user <- recc_predicted@items[[user_ID]]
comics_user <- recc_predicted@itemLabels[recc_user]
comics_user_1 = data.frame(list(comics_user))
names(comics_user_1) <- 'book_id'
comics_user_1$book_id <- as.numeric(comics_user_1$book_id)
comics_user_1 = comics_user_1%>% left_join(goodread_comics)%>% select(title, book_id, average_rating)%>% arrange(desc(average_rating))
v = comics_user_1%>% inner_join(recommendations)
p = comics_user_1%>% full_join(recommendations)%>% arrange(desc(average_rating))%>% select(title, book_id, average_rating)
v = v%>% full_join(p[1:quantity- nrow(v),]) %>% arrange(desc(average_rating))
return(v)}
#########################222222222222222222222222222222
grades = (goodread_reviews%>% filter(user_id == user_ID))$rating
if((count(goodread_reviews%>% filter(user_id == user_ID))>7 & max(grades)>3) |
(count(goodread_reviews%>% filter(user_id == user_ID))<=7 & max(grades)>3) ){
item_recommendation = function(book_ID, rating_matrix = user_item, n_recommendations = 5){
book_index = which(colnames(rating_matrix) == book_ID)
similarity = apply(rating_matrix, 2, FUN = function(y)
cos_similarity(rating_matrix[,book_index], y))
recommendations = tibble(book_id = names(similarity),
similarity = similarity) %>%
filter(book_id != book_ID) %>%
top_n(n_recommendations, similarity) %>%
arrange(desc(similarity))
return(recommendations)}
k = goodread_reviews%>% filter(user_id == user_ID)%>%filter(rating>=4)
m = k$book_id
use = data.frame(matrix(ncol = 2, nrow = 0))
colnames(use) <- c('book_id', 'similarity')
use$book_id= as.character(use$book_id)
for (i in 1:length(k$book_id)){
print(i)
recom_cf_item = item_recommendation(m[i])
use = use%>%full_join(recom_cf_item)
}
uses = use%>%arrange(desc(similarity))%>%filter(similarity>0.2)
answer= uses
answer=unique(answer)
answer = answer[1:quantity,]
goodread_comics$book_id = as.character(goodread_comics$book_id)
answer = answer%>%left_join(goodread_comics)%>%select(book_id, average_rating, title)%>% arrange(desc(average_rating))
if (length(answer)<quantity)
{
additional_data = goodread_comics%>%arrange(desc(average_rating))%>%filter(ratings_count >1000)%>%select(book_id, average_rating, title)
add_rows = quantity - length(answer)
print(add_rows)
additional_data = additional_data[1:add_rows]
answer = answer%>% full_join(additional_data)%>% arrange(desc(average_rating))%>% select(book_id, average_rating, title)
answer = answer[1:quantity,]
return(answer)}
if (length(answer)==quantity)
{
return(answer)
}
return(answer)}
############################################## 3333
if (count(goodread_reviews%>% filter(user_id == user_ID))<=10 & max((goodread_reviews%>% filter(user_id == user_ID))$rating)<4 ){
woon = goodread_comics%>%arrange(desc(average_rating))%>%filter(ratings_count >1000)%>%select(book_id, average_rating, title)
woon = woon[1:quantity,]
return(woon)}
}Оценивание рекомендации:
Итак, расмотрим пользователя 08d805375530cc208801531ca7fdefbc. Он оценил 19 комиксов. Только один комикс был оценен на 5 - Hawkeye #19, от издательства Marvel. Еще 8 комиксов были оценены на четверку - от издательств Dark Horse Comics, Image Comics, Marvel Comics, TokyoPop.
Пользователь предпочитает комиксы 2002-2016 года выпуска, различных издательств.Также он в основном читает хорроры, но нельзя сказать что все они ему нравятся. Два раза встречается манга, одна с оценкой в 4, другая - 3. Также присутствует фентези.
joined_df = goodread_comics %>% inner_join(goodread_reviews)
user1=joined_df %>% filter(user_id =="08d805375530cc208801531ca7fdefbc") %>% select(title,rating,average_rating,publisher,publication_year,popular_shelves.0.name,popular_shelves.1.name,popular_shelves.2.name,popular_shelves.3.name) %>% arrange(-rating)
user1 %>% DT::datatable()Посмотрим, что порекомендовала функция.
Положительные результаты по рекоммендации:
1.Годы комиксов подходят под предпочтения пользователя
2.Издатель - Image Comics, который относительно неплохо оценивался пользователем, составил половину рекомендаций
3.Категории перекликаются с предпочтениями пользователя, например, там есть комиксы манга, хоррор, фэнтази
4.В рекомендациях есть логика - функция рекомендует комиксы той же серии, что положительно оценил пользователь. Например, Saga, Vol. 2 была оценена им на 4 - функция порекомендовала продолжение - 4 и 5 серию комикса, а также Saga: Book Two.
Рекомендация, которая показалась странной, это “The Complete Peanuts, Vol. 6: 1961-1962”. Во-первых, категория комикса - humor. Также, графика совсем отличается от той, что предпочитает пользователь.
Сделаем оценку модели на основе метрик RMSE, MSE и MAE.
В целом, получили один из лучших среди всех худших результатов. Учитывая объем представленных нам данных, RMSE = 1.24 можно назвать неплохим улучшением по сравнению с самым первым результатом, который был равен 1,88.
rates = pivot_wider(goodread_reviews, names_from = book_id, values_from = rating)
userNames = rates$user_id
rates = select(rates, -user_id)
rates = as.matrix(rates)
rownames(rates) = userNames
r = as(rates, "realRatingMatrix")
ratings_comics <- r[rowCounts(r) > 5, colCounts(r) > 6]
#Оцениваем наши рекомендации, используем MSE, RMSE, MAE
set.seed(100)
eval_sets <- evaluationScheme(data = ratings_comics,
method = "split",
train = 0.8, # доля обучающей выборки
given = 4, # сколько оценок используется для предсказания
goodRating = 4) # если предсказанная оценка < 4, то фильм не рекомендуем
recc_model <-
Recommender(data = getData(eval_sets, "train"), method = "IBCF")
recc_predicted <-
predict(
object = recc_model,
newdata = getData(eval_sets, "known"),
n = 6,
type = "ratings"
)
eval_accuracy2 <- calcPredictionAccuracy(x = recc_predicted,
# predicted values
data = getData(eval_sets, "unknown"),
byUser = F) # not averaging for each user
eval_accuracy2## RMSE MSE MAE
## 1.2432162 1.5455866 0.8815459Content-based система
Функция getBooks() для внутренних пользователей
Принцип работы функции getBooks()
Для существующего в базе пользователя:
- При запросе n фильмов функция выдаёт ровно n рекомендаций, но есть один ключевой момент, а точнее - функция дополняет количество доступных рекомендаций исходя из косинусного расстояния с топовыми книгами. Для того, чтобы было заметно, что относится к рекомендациям системы, разработчик выделил топовые книги в столбце title2, а рекомендуемые в title.
Для нового пользователя:
- Просто n топовых книг. Не стали учитывать работу с новым пользователем в данной функции, т.к ниже представлена функции для новых пользователей.
Предобработка переменных
goodread_comics1 = goodread_comics %>% dplyr::select(book_id,authors.0.author_id, authors.1.author_id, average_rating, publication_year,series,publisher, popular_shelves.0.name,popular_shelves.1.name,popular_shelves.2.name,popular_shelves.3.name)
goodread_comics1 = goodread_comics1 %>% mutate(shelves =paste( popular_shelves.0.name, popular_shelves.1.name, popular_shelves.2.name, popular_shelves.3.name))
goodread_comics1 = goodread_comics1 %>% select(-popular_shelves.0.name,-popular_shelves.1.name,-popular_shelves.2.name,-popular_shelves.3.name)
goodread_comics1$authors.1.author_id= as.numeric(goodread_comics1$authors.1.author_id)
goodread_comics1$authors.0.author_id= as.numeric(goodread_comics1$authors.0.author_id)
goodread_comics1$average_rating= as.numeric(goodread_comics1$average_rating)
goodread_comics1$publication_year= as.numeric(goodread_comics1$publication_year)
goodread_comics1$pub_v = 1
goodread_comics1$shelves_v = 1
goodread_comics1$publisher[goodread_comics1$publisher==""] <- NA
sent_sj_edited = sent_sj %>% select(-s, -n, -sentiment)
goodread_comics2 = goodread_comics1 %>% left_join(sent_sj_edited)
goodread_comics2 = goodread_comics2 %>% pivot_wider(names_from = publisher, values_from = pub_v, values_fill = 0)
goodread_comics2 = goodread_comics2 %>% pivot_wider(names_from = shelves, values_from = shelves_v, values_fill = 0)
rownames = goodread_comics2$book_id
goodread_comics2 = goodread_comics2 %>% dplyr::select(-book_id)
rownames(goodread_comics2) = rownames
sim = lsa::cosine(t(as.matrix(goodread_comics2)))
diag(sim) = 0
top_books = goodread_comics %>% select(title,ratings_count, average_rating, book_id) %>% arrange(-average_rating,-ratings_count)Код первой системы content-based
getBooks = function(id, n=5){
user = goodread_reviews %>% filter(user_id == id & rating == 5)
if (nrow(user)==0) {
recommend = top_books[1:n, ]}
else {
mostSimilar = head(sort(sim[,as.character(user$book_id)], decreasing = T), n = n)
a = which(sim[,as.character(user$book_id)] %in% mostSimilar, arr.ind = TRUE)
index = arrayInd(a, .dim = dim(sim[,as.character(user$book_id)]))
result = rownames(sim)[index[,1]]
recommend = filter(goodread_comics,book_id %in% result) %>% dplyr::select(title,ratings_count,average_rating, book_id)
if (length(recommend$title)<n){
recommend2 = filter(goodread_comics,book_id %in% result) %>% dplyr::select(title, book_id)
recommend1 = top_books[1:(n-nrow(recommend)), ] %>% select(title, book_id) %>% rename(title2 = title)
recommend = recommend1 %>% full_join(recommend2)
}}
recommend = recommend %>% filter(!(recommend$book_id %in% user$book_id ))
recommend
}Функция content-based для новых пользователей
Функция рекомендует книги по ввенным названиям книг и рекомендует по n (именно по n) похожих комиксов только для тех комиксов, что есть в датасете goodread_comics.
В случае несуществующих комиксов учтены 3 сценария работы: (неполноценная рекомендация)
Когда нет книг, похожих на запрашиваемые/запрашиваемый комиксы/комикс
Когда нет ни одного комикса из списка
Когда для каких-то введенных книг нет похожих или нет книг в базе (по сути объединение случаев 1 и 2)
В первом случае, функция только предупреждает и не рекомендует ничего. Во втором случае, система заполняет строки столбца title пустыми значениями “NA” ровно столько раз, сколько несуществующих книг запршивается новым пользователем. В третьем случае, функция по n рекмендаций к каждой существующей книге и добавляет строку с “Please try to enter another book”, чтобы указать на наличие недостатков в базе с похожими книгами.
Код второй системы
getBooksbyName = function(comics_name, n=3){
mostSimilar <- data.frame(title=character(0),book_id=numeric(0))
for(i in 1:length(comics_name)){
user1 = goodread_comics %>% filter(title == comics_name[i])
mostSimilar1 = head(sort(sim[,as.character(user1$book_id)], decreasing = T), n = n)
for (x in 1:(length(mostSimilar1))){
if (isTRUE(mostSimilar1[x]==0)){
warning('Not Acceptable Cosine Similarity Value')
print('Try another book')
mostSimilar = "Please try to enter another book"}
else{
mostSimilar2 = data.frame(similar = mostSimilar1[x])
mostSimilar2$book_id = as.numeric(rownames(mostSimilar2))
mostSimilar2 = mostSimilar2 %>% arrange(-similar)
recommend1 = mostSimilar2 %>% left_join(goodread_comics) %>% select(title,ratings_count,average_rating, book_id)
mostSimilar = rbind(mostSimilar, recommend1)}}}
mostSimilar
}Оценка базовой рекомендательной системы content-based
Для начала, нашей целью стал анализ двух групп потребителей графической литературы. Так, мы выделили две группы (manga, fantasy) исходя из того, что эти категории, в большей части, входят в топ-15 категорий полок по данным из 4 столбцов с полками, и являются более генерализуемыми в отличие от тех же самых marvel, dc comics или steampunk. Под генерализуемостью мы предполагаем доступность в каждом из четырёх столбцов.
Нет смысла в выведении всех таблиц, но код содержится в этом чанке
a = joined_df %>% group_by(popular_shelves.0.name) %>% summarize(avg_rating = mean(rating), n = n()) %>% arrange(-n, -avg_rating)
b = joined_df %>% group_by(popular_shelves.1.name) %>% summarize(avg_rating = mean(rating), n = n()) %>% arrange(-n, -avg_rating)
c = joined_df %>% group_by(popular_shelves.2.name) %>% summarize(avg_rating = mean(rating), n = n()) %>% arrange(-n, -avg_rating)
d = joined_df %>% group_by(popular_shelves.3.name) %>% summarize(avg_rating = mean(rating), n = n()) %>% arrange(-n, -avg_rating)Manga Readers
Предупреждения:
Мы не относим значения столбцов popular_shelves к отдельным пользователям из данной нам выборки, так как знаем, что данное разделение на популярные полки было сделано на генеральной совокупности для отдельных книг, но объединеннная таблица с оценками пользователей и характеристиками книг позволяет нам получить больше информации из выборки пользователей.
Дополнительная информация по комиксам была прочитана в википедии
Исходная функция была слегка изменена для рекомендации книг была слегка изменена для работы с фильтрованными датасетами для работы со “специфическими” категориями книг
Мы взяли пользователя с двумя оценками в экспериментальных целях
Первой группой потребителей стали исключителньно люди, оценившие комиксы, у которых хотя бы в одном из столбцов с popular_shelves есть ключевое слово ‘manga’ - таких наблюдений в нашем датасете joined_df оказалось 1438. Оставив пользователей с оценками равными 5, мы сократили исходное количество наблюдений до 545, и обратились к функции за рекоммендацией десяти фильмов.
user = joined_df %>% filter(popular_shelves.0.name=='manga'|popular_shelves.1.name =='manga' | popular_shelves.2.name =='manga'|popular_shelves.3.name=='manga')
top_manga = goodread_comics %>% filter(popular_shelves.0.name=='manga'|popular_shelves.1.name =='manga' | popular_shelves.2.name =='manga'|popular_shelves.3.name=='manga') %>% select(book_id, title, ratings_count, average_rating) %>% arrange(-average_rating,-ratings_count)
#Адаптированная под новые данные функция
user = user %>% filter(rating==5)
getBooks = function(id, n=10){
user = user %>% filter(user_id == id & rating ==5)
if (nrow(user)==0) {
recommend = top_books[1:n, ]}
else {
mostSimilar = head(sort(sim[,as.character(user$book_id)], decreasing = T), n = n)
a = which(sim[,as.character(user$book_id)] %in% mostSimilar, arr.ind = TRUE)
index = arrayInd(a, .dim = dim(sim[,as.character(user$book_id)]))
result = rownames(sim)[index[,1]]
recommend = filter(goodread_comics,book_id %in% result) %>% dplyr::select(title,ratings_count,average_rating, book_id)
if (length(recommend$title)<n){
recommend2 = filter(goodread_comics,book_id %in% result) %>% dplyr::select(title, book_id)
recommend1 = top_books[1:(n-nrow(recommend)), ] %>% select(title, book_id) %>% rename(title2 = title)
recommend = recommend1 %>% full_join(recommend2)
}}
recommend = recommend %>% filter(!(recommend$book_id %in% user$book_id ))
recommend
}
goodread_comics = goodread_comics %>% left_join(sent_sj_edited)user %>% count(user_id) %>% arrange(-n) %>% DT::datatable()Первый пользователь
Среди первых двадцати пользователей можно встретить тех, у кого от 2 до 5 оцененных высшей оценкой книг и проанализировать трёх пользоваетелей с 3,4 и 5 оценками. Давайте посмотрим на предпочтения одного из пользователей с пятью оценками
user1_data = user %>% filter(user_id == '4cc40b94cc18cf3650da122ca8f75b40')
user1_data %>% select(book_id, avgRat) %>% DT::datatable()-Bishojo Senshi Sailor Moon Shinsoban; Kitchen Princess #6; Noragami 7: Stray God; Kamisama Kiss 17; A Silent Voice 6.
Первое, что объединяет всю оцененную литературу - это манга, и, соотвественно, ожидается что-то связанное с этим типом литературы.
Давайте обратимся к рекомендательной системе
a = getBooks("4cc40b94cc18cf3650da122ca8f75b40")
a %>% DT::datatable()Оценим пропорции издательств среди пяти оцененных и рекомендованных (на 5 баллов) книг, средний рейтинг издательств и увидим, несоответствия в издательствах, оцененных и рекомендованных книг. Но, как было отмечено нашими коллегами, рейтинги издательств манги очень высокие.
user1_data = user
user1_data = user1_data%>% filter(user_id == '4cc40b94cc18cf3650da122ca8f75b40')
user1_data %>% group_by(publisher) %>% summarize(avgRat = mean(rating), n_prop = n()/5) %>% arrange(-n_prop) %>%
DT::datatable()a %>% left_join(goodread_comics) %>% group_by(publisher) %>% summarize(avgRat = mean(average_rating), n_prop = n()/10) %>% arrange(-n_prop) %>% DT::datatable()## Joining, by = c("title", "ratings_count", "average_rating", "book_id")Положительные результаты по рекоммендации
Можем заметить, что были предложены комиксы из одинаковой серии “Kamisama Kiss”
Схожие по уровню тональности/направленю комиксы(например, Black Butler и Silent Voice, Bishojo Senshi Sailor Moon Shinsoban, Kitchen Princess и Josie and the Pussycats );
Можно заметить некоторые странности в рекомендованных фильмах:
Captain America: Steve Rogers, Volume 1: Hail Hydra
Out of the Past
Сильные различия в издателях
Данная рекомендация оправдала ожания только в 5 из 10 предложений, что не есть хорошо. Но, это может быть связано с разносторонностью оценок данного пользователя, так как он оценил высшим баллом литературу различного содержанания(good<->bad).
Второй пользователь
Можем увидеть, что у пользователя 4 высокие оценки
user2_data = user %>% filter(user_id =='f07b2b3332b24aeea24a566e5063e56b')
user2_data %>% select(title,ratings_count,average_rating, book_id) %>% DT::datatable()Рекомендация из десяти книг, где две книг в столбце “title2” из топа, а восемь даны рекомендательной системой
b = getBooks('f07b2b3332b24aeea24a566e5063e56b')
b %>% DT::datatable()Пропорции издательств и средний рейтинг
Рейтинг, как и в предыдущих случаях, высокий
Пропорции не совпадают полностью, но есть совпадение в Viz Media LLC
user2_data %>% group_by(publisher) %>% summarize(avgRat = mean(rating), nrop = n()/4) %>% DT::datatable()b %>% left_join(goodread_comics) %>% group_by(publisher) %>% summarize(avgRat = mean(average_rating), n_prop = n()/10) %>% arrange(-n_prop) %>% DT::datatable()## Joining, by = c("book_id", "title")Положительные результаты по рекомендации
Можем заметить, что были предложены комиксы из одинаковой серии “Kamisama Kiss”
Половина предложенных относятся к категории манга.
Схожие по уровню тональности комиксы(например, Black Butler и Silent Voice, Bishojo Senshi Sailor Moon Shinsoban, Kitchen Princess и Josie and the Pussycats ); то есть (в силу незнания каждой книги) были прочитаны описания и найдены некоторые общие характеристики
Года рекомендованных комиксов не сильно отличаются от понравившихся пользователю. (одно десятилетие)
Тем не менее, система порекомендовала несколько комиксов о супергероях Marvel и DC (Batman: Knightfall, Vol. 3: KnightsEnd, Young Avengers,Nightwing,The Wicked), и на наш взгляд это не совсем удачные рекомендации, так как пользователь, читающий только мангу, скорее захочет видеть в рекомендациях тот же жанр комиксов. Кроме этого, совпадает только половина издателей - VIZ Media LLC и неизвестный издатель.
Третий пользователь
Книги, оцененные пользователем (3 оценки):
user3_data = user %>% filter(user_id =='359e63e506eedc65dc7dc1ecf12bedf9')
user3_data %>% select(title,ratings_count,average_rating, book_id) %>% DT::datatable()Можно заметить, что наблюдается сюжетное и стилистическое сходство этих двух манг. Книги непостредственно связаны с технологиями и убийством персонажей, близких к главным героям. Можем заметить, что книги из одного десятилетия издательства.
Перйдём к анализу рекомендации:
На данном этапе мы запросили 10 книг, но анализируем только половину в силу заметных совпадений издательств после пятого
Книги из данной десятки относятся к пяти издательствам и только одна была классифицирована пользователями как manga (Skip Beat!, Vol. 09).
Можем заметить, что первая книга была рекомендована в силу того, что она относится к одному издательству и является мангой, а остальные немного похожи по описаниям и средним оценкам.
3.Странной рекомендацией здесь можно назвать Air, Volume 2: Flying Machine, так как она сильно отличается описанием.
с = getBooks('359e63e506eedc65dc7dc1ecf12bedf9')
с %>% DT::datatable()Fantasy Readers
Второй группой стала полка/жанр ‘fantasy’, которая была не в топе распредлеения по оценкам и количеству оценок, и показаллась нам количественно адекватнее чем “graphic-novels”, где остается более десяти тысяч наблюдений. Отфильтровав датасет по нужным нам переменным, мы получили 1700 наблюдений, из которых 598 с высшей оценкой. Далее, по схожей предыдущей оценке логике, мы выделили пользователей с 6,4 и 2 пятёрками.
Отфильтруем исходный датасет под выбранную группу
user = joined_df %>% filter(popular_shelves.0.name=='fantasy'|popular_shelves.1.name =='fantasy' | popular_shelves.2.name =='fantasy'|popular_shelves.3.name=='fantasy')
user = user%>% filter(rating==5)
user %>% count(user_id) %>% arrange(-n) %>% DT::datatable()Книги, оцененные первым пользователем(жанры этих книг):
user %>% filter(user_id =="8273fc29780c84559cbd533fc969c0a6") %>% select(title,ratings_count,average_rating, book_id) %>% DT::datatable()Fullmetal Alchemist, Vol. 21 (Fullmetal Alchemist, #21) - steampunk, drama
Tsubasa: RESERVoir CHRoNiCLE, Vol. 09 - drama, fantasy, romance
Escape from Lucien (Amulet, #6) - fantasy
Kyo Kara MAOH!, Volume 01 - fantasy, comedy, adventure
Avatar: The Last Airbender: The Rift, Part 1 (The Rift, #1) - action, comedy, fantasy, steampunk
То есть видна жаноровая связь между оцененными фильмами, где наблюдаются приключения в вымышленных мирах - fantasy. Логично предположить о схожести рекомендаций по жанру, но мы это проверим ниже.
c = getBooks('8273fc29780c84559cbd533fc969c0a6')
c %>% DT::datatable()Очевидно, что странными предложением в данной подборке являются Hellblazer, так как по сравнеию с оставльными предложениями данная книга из другого раздела, но мы предполагаем, что рекомендательная система предложила именно эту книга из-за схожести по издательству. С точки зрения команды, данная рекомендация собрала неплохой набор книг и справилась с задачей в 8 случаях из 10 запрашиваемых.
Анализируем предпочтения и подборку комиксов для пользователся с четырьмя оценками:
Bishojo Senshi Sailor Moon Shinsoban - fantasy, adventure
Promethea - science fiction
Jack of Fables - comedy, adventure
user %>% filter(user_id =="ca1c301fff032671a4fd555429db2298") %>% select(title,ratings_count,average_rating, book_id)%>% DT::datatable()Можем заметить, что данному пользователю не получается рекомендовать более 4 книг, и по этой причине, ему руомендуются комиксы из первой десятки и все то, что получаем content-based подходом.
Положительные замечания: - Комиксы издательств Marvel И Dynamite Entertainment
Странным явлением является рекомендация Maximum Ride, которая выделяется тем, что эта книга из разряда “манга” по сравнению с остальными, которые больше похожи на graphic-novels и комисы, исходя из издательств и жанров, к которым они относятся.
d = getBooks("ca1c301fff032671a4fd555429db2298")
d %>% DT::datatable()Анализ третьего пользователся с двумя пятёрками:
- Wayward и Fables - это специфические комиксы, которые не фокуисруются на супергероях, а на мистических существах и сказочных персонажах, но подборка рекомендаций сфокусирована на различных бестселлерах как Batmat, Deadpool и другие. По этой причине, подборка соответствует только двум из десяти ожидаемых рекомендаций, где 2 киги из подборки относятся к серии Fables. Видимо, в данном случае издание Vertigo повлияло на смещение результата в сторону различных героев Marvel, DC и Vertigo, а далее и на схожесть между рекомендованными комиксами.
user %>% filter(user_id =="0854dcf6ea7dc480e5ddd548d8bbc7d9") %>% select(title,ratings_count,average_rating, book_id) %>% DT::datatable()e = getBooks('0854dcf6ea7dc480e5ddd548d8bbc7d9')
e %>% DT::datatable()Оценка индивидуальной рекомендательной системы
Выше был описан принцип работы данной рекомендательной функции с различными случаями.
Первый случай (полноценная рекомендация)
j = getBooksbyName(comics_name = c('Kamisama Kiss, Vol. 2','Our Hero (Babymouse, #2)', "Ultimate X-Men, Volume 2: Return to Weapon X"))
j %>% DT::datatable()По умолчанию, функция рекомендует по три книги к каждой введенной пользователем. Так, для трёх введенных книг мы получили 9 рекомендаций, и для данных трёх книг никаких предупреждений.
Давайте оценим сами рекомендации на адекватность (будем оценивать по блокам из трёх в силу приципа работы этой функции)
Первый блок - этр блок из трёх рекомендаций к комиксу из серии “Kamisama Kiss”
Можем заметить, что были рекомендованы две книги из этой серии - это скорее хорошо
Несмотря на то, что комикс полностью отличается от того, что нравится пользователю, положительным моментом являетя совпадение одного из авторов - это тоже хорошо
3/3
Второй блок - блок из трех рекомендаций к скорее детскому комиксу из серии “Our Hero (Babymouse)”
- Есть одна детская книга ‘Kitchen Princess’ и ‘The Power of Parasit’, но третья как-то мимо
2/3
Третий блок - что-то в стиле героев американских комиксов
- Все рекомендации издательства Marvel
3/3, но истинные ценители комиксов могут не согласиться (в нашей команде нет таких)
Давайте попробуем построить еще одну рекомендацию для комиксов, рекомендованных ранее
k = getBooksbyName(comics_name = c("Guardians of the Galaxy, Volume 4: Original Sin",'Kitchen Princess, Vol. 06 (Kitchen Princess, #6)',"Fables, Vol. 4: March of the Wooden Soldiers"))
k %>% DT::datatable()Первый блок рекомендаций - для “Guardians of the Galaxy”
Как и в предыдущей рекомендации, всё из компании Marvel
Как ожидалось, был рекомендован комикс “Ultimate X-Men”
3/3
Второй блок - детские книги
Рекомендованы две детские книги похожих издателей, но третья (Marvel) мимо
2/3
Третий блок - Fables
Рекомендованы книги из серии “Fables” - скорее хорошо
Сомнительная реомендация, которая может быть связана только по схожести издательств, т.к. Vertigo - это импринт DC Comics, а люди-X и Fables нацелены на более взрослую аудиторию
То есть можем сделать вывод скорее об адекватности этой системы . Наверное, наш подход не очень адекватен в смысле построения рекомендаций на основе каждого отдельного комикса, но данная система справляется немного лучше предыдущей, и нет какой-то мистики в принципе работы системы, т.к. нет совсем странных случаев.
Неполноценные рекомендации
Следующие случаи будут рассмотрены с целью представления приципа работы, а может и недостатков системы, но никак не для оценки адекватности отдельных рекомеднаций
Когда нет книг, похожих на запрашиваемые/запрашиваемый комиксы/комикс
Когда нет ни одного комикса из списка
Когда для каких-то введенных книг нет похожих или нет книг в базе (по сути объединение случаев 1 и 2)
Второй случай (когда нет книг, похожих на запрашиваемые/запрашиваемый комиксы/комикс)
Можем заметить предупреждения о низких значениях косинусного расстояния и итоговый текст о невозможности построения рекомендации.
getBooksbyName(comics_name = c("Superman for All Seasons","Supergirl: Power","Batman: Death by Design"))## [1] "Try another book"
## [1] "Try another book"
## [1] "Try another book"
## [1] "Try another book"## [1] "Please try to enter another book"Третий случай (Когда нет ни одного комикса из списка)
Давайте введём абсолютно случайные значения и заметим, что на выходе у нас таблица из NA с совпадаюшим с количеством введенных элементов количеством столбцов.
Четвертый случай (микс)
Давайте введеём два комикса без похожих, четыре нормальных, и одно случайное значение.
И на выходе получим 12 рекомендаций для существующих комиксов, строку с предупреждением, строку с пустым значением(NA)
getBooksbyName(comics_name = c("Superman for All Seasons","Supergirl: Power",'Kamisama Kiss, Vol. 2','Our Hero (Babymouse, #2)','Tsubasa: RESERVoir CHRoNiCLE, Vol. 09', "Ultimate X-Men, Volume 2: Return to Weapon X",'Otabek')) %>% DT::datatable() ## [1] "Try another book"
## [1] "Try another book"
## [1] "Try another book"Примеры collaborative filtering
user_recommendation_col('b14022e167c8e128788c8b37ad8fb3c9', 10) %>% select(book_id, average_rating) %>% DT::datatable() P.S. Так как для работы с новыми пользователями 1 и 2-го типов мы вносим их в общую базу данных, для того, чтобы получить валидные рекомендации для следующего нового пользователя, необходимо обновить goodread_review до первоначального варианта. Чтобы не забывать об этом шаге мы включили автообновление датасета до исходного при вводе данных.
Необходимость отвечать в консоле не дает это продемонстрировать. Пройдя код и раскомментировав вы сможете сами в этом убедиться
#load("~/shared/minor2_2020/data/good_read/books_g_6.RData")
#load("~/shared/minor2_2020/data/good_read/reviews_g_6.RData")
#goodread_reviews =goodread_reviews%>% select(book_id, user_id, rating)
#user_item = goodread_reviews %>%
#pivot_wider(names_from = book_id,values_from = rating) %>%
#as.data.frame()
#rownames(user_item) = user_item$user_id
#user_item$user_id = NULL
#user_item = as.matrix(user_item)
#user = readline('are you user? yes,no,да, нет')
#if(user == 'yes'|user == 'да')
#{id = readline('what is your id?')
#id = as.character(id)}
#quantity = readline('how many recommendations do you want? write a number')
#quantity = as.numeric(quantity)
#if(user == 'no'|user == 'нет'){
#goodread_comics$ratings_count = as.numeric(goodread_comics$ratings_count)
#quest = readline('are you ready to answer my questions? yes,no,да, нет')
#if(quest == 'no'|quest == 'нет'){
#print('no, problem')
#lazy_answer = goodread_comics%>% arrange(desc(average_rating))%>%select(title, average_rating, book_id)
#lazy_answer = lazy_answer[1:quantity,]
#final_answer = lazy_answer
#}
#if(quest== 'yes'|quest == 'да'){
#questions = goodread_comics%>% arrange(desc(ratings_count))%>%select(title)
#questions = questions[1:10]
#my_vec =vector()
#for (i in 1:10){
#ques <- readline(questions[i,])
#ques = as.numeric(ques)
#my_vec <- c(my_vec, ques)}
#questions$rating <- my_vec
#questions = na.omit(questions)
#questions$user_id <- 'new'
#questions = questions%>% left_join(goodread_comics)%>% select(book_id, rating, user_id)
#load("~/shared/minor2_2020/data/good_read/reviews_g_6.RData")
#goodread_reviews =goodread_reviews%>% select(book_id, user_id, rating)
#goodread_reviews = goodread_reviews %>% full_join(questions)
#final_answer = user_recommendation_col('new', quantity)
#}
#}
#if (user== 'yes'|user == 'да'){
#if(count(goodread_reviews%>% filter(user_id == id)) != 0){
#final_answer= user_recommendation_col('new', quantity)
#}
#if (count(goodread_reviews%>% filter(user_id == id)) == 0){
#print('We have not found you in the list of users. No problem, rely on us:)')
#lazy_answer = goodread_comics%>% arrange(desc(average_rating))%>%select(title, average_rating, book_id)
#lazy_answer = lazy_answer[1:quantity,]
#final_answer = lazy_answer
#}}
#final_answerПримеры content-based
Ровно 12 примеров разобраны в части с оценкой системы
Выводы
Итак, в этом отчете мы провели детальный анализ, который помог нам понять, какие данные представлены в нашем датасете, выявить закономерности и просто познакомиться с пользователями. Этот этап был несомненно важен, так как в функциях были не только применены общие методы для создания функций, но и введены исключения, относящиеся непосредственно к нашей выборке, не лишенной своих особенностей.
Для наиболее точных рекомендаций нами были созданы 3 функции: collaborating filtering, content-based и content-based для ного пользователя. Все функции дают достаточно хорошие результаты, однако и их есть в чем совершенствовать.
Подводя итог всему вышесказанному, разработка таких систем - только начало в вопросах такого рода, так как для выявления всех тонкостей системы, всех ее недочётов или нерассмотренных исключений требудет не только большего объема данных, но и несколько других методов, которые бы смогли детальнее анализировать не только самих пользователей, но и фильм, учиться с каждым новым отзывов. Это открывает нам путь к новой части data science — машинному обучению.
Ответы на вопросы peer review
Вопрос:Проверяются ли данные на совпадение в отношении уже прочитанных пользователем комиксов?
Ответ:Да, данные проверяются, в функции встроен outer_join, позволяющий нам выкинуть комиксы, которые уже были прочитаны пользователем, прежде чем давать ему новую рекомендацию.
Вопрос: Почему в одном случае использован метод UBCF, а в другом IBCF - чем это объясняется?
Ответ:Насколько мы поняли задачу, функция дожна была стать наиболее эффективной в своем классе, то есть в классе коллаборативной фильтрации. После того, как мы провели разведывательный анализ, было выяснено, что около половины пользователей послтавили лишь 1-2 оценки, что естественно не достаточно для того, чтобы с достаточной точностью найти в пару к пользователю другого похожего на него. Ма задумались о том, каким образом может быть решена данная проблема и пришли к выводу, что IBCF станет хорошим подспорьем на данном поприще: поможет работать не с каждым пользователем, а с каждым фильмом, который был оценен на 4-5 баллов.
Вопрос: Я не поняла пункт про аккаунт пользователя в первой коллаборативной системе. Как это отличается от присутствия номера айди пользователя в системе?
Ответ:В целом, ничем не отличается. На этапе формулировки вопросов мы решили, что наиболее клиентоориентированным и привычным вопросом является вопрос о налии/отсутствии аккаунта в системе, нежели прямой вопрос о id пользователя. Более того, как Вы могли заметить, мы сначала спрашиваем о наличии аккаунта, а только потом, если ответ бл положительный, о конкретном id, что позволяет новому пользователю не пугатьс вопросов, на которые он заведомо не знает ответов.
Вопрос: Зачем после применения функции джойнить результат со всем датасетом? Много колонок, местами пустые клетки.
Ответ:То, о чем вы говорите, это промежуточный этап работы, который был проведен в ходе оценивания качества функции. Мы соединили со всем датасетом, чтоб увидеть не только самую главную информацию о фильме, которую выдает функция, но и дополнительную информацию, позволяющую провести тест на адекватность рекомендации.
Вопрос:А что будет, если новому пользователю не понравится ни один из топовых комиксов?
Ответ:Если пользователю ничего не понравилось из топа и он не хочет оценивать другие комиксы, то пусть переходит на другой сайт.
**Вопрос:* Если бы мне нравились комиксы по супермэну и бэтмэну, что бы мне порекомендовали? Если бы я был юзером, у которого куса отзывов на манги, но есть отзывы и на другие комиксы, что бы вы мне посоветовали?
Ответ: Как можно видеть по результатам, пользователь получил в рекомендациях комиксы из вселенной dс, а также другие комиксы, связанные с супергероями
user = joined_df %>% filter(popular_shelves.0.name=='dc-comics'|popular_shelves.2.name =='dc' | popular_shelves.2.name =='batman'|popular_shelves.3.name=='batman')
user = user%>% filter(rating==5)
user %>% count(user_id) %>% arrange(-n)## # A tibble: 93 x 2
## user_id n
## <chr> <int>
## 1 6305fa58820260714d2ca097d7cb82ac 4
## 2 1d02d7115117999be6c86a54360c673b 3
## 3 01a723850ff625fdee36e8bbc152e07e 2
## 4 4a8b6f4c6a692e6eea5ac097978fee32 2
## 5 60f5a8f8a4724b1a81faec3fec51922d 2
## 6 70da424cfb5d9e0e9839651405092f56 2
## 7 b50475acf92c2bc41a3710c02b93b408 2
## 8 00d538e7c57b6e1e108bc67b4e11f0f1 1
## 9 039823e43759feb87a7dd6cf37fd7600 1
## 10 056cabd396b7faa3aaf79b2e695dc51e 1
## # ... with 83 more rowsuser %>% filter(user_id == '6305fa58820260714d2ca097d7cb82ac') %>% select(title,ratings_count,average_rating, book_id)%>% DT::datatable()getBooks('6305fa58820260714d2ca097d7cb82ac',10) %>% DT::datatable()Ответ:Мы провели техническую оценку по показателям RMSE = 1,24; MSE = 1,54; MAE = 0,88. Это значит, что наша система рекомендательная система в среднем ошибается чуть меньше, чем на 1 балл. Кажется, с технической точки зрения это значит, что она работает качественно.
Вопрос:Предположим, я слишком требовательный читатель, и пока что я не нашел ни одного комикса, который можно было оценить больше, чем на 3. Вы порекомендовали ТОП комиксов, но я их уже прочитал и поставил им заслуженные 1 или 2 балла из 5. Что вы будете делать в этом случае? Подсказка: используйте силу рандома.
Ответ: С нашей точки зрения, рандом не самый лучший способ решение подобного рода проблем, более того рекомендация топа рейтинга, по оценкам статистичких тестов, дает более хороший результат, чем рандом. Поэтому такому пользователю мы просто порекомендуем топ по среднему рейтингу, так как ни один из предложенных комиксов ему не понравился.
Вопрос:Если я новый пользователь и хочу получить рекомендации, однако не читала предложенные комиксы из топ-списка (соответственно, не могу их оценить) и при этом хочу указать приоритетный тип комикса (например, манга) - какая рекомендация будет выдана? просто топ комиксов, топ манг или манги на рандом?
Ответ: К сожалению, на данном этапе, наша функция не продполагает выбора жанра. Возможно, в будущем у пользователя появтся альтернатива выбора жанра.
Вопрос:Вопрос возник в начале презентации, по предворительному анализу, поскольку мало сказано о том, как это было посчитана и на основе чего даная информация, использовалась ли какая-то метрика (LDA,TF-IDF) и тд.
Ответ:В предворительном анализе нами был использован метод LDA. Однако в анализ в презентации мы его не вставили. В презентации была указана переменная prp_pos, которая была посчитана с помощью сентимент анализа.
Вопрос:Если я пользователь, которому нравится экшн манга типа Стального Алхимика, порекомендуют ли мне американские/англоязычные экшн-комиксы из супергеройских вселенных?
Ответ:Говоря о контентной фукции - да. Как и в уже разобранных нами примерах, функция скорее всего выдаст вам в основном манги, но с большой вероятностью в рекомендацию попадут и комиксы из супергеройских вселенных по типу Марвел и DC.
Вопрос: Если был бы пользователь, имеющий 5 оценок 5+ для аниме манг, и еще 5 по 5+ для исторических комиксов, то первое место в списке рекомендаций будет принадлежать комиксу из наиболее многочисленного жанра?
Ответ:Так как наша функция не имеет конкретной прописанной привязки к жанрам, имеющимся уже в оценках у пользователя, сложно заранее оценить, что она порекомендует. Предположительно, что в рекомендацию войдут оба жанра, но об их процентном распределении можно будет судить только на конкретном примере.
Вопрос:Если мой пользователь любит комиксы по гуль вселенным, а именно комиксы про Рик и Морти, будут ли ему рекомендоваться более детские комиксы по типу время приключений?
Ответ:К сожалению, у нас нет в датасе комиксов про Рика и Морти, как и комиксов “Аdventure time” и других известных аналогов, чтобы проверить, что выдаст рекомендательная система.
Вопрос:Хотелось бы проверить как работает эта система на нескольких примерах: сначала я бы ответил что не хочу создавать аккаунт, посмотрел бы на рекомендации, потом сравнил бы эти рекомендации с теми, которые были бы у меня, согласившись я на создание аккаунта. Ожидаю, что результат будет один и тот же
Ответ:Результат действительно будет один и тот же, проверили
Вопрос:Абсолютно лишним было описание видов переменных, которые были использованы в проекте, простому пользователю, да и нам, это ни к чему. Кроме того, я бы вставила результаты прогона систем в таблицу, а не переключалась на код, чтобы это показать, т.к. простой пользователь, опять е, не понял бы. К сожалению, в презентации не представлены методы оценивания и успешные/провальные примеры работы систем, а опять же представлены кодом, в котором сложно сразу что-то понять. Еще один вопрос, почему во второй системы у вас такая разбивка пользователей на группы? Там же было много разных жанров, а не только манга и фентези.
Ответ:Ответ на этот вопрос в самом начале построенной системы
**Вопрос:*Насколько изменится рекомендации системы, для двух пользователей, если разбить пользователей на другие специфические группы(жанры)? А если изменить не только группу но и пользователей? Ожидаемый результат: скорее всего рекомендовательная система выдаст хуже результат, чем 6 из 10, посокльку наибольшое количетво хороших оценок у манга и фэнтези.
Ответ:Для начала, сравним пропорции хороших и плохих оценок в случаях manga, fantasy и потенциальной полкой favorites. Заметим, что в пропорциональном соотношении, хороших оценок среди manga и fantasy не выше всех остальных, т.к. есть другие категории, которые сильно превосходят эти две категории по количеству положительных оценок, но и не стоит отрицать того факта, что manga и fantasy превосходят другие категории в пропорциональном соотношении хороших оценок.
Код в данном чанке позволил нам проследить за пропорциями “жанров”,которые были оценены выше четырех баллов.
a = joined_df %>% filter(rating>=4) %>% group_by(popular_shelves.0.name) %>% summarize(prop_good = round((n()*100)/nrow(joined_df),1))
b = joined_df %>% filter(rating>=4) %>% group_by(popular_shelves.1.name) %>% summarize(prop_good = round((n()*100)/nrow(joined_df),1))
c = joined_df %>% filter(rating>=4) %>% group_by(popular_shelves.2.name) %>% summarize(prop_good = round((n()*100)/nrow(joined_df),1))
d = joined_df %>% filter(rating>=4) %>% group_by(popular_shelves.3.name) %>% summarize(prop_good = round((n()*100)/nrow(joined_df),1))Давайте в качестве третьей группы возьмём те комиксы, которые хотя бы в каком-то из случаев были отнесены к favorites.
Какова причина такого выбора?
Можно встретить во всех столбцах с популярными полками
Данная категория не выделяется высоким соотношением хороших оценок
Таких комиксов не слишком мало и не слишком много
Предыдущие пункты сигнализируют на о большей свободе действий, нежели какие-то совсем специфические категории (steampunk, marvel, komik, kitche-princess и т.д)
Давайте начнём работу с этой категорией.
user = joined_df %>% filter(popular_shelves.0.name=='favorites'|popular_shelves.1.name =='favorites' | popular_shelves.2.name =='favorites'|popular_shelves.3.name=='favorites')
user = user %>% filter(rating==5)Посмотрим, распределение количеств “отличных” оценок среди пользователей, оценивших книги этой категории и заметим, что, в основном, это меньше трёх оценок - всего два пользователя с тремя оценками и один с четырьмя. Давайте оценим рекомендации пользователей с 2, 3 и 4 оценками.
user %>% count(user_id) %>% arrange(-n) %>% DT::datatable()Первый пользователь
Можем заметить, что пользователь совпал со вторым пользователем из категории manga. Поэтому стоит перейти к следующему.
user %>% filter(user_id == 'f07b2b3332b24aeea24a566e5063e56b')%>% select(title,ratings_count,average_rating, book_id)%>% DT::datatable()getBooks('f07b2b3332b24aeea24a566e5063e56b',10) %>% DT::datatable()Второй пользователь
Предпочтения:
Можем заметить, что все три книги - манга. Следовательно, от рекомендательных систем ожидается что-то связанное именно с этим видом литературы.
user %>% filter(user_id == 'a410bfaed52d4b018939ccf8352a346e') %>% select(title,ratings_count,average_rating, book_id)%>% DT::datatable()Обратимся к рекомендательной функции за пятью рекомендациями:
Можем заметить, что рекомендация не самая удачная, так как только две книги относятся к манге. Авторы этих двух книг полностью совпадают, и издаются одним издательство VIZ Media LLC.
Еще одним положительным совпадением является совпадение одного из авторов из его/ее предпочтений с автором рекомендованных книг.
В остальных случаях, система советует что-то странное из серии DC Comics, что не есть хорошо для человека, высоко оценившего мангу. Скорее всего, система составила такие рекомендации исходя из каких-то других переменных.
2/5
l = getBooks('a410bfaed52d4b018939ccf8352a346e',5)
l %>% DT::datatable()Теперь, когда у нас есть адаптированная под названия функция, мы можем проверить системы на пересечения в рекомендациях, и оценить слабые и сильные стороны каждой. Заметим, что все рекомендации первой системы представлены также и второй системой.
j = getBooksbyName(comics_name = c('Fruits Basket, Vol. 23','Attack on Titan: No Regrets, Volume 02','Bakuman, Volume 1: Dreams and Reality (Bakuman, #1)'))
j %>% DT::datatable()Третий пользователь
И снова две манги. Наверное, в данной нам выборке есть какая-то склонность к высокому оцениванию манги, т.к. уже третий пользователь из разряда favorites непосредственно связан с мангой.
user %>% filter(user_id == "5c0a76a445829482c8bbc8243734795a")%>% select(title,ratings_count, average_rating, book_id )%>% DT::datatable()Обратимся к первой системе:
Заметим странность: система рекомендует книгу, которая уже была оценена пользователем, несмотря на то, что мы исправили эту ошибку и в других случаях, где мы столкнулись с той же самой омибкой, такое не наблюдается.
l = getBooks('"5c0a76a445829482c8bbc8243734795a"',5)
l %>% DT::datatable()f = getBooksbyName(comics_name = c('Skip Beat!, Vol. 09','Fullmetal Alchemist, Vol. 21 (Fullmetal Alchemist, #21)'))
f %>% DT::datatable()Вопрос на решение: Опишите сценарий работы вашей системы для пользователя, у которого 8 оценок, из них 6 — это низкие оценки 1-2-3
Ответ: Найдем пользователя удовлетворяющего данным требованиям. Таким пользователем является 5a81ba0c7e1d614be4e896d80b778639 с оценками, которые вы можете увидеть ниже.
review_8 = goodread_reviews%>% group_by(user_id)%>%tally()
review_8 = review_8%>%filter(n==8)
user_8 = aggregate(rating ~ user_id, goodread_reviews, sum)
user_8 = review_8%>% left_join(user_8)%>%filter(rating>10 & rating < 28 )
specialuser_review = goodread_reviews%>% filter(user_id == "5a81ba0c7e1d614be4e896d80b778639")
specialuser_review = specialuser_review%>%left_join(goodread_comics)%>%select(user_id, rating, title)
specialuser_review %>% DT::datatable()recommendation_for_user_8 = user_recommendation_col("5a81ba0c7e1d614be4e896d80b778639", 10)## [1] 1
## [1] 2
## [1] 7recommendation_for_user_8 %>% DT::datatable()Итак, нам удалось посмотреть, какую рекомендацию получит пользователь, имеющий 8 отзывов, в 6 из которых былас поставлена оценка менее 4. Как видно из результата, функция выдала комиксы, схожие с популярными, так как ни один из них не был прочитан пользователем. Кроме того, мы не обнаруживаем пересений между уже прочитанными книгами и теме, что были порекомендованы.