Текст задания:
Сделать рекомендацию для пользователя, который есть в системе, но хочет что-то не похожее на комикс А.
Предобработка и загрузка данных
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)
goodread_comics$series = as.numeric(goodread_comics$series)
goodread_comics$series = ifelse(goodread_comics$series>=100,NA, goodread_comics$series)
rating_df = joined_df %>% group_by(book_id) %>% summarize(avgRat = mean(rating))
goodread_comics = rating_df %>% inner_join(goodread_comics)
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 = 'words') %>% anti_join(enstopwords)
reviews_tokens = reviews_tokens %>% select(book_id, title, words)Пропорциональное соотношение плохих и хороших слов
На данном этапе выделил хорошие и плохие из словаря ‘bing’, и каждому описанию присвоил пропорцию хороших слов.
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_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)))
top_books = goodread_comics %>% select(title,ratings_count, average_rating, book_id) %>% arrange(-average_rating,-ratings_count)Исходя из формулировки задания, в данном задании нет привязки к определенному виду рекомендательной системы, и нет жестких требований наличия функций, а значит можно включить воображение и рассмотреть несколько подходов к решению задачи, как это было сделано мною.
Если конкретнее, то я написал три рекомендательные функции:
Первая система является аналогом content-based системы, но с основным отличием в матрице схожести по косинусному расстоянию.
Вторая система основана на матрице расстояний, которую я построил с помощью функции dissimilarity для поиска расстояний на основе рейтинговых данных.
Источник: https://rdrr.io/cran/recommenderlab/man/dissimilarity.html
Третья система IBCF подход с измененными системными параметрами поиска topNList.
Источник: https://github.com/mhahsler/recommenderlab/blob/master/R/topNList.R
Я выбрал именно эту последовательность представления проделанной работы, основываясь на общих чертах функций, так как первая и вторая функции имеют схожий скелет, а третья система требовала преобразование topNList для изменения результатов предсказаний. Всю остальную логику работы я планирую представить в следующих частях работы, т.к. всё основано на небольших деталях, которые нужно раскрыть для полного понимания принципов работы этих функций.
При предобработке данных была построена матрица косинусныных расстояний по выбранным переменным, как в групповом проекте, для системы Content-Based. Но, получения антирекомендаций (т.е тех книг, что абсолютно не похожи на оцененные пользователем), я составил матрицу 1-sim, руководствуясь множеством значений косинусных расстояний.
d_sim = as.dist(1-sim)
d_sim = as.matrix(d_sim)После получения основы для построения рекомеднательной системы №1, я приступил к построению самой системы.
Давайте опишу принцип работы первой системы:
Функция принимает только два аргумента (количество желаемых рекомендаций, id пользователя)
Если такого пользователя нет в базе, рекомендуется n случайных комиксов из исходного датасета goodread_comics
Если пользователь есть в базе, функция рекомендует ему ровно n комиксов, большего всего отличающихся от оцененных им. Но, эти n рекомендаций состоят из n-m случаных книг только в тех случаях, когда системе не получается рекомендовать больше m книг.
Код системы
AntiRecommender_CB = function(id, n=5){
user = goodread_reviews %>% filter(user_id ==id)
simCut = d_sim[,as.character(user$book_id)]
if (nrow(user)==0) {
recommend = goodread_comics[sample(nrow(goodread_comics), n), ]}
else {
mostSimilar = head(sort(simCut, decreasing = T), n = n)
mostSimilar = mostSimilar[mostSimilar!=0]
a = which(simCut %in% mostSimilar, arr.ind = TRUE, useNames = T)
index = arrayInd(a, .dim = dim(d_sim[,as.character(user$book_id)]))
result = rownames(d_sim)[index[,1]]
recommend = filter(goodread_comics,book_id %in% result) %>% dplyr::select(title, book_id)
if (length(recommend$title)<n){
random = goodread_comics[sample(nrow(goodread_comics), 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
}Во избежание получения искаженных результатов, загрузил датасеты заново, т.к. системы второго и третьего пунктов не требуют чего-то большего чем исходные данные.
Загрузка данных
load("reviews_g_6.RData")
load("books_g_6.RData")
goodread_reviews_cf = select(goodread_reviews, -review_id, -date_added,-review_text)Преобразования: для работы со следующими двумя системами требуется RealRatingMatrix
Подобрал rowCounts(r) > 2 по той причине, что третий квартиль распределения количеств оценок по пользователям начинается именно с двойки, а в нижних квартиля наблюдается только единица.
rates = pivot_wider(goodread_reviews_cf, 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_books <- r[rowCounts(r) > 2, colCounts(r) > 0]Основа будущей рекомендательной системы: матрица косинусных расстояний dissimilarity.
dissimilarity = dissimilarity(ratings_books, method = "cosine", which = "items")
dissimilarity = as.matrix(dissimilarity)
similarity = similarity(ratings_books, method = "cosine", which = "items")
similarity = as.matrix(similarity)В основе второй системы лежат те же условия, что и в прошлой, за исключением небольших преобразований, которые связаны особенностями матриц с которыми пришлось повозиться для получения ровно n антирекомендаций (иначе, я получал 18 рекомендаций при запросе n=20).Кроме этого, во внутренних преобразованиях данных, из функции пришлось исключить одинаковые значения индексов, т.к. при запросе десяти рекомендаций получал 13. Также, при построении этой системы, я заметил достаточное большую разницу в значениях косинусных расстояний (по оценкам): при запрашивании 20 рекомендаций, я несколько раз заметил, что после некоторого количества единиц сразу начинаются значения меньше 0.5 или 0.4, и поэтому я решил приравнять нулю зачения меньшие 0.4, а всё остальное оставить как есть.
Код системы
goodread_comics$average_rating = as.numeric(goodread_comics$average_rating)
goodread_comics$ratings_count = as.numeric(goodread_comics$ratings_count)
AntiRecommender_CD = function(id, n=5){
user = goodread_reviews %>% filter(user_id ==id)
simCut = dissimilarity[,as.character(user$book_id)]
simCut[simCut<0.4] = 0
if (nrow(user)==0) {
recommend = goodread_comics[sample(nrow(goodread_comics), n), ] %>% select(title, book_id, average_rating)}
else {
mostSimilar = head(sort(simCut, decreasing = T), n = n)
mostSimilar = mostSimilar[mostSimilar!=0]
a = which(simCut %in% mostSimilar, arr.ind = TRUE, useNames = T)
index = arrayInd(a, .dim = dim(dissimilarity[,as.character(user$book_id)]))
result = rownames(dissimilarity)[index[,1]] %>% unique()
index = data.frame(index)
v = index$X1 %>% unique()
df_unique = data.frame(X1 = v)
index = df_unique %>% left_join(index, by= 'X1')
for (i in 1:length(index$X1)){
if (isTRUE(index[i,1] == index[i+1,1])){
index[i,1] = NA}}
index = index %>% drop_na() %>% as.matrix()
colnames(index) = NULL
mostSimilar = data.frame(book_id = as.numeric(result), similar =simCut[index])
recommend = mostSimilar %>% left_join(goodread_comics) %>% select(title,book_id ,similar) %>% head(n)%>% arrange(-similar)
if (nrow(recommend)<n){
random = goodread_comics[sample(nrow(goodread_comics), n), ]
recommend2 = filter(goodread_comics,book_id %in% result) %>% dplyr::select(title, book_id)
recommend1 = random[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
}Как было отмечено ранее, для получения третьей системы был изменён способ получения topNList.
Функция принимает только два аргумента (количество желаемых рекомендаций, id пользователя)
Если пользователя нет в базе, рекомендуется n случайных комиксов из исходного датасета goodread_comics
Если есть, то рекомендует n кинг. Дополнительных условий нет.
Код системы
recc_model = Recommender(data = ratings_books, method = "IBCF")
goodread_comics = goodread_comics %>% inner_join(rating_df)
Anti_IBCF = function(id, n){
recc_predicted = predict(object = recc_model, newdata = ratings_books, n = n)
recc_user = recc_predicted@items[[id]]
if (length(recc_user)==0) {
rec = goodread_comics[sample(nrow(goodread_comics), n), ]
} else {
comics_user = recc_predicted@itemLabels[recc_user]
names_comics_user = goodread_comics$title[match(comics_user, goodread_comics$book_id)]
rec = data.frame(book_id = as.numeric(comics_user), title = names_comics_user) %>% left_join(goodread_comics) %>% select(title, book_id, avgRat)
}
rec
}Код для изменения topNList. В отличие от кода, приведенного в источнике можно заметить, что:
Во-первых, для каждой книги мы выбираем k наименее похожих книг
Во-вторых, подбираем n наихудших элементов для дальнейшей рекомендации
Что я сделал для изменения topNList?
Просто изменил все head на tail (не наугад), а проверил правильность своих действий просмотром структуры переменной recc_predicted (база с рекомендациями каждому отдельному пользователю), где при выборе наилучших элементов, чаще всего, наблюдаются высокие оценки, а в нашем случае оценки чаще всего не превышают тройку. Кроме этого, по моим наблюдения за структурой recc_predicted ,множества рекомендуемых пользователям книг, никак не пересекаются в обоих(рек/антирек) случаях.
setAs("topNList", "dgTMatrix",
function(from) {
i <- rep(1:length(from@items), lapply(from@items, length))
j <- unlist(from@items)
if(!is.null(from@ratings)) x <- unlist(from@ratings)
else x <- rep(1, length(j))
new("dgTMatrix", i = i-1L, j = j-1L,
x = x,
Dim = c(length(from@items), length(from@itemLabels)),
Dimnames = list(names(from@items), from@itemLabels))
})
setAs("topNList", "dgCMatrix",
function(from) as(as(from, "dgTMatrix"), "dgCMatrix"))
setAs("topNList", "ngCMatrix",
function(from) as(as(from, "dgCMatrix"), "ngCMatrix"))
setAs("topNList", "matrix",
function(from) dropNA2matrix(as(from, "dgCMatrix")))
setMethod("getList", signature(from = "topNList"),
function(from, decode = TRUE, ...)
if(decode) lapply(from@items, function(y) from@itemLabels[y])
else from@items)
setMethod("getRatings", signature(x = "topNList"),
function(x, ...) x@ratings)
setAs("topNList", "list", function(from) getList(from, decode = TRUE))
## creation from realRatingMatrix
setMethod("getTopNLists", signature(x = "realRatingMatrix"),
function(x, n=10, randomize=NULL, minRating=NA){
n <- as.integer(n)
# just in case
x <- denormalize(x)
x.l <- getList(x, decode = FALSE)
if(is.null(randomize) || is.na(randomize)) {
reclist <- lapply(x.l, FUN = function(l)
tail(sort(l, decreasing = TRUE), n=n))
ret <- new("topNList",
items = lapply(reclist, FUN = function(l) as.integer(names(l))),
ratings = lapply(reclist, as.vector),
itemLabels = colnames(x), n = n)
if(!is.null(minRating) && !is.na(minRating))
ret <- bestN(ret, n = n, minRating = minRating)
}else{
## randomize recommendations
reclist <- lapply(x.l, FUN = function(l) {
if(!is.null(minRating) && !is.na(minRating)) l <- l[l>=minRating]
if(length(l)>0) sample(l, size = min(n, length(l)),
prob = (l-min(l)+1)^randomize)
else integer(0)
})
ret <- new("topNList",
items = lapply(reclist, FUN = function(l) as.integer(names(l))),
ratings = lapply(reclist, as.vector),
itemLabels = colnames(x), n = n)
}
ret
})
## only keep best n items.
setMethod("bestN", signature(x = "topNList"),
function(x, n = 10, minRating = NA) {
if(!is.null(minRating) && !is.na(minRating)) {
if(is.null(x@ratings)) stop("topNList does not contain ratings, setting minRatings not possible!")
take <- lapply(x@ratings, ">=", minRating)
x@items <- lapply(1:length(take), FUN=function(l) x@items[[l]][take[[l]]])
x@ratings <- lapply(1:length(take), FUN=function(l) x@ratings[[l]][take[[l]]])
}
new("topNList", items = lapply(x@items, tail, n),
ratings = if(!is.null(x@ratings)) lapply(x@ratings, tail, n) else NULL,
itemLabels = x@itemLabels, n = as.integer(n))
})
setMethod("removeKnownItems", signature(x = "topNList"),
function(x, known) {
if(!is(known, "ratingMatrix"))
stop("known needs to be a ratingMatrix!")
if(length(x) != nrow(known))
stop("length of x and number of rows in known do not match!")
ns <- names(x@items)
rem <- lapply(1:length(x), FUN=function(i)
which(x@items[[i]] %in% unlist(getList(known[i,],
decode=FALSE, ratings=FALSE))))
#x@items <- lapply(1:length(x), FUN=function(i) {
# setdiff(x@items[[i]],
# getList(known[i],
# decode=FALSE, ratings=FALSE)[[1]])
#})
x@items <- lapply(1:length(x), FUN=function(i) x@items[[i]][-rem[[i]]])
names(x@items) <- ns
if(!is.null(x@ratings))
x@ratings <- structure(lapply(1:length(x), FUN=function(i)
x@ratings[[i]][-rem[[i]]]), names = ns)
x
})
setMethod("length", signature(x = "topNList"),
function(x) length(x@items))
setMethod("show", signature(object = "topNList"),
function(object) {
cat("Recommendations as", sQuote(class(object)),
"with n =", object@n, "for",
length(object@items),"users.","\n")
invisible(NULL)
})
setMethod("colCounts", signature(x = "topNList"),
function(x, ...) {
s <- colSums(as(x, "ngCMatrix"))
names(s) <- x@itemLabels
s
})
setMethod("rowCounts", signature(x = "topNList"),
function(x, ...) sapply(x@items, length))Давайте придержимся стратегии проверки рекомендаций только для одного пользователя.
Предпочтения рассматриваемого пользователя
Рассматриваемым пользователем стал читатель манги, который первым был рассмотрен в групповом проекте при оценке системы content-based. По этой причине, не буду подробно расписывать его предпочтения.
joined_df %>% filter(user_id == '4cc40b94cc18cf3650da122ca8f75b40') %>% select(title, average_rating, publisher, authors.0.author_id, authors.1.author_id) %>% DT::datatable()Пример №1
Антирекомендации первой системы
В целом, сложно судить об адекватности антирекомендации, учитывая большое количество факторов в системе content-based. Очвиден один момент - нет общих авторов и только одно общее издательство. При сравнении с исходной системой content-based, которая была написана для группового проекта, пересечений в рекомендациях не наблюдается, а это важно. Кроме этого, нет никаких книг из тех же серий (например, Kamisama Kiss Vol.N), что были оценены пользователем.
rec1 = AntiRecommender_CB("4cc40b94cc18cf3650da122ca8f75b40", 5)
rec1 = rec1 %>% left_join(goodread_comics)
rec1 %>% select(title, average_rating, publisher, authors.0.author_id, authors.1.author_id) %>% DT::datatable()Пример №2
Антирекомендации второй системы
AntiRecommender_CD("4cc40b94cc18cf3650da122ca8f75b40", 5) %>% DT::datatable()Пример №3
Антирекомендации третьей системы
Первая книга во второй и третьей системах совпадает (Stargazing Dog).
Anti_IBCF("4cc40b94cc18cf3650da122ca8f75b40", 5) %>% DT::datatable()Формальная оценка системы №3:
Конечно, ошибка в 1.42 - это не самый лучший результат. Но, по крайней мере, это лучший результат, который был получен мною в процессе работы над этим заданием.
#строим модель оценивания
set.seed(1)
eval_sets <- evaluationScheme(data = ratings_books,
method = "split",
train = 0.8,
given = 2,
goodRating = 5)
recc_model_ibcf <-
Recommender(data = getData(eval_sets, "train"), method = "IBCF")
recc_predicted_ibcf <-
predict(
object = recc_model_ibcf,
newdata = getData(eval_sets, "known"),
n = 6,
type = "ratings"
)
eval_accuracy <- calcPredictionAccuracy(x = recc_predicted_ibcf,
# predicted values
data = getData(eval_sets, "unknown"),
byUser = F)
eval_accuracy## RMSE MSE MAE
## 1.4244459 2.0290460 0.9782225Проделав небольшую работу, я пришел к такому выводу - все три системы, написанные мною, выдают абсолютно различные результаты. Сложно определенно сказать, какая работает лучше всех, но, исходя из принципов работы этих систем, я предполагаю, что IBCF лучше остальных справляется с задачей нахождения антирекомендаций ровно по причине работы на основе пользовательских оценок. Кроме этого, думаю, что значение RMSE не всегда должно понижаться с повышением количества пользовательских оценок, т.к. в выборке есть пользователи, которые при в n раз большем количестве наблюдений показывают в три раза более высокие значения ошибок.
Небольшой факт: третья система мне более симпатична в силу более практически обоснованного и понятного принципа работы.