Recommender System :MovieLens
Kumudini Bhave
June 26, 2017
Recommender System : Movie Lens
Summary
This is an R Markdown document for performing analysis of MovieLense Data and to recommend the new / untried movies to users. We explore the the different algorithms IBCF and UBCF with Cosine similarity and compare for accuracy for evaluation. We will also check if adding the period context of the movie release changes the recommendations.
knitr::opts_chunk$set(message = FALSE, echo = TRUE)
# To load survey data from googlesheets
suppressWarnings(suppressMessages(library(googlesheets)))
# Library for loading CSV data
library(RCurl)
# Library for data tidying
library(tidyr)
# Library for data structure operations
library(dplyr)
library(knitr)
# Library for plotting
library(ggplot2)
# Library for data display in tabular format
library(DT)
library(pander)
library(Matrix)
suppressWarnings(suppressMessages(library(recommenderlab)))# Loading data from googlesheets, first finding the relevant sheet , reading the
# sheet and relevant worksheet
data(MovieLense, package = "recommenderlab")
movielense <- MovieLense
class(movielense)## [1] "realRatingMatrix"
## attr(,"package")
## [1] "recommenderlab"# Verifying records and variables
nrow(movielense)## [1] 943ncol(movielense)## [1] 1664# Loading the metadata that gets loaded with main dataset
moviemeta <- MovieLenseMeta
# Verifying records and variables
nrow(moviemeta)## [1] 1664ncol(moviemeta)## [1] 22pander(head(moviemeta), caption = "Sample Movie Meta Data")| title | year |
|---|---|
| Toy Story (1995) | 1995 |
| GoldenEye (1995) | 1995 |
| Four Rooms (1995) | 1995 |
| Get Shorty (1995) | 1995 |
| Copycat (1995) | 1995 |
| Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) | 1995 |
| Adventure | Animation | Children’s | Comedy | Crime | Documentary | Drama |
|---|---|---|---|---|---|---|
| 0 | 1 | 1 | 1 | 0 | 0 | 0 |
| 1 | 0 | 0 | 0 | 0 | 0 | 0 |
| 0 | 0 | 0 | 0 | 0 | 0 | 0 |
| 0 | 0 | 0 | 1 | 0 | 0 | 1 |
| 0 | 0 | 0 | 0 | 1 | 0 | 1 |
| 0 | 0 | 0 | 0 | 0 | 0 | 1 |
| Fantasy | Film-Noir | Horror | Musical | Mystery | Romance | Sci-Fi | Thriller |
|---|---|---|---|---|---|---|---|
| 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
| 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 |
| 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 |
| 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
| 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 |
| 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
| War | Western |
|---|---|
| 0 | 0 |
| 0 | 0 |
| 0 | 0 |
| 0 | 0 |
| 0 | 0 |
| 0 | 0 |
Data Preparation
Since it is a large dataset,and sparse as well, there might be users that might have hardly rated any movies (may be watched or not) and many a movies which may not be rated to a good extent. To maintain a healthy baseline on which recommendations could be made we will take into consideration those users who have rated at least 20 movies and those movies that are rated b atleast 50 users.
# Extracting data tha comprises of at least 20 ratings per user and 50 ratings
# per movie
movielenseorig <- movielense
movielense <- movielense[rowCounts(movielense) > 20, colCounts(movielense) > 50]
minrowcnt <- min(rowCounts(movielense))
nrow(movielense)## [1] 898ncol(movielense)## [1] 591Forming Train / Test Sets
set.seed(101)
which_train <- sample(x = c(TRUE, FALSE), size = nrow(movielense), replace = TRUE,
prob = c(0.8, 0.2))
recc_data_train <- movielense[which_train, ]
recc_data_test <- movielense[!which_train, ]Model : Item-Based Collaborative Filtering
Item-rBased collaborative filtering algorithm is applied with Cosine similarity to identify 25 neighbouring items wiht similar genre profile and base recommendations on that basis
# Find top 10 recomm movies with Item based collab filter
recc_model1 <- Recommender(data = recc_data_train, method = "IBCF", parameter = list(k = 25,
method = "Cosine"))
recc_model1## Recommender of type 'IBCF' for 'realRatingMatrix'
## learned using 722 users.# Applying model to test
num_rec <- 10 # Lets recommend top 5 movies to each of users
recc_predicted1 <- predict(object = recc_model1, newdata = recc_data_test, n = num_rec)
recc_predicted1## Recommendations as 'topNList' with n = 10 for 176 users.# The recc_predicted object contains the recommendations which is topN
# recommendations for each of the users.The slots are: . items: This is the list
# with the indices of the recommended items for each user . itemLabels: This is
# the name of the items . n: This is the number of recommendations . ratings
# predicted
# We try to find the latest among those predicted for each user as most
# recommended.
recdf <- data.frame(user = sort(rep(1:length(recc_predicted1@items), recc_predicted1@n)),
rating = unlist(recc_predicted1@ratings), index = unlist(recc_predicted1@items))Recommendations from IBCF model
Displaying the recommendations for first ten users
recdf$title <- recc_predicted1@itemLabels[recdf$index]
recdf$year <- moviemeta$year[recdf$index]
recdf <- recdf %>% group_by(user) %>% top_n(5, recdf$rating)
# recdf
datatable(recdf[recdf$user %in% (1:10), ])Recommendations from IBCF model With Period Context Added
Displaying the recommendations for first ten users, the top and latest movies.
recdfnew <- recdf[with(recdf, order(recdf$user, -recdf$year, -round(recdf$rating))),
c(1, 2, 5, 4)]
recdfnew <- recdfnew %>% group_by(user) %>% top_n(5, recdfnew$year)
datatable(recdfnew[recdfnew$user %in% (1:10), ])We see that the period context when added to the recommended movies , pushes the latest movies up the list for the user. This list was found pretty much similar to those with top n by rating with a variation in 1 or 2 recommendations
Model : User-Based Collaborative Filtering
UserBased collaborative filtering algorithm is applied with Cosine similarity to identify 25 neiighbouring users wiht similar profile and base recommendations on that basis
# Find top 10 recomm movies with Item based collab filter
recc_model2 <- Recommender(data = recc_data_train, method = "UBCF", parameter = list(k = 25,
method = "Cosine"))## Available parameter (with default values):
## method = cosine
## nn = 25
## sample = FALSE
## normalize = center
## verbose = FALSErecc_model2## Recommender of type 'UBCF' for 'realRatingMatrix'
## learned using 722 users.# Applying model to test
num_rec <- 10 # Lets recommend top 5 movies to each of users
recc_predicted2 <- predict(object = recc_model2, newdata = recc_data_test, n = num_rec)
recc_predicted2## Recommendations as 'topNList' with n = 10 for 176 users.recdfub <- data.frame(user = sort(rep(1:length(recc_predicted2@items), recc_predicted2@n)),
rating = unlist(recc_predicted2@ratings), index = unlist(recc_predicted2@items))Recommendations from UBCF model
Displaying the recommendations for first ten users
recdfub$title <- recc_predicted2@itemLabels[recdfub$index]
recdfub$year <- moviemeta$year[recdfub$index]
recdfub <- recdfub %>% group_by(user) %>% top_n(5, recdfub$rating)
# recdfub
datatable(recdfub[recdfub$user %in% (1:10), ])Recommendations from UBCF model With Period Context Added
Displaying the recommendations for first ten users , the top and latest movies
recdfubnew <- recdfub[with(recdfub, order(recdfub$user, -recdfub$year, -round(recdfub$rating))),
c(1, 2, 5, 4)]
recdfubnew <- recdfubnew %>% group_by(user) %>% top_n(5, recdfubnew$year)
datatable(recdfubnew[recdfubnew$user %in% (1:10), ])We dont see any difference in the recommendations with the period context added, . Also there is not tie as seen in item based (were more number of movies are recommended because of rating tie).
Using k-fold To Validate Models , Forming Training and Test Sets
# Since minrowcnt is 20 , we keep the itemto keep at 15
set.seed(101)
n_fold <- 10 # k value for k fold cross validation
items_to_keep <- 15 # Items to consider in training set (less than min no of ratings )
rating_threshold <- 3.5 # Considering a rating of 3.5 as good rating across all movies
eval_sets <- evaluationScheme(data = movielense, method = "cross-validation", k = n_fold,
given = items_to_keep, goodRating = rating_threshold)
eval_sets## Evaluation scheme with 15 items given
## Method: 'cross-validation' with 10 run(s).
## Good ratings: >=3.500000
## Data set: 898 x 591 rating matrix of class 'realRatingMatrix' with 82047 ratings.evaltrain <- getData(eval_sets, "train") # training set
evalknown <- getData(eval_sets, "known") # known test set
evalunknown <- getData(eval_sets, "unknown") # unknown test setCreating Models
Model 1 : IBCF-Cosine
# First, let's prepare the data for validation, as shown in the previous section.
# Since #the k-fold is the most accurate approach, we will use it here:
model_to_evaluate <- "IBCF"
model_parameters <- list(method = "Cosine")
model1_IBCF_cosine <- Recommender(data = evaltrain, method = model_to_evaluate, parameter = model_parameters)
items_to_recommend <- 10
model1_prediction <- predict(object = model1_IBCF_cosine, newdata = evalknown, n = items_to_recommend,
type = "ratings")
model1_predtop <- predict(object = model1_IBCF_cosine, newdata = evalknown, n = items_to_recommend,
type = "topNList")
model1_accuracy <- calcPredictionAccuracy(x = model1_prediction, data = evalunknown,
byUser = FALSE)
model1_accuracy## RMSE MSE MAE
## 1.2802981 1.6391632 0.9466074Model 1 : UBCF-Cosine
model_to_evaluate <- "UBCF"
model_parameters <- list(method = "cosine")
model3_UBCF_cosine <- Recommender(data = evaltrain, method = model_to_evaluate, parameter = model_parameters)
items_to_recommend <- 10
model3_prediction <- predict(object = model3_UBCF_cosine, newdata = evalknown, n = items_to_recommend,
type = "ratings")
model3_predtop <- predict(object = model3_UBCF_cosine, newdata = evalknown, n = items_to_recommend,
type = "topNList")
model3_accuracy <- calcPredictionAccuracy(x = model3_prediction, data = evalunknown,
byUser = FALSE) # byUser =FALSE for model level performance metrics
model3_accuracy## RMSE MSE MAE
## 1.0190525 1.0384679 0.8134037Comparing Models With Varying Values Of Recommendation
# Evaluating different models, we can define a list with them We add random and
# popular to the model methods of evaluation in this comparison
models_to_evaluate <- list(IBCF_cos = list(name = "IBCF", param = list(method = "cosine")),
UBCF_cos = list(name = "UBCF", param = list(method = "cosine")))
# In order to evaluate the models properly, we need to test them, varying the
# number of flavors , as follows
n_recommendations <- c(1, 3, 5, 7, 10, 12, 15)
list_results <- evaluate(x = eval_sets, method = models_to_evaluate, n = n_recommendations)
plot(list_results, annotate = 1, legend = "topleft")
title("ROC curve")
plot(list_results, "prec/rec", annotate = 1, legend = "bottomright")
title("Precision-recall")
listerror <- evaluate(x = eval_sets, method = models_to_evaluate, type = "ratings")
modelcomp <- as.data.frame(sapply(avg(listerror), rbind))
modelcompnew <- as.data.frame(t(as.matrix(modelcomp)))
colnames(modelcompnew) <- c("RMSE", "MSE", "MAE")pander(modelcompnew, caption = "Model Comparison Based On Varying Recommendation")| RMSE | MSE | MAE | |
|---|---|---|---|
| IBCF_cos | 1.268 | 1.609 | 0.9409 |
| UBCF_cos | 1.017 | 1.036 | 0.8105 |
Online Evaluation
Results from offline experimentation have limited predictive power for online user behavior. Although cross validation is one technique to make the recommendations more robust, the online evaluation better points to insights as to which kind of recommender is earning dividends, ie. what is the user experience ( interaction ) of the recommendations made.
The split validation performed online is an A/B testing ( also ccalled multivariate testing), which deviates different sets of users to different Rec Sys and the real time performance of each can be gauged
Also, implicit behavior data such as time-spent reading and links followed, gives more fuel to the recommendations that could be made.
The Click-Through Rate (CTR) and the Conversion Rate (CR) of the recommendations can be measured in an online evaluation which gives a good estimate of the Rec Sys performance.
An empiric evaluation with a dummy simualted session can be done to study the sanit of recommendations.
Steps that could be put in designing an online evaluation
- Do an RFM analysis , and customer segmentation.
- An A/B testing to evaluate and find the different recsys at work (we could have content /collaborative or monolithic hybrid )
- Based on RFM analysis and CLV (customer lifetime value), the top segments customers can be given email recommendations
- Further on depending on user experience of the recommendations i.e. ow the user interacts with the recommendations, whether he/she ends up buying the product, if so then an incentive could be offered (could be coupon off for next purchase ). Strategies to keep the user engaged on in the website for longer time could be used.
- The user engagement time could be used to gauge interest and offer incentive to promote higher ROI.
- Ranking metrics are MAP and NDCG. ( Mean average precision / Normalized Discounted Cumulative Gain) could be performed