Project Objectives

For assignment 2, start with an existing dataset of user-item ratings, such as our toy books dataset, MovieLens, Jester [http://eigentaste.berkeley.edu/dataset/] or another dataset of your choosing.

Implement at least two of these recommendation algorithms:
• Content-Based Filtering
• User-User Collaborative Filtering
• Item-Item Collaborative Filtering

You should evaluate and compare different approaches, using different algorithms, normalization techniques, similarity methods, neighborhood sizes, etc. You don’t need to be exhaustive—these are just some suggested possibilities.

You may use the course text’s recommenderlab or any other library that you want. Please provide at least one graph, and a textual summary of your findings and recommendations.

Libraries

library(recommenderlab)
library(reshape2)
library(RCurl)
library(ggplot2)
library(knitr)
library(kableExtra)
library(dplyr)
library(tidyr)
library(ggplot2)

Data Preparation and Exploration

We gathered data from section “recommended for education and development” of site https://grouplens.org/datasets/movielens/. This site provides two links, from which we chose the link for the smaller file, because the larger one (named as Full) is too large to load into github. Description of the data is as follows:

This dataset (ml-latest-small) describes 5-star rating and free-text tagging activity from MovieLens, a movie recommendation service. It contains 100836 ratings and 3683 tag applications across 9742 movies. These data were created by 610 users between March 29, 1996 and September 24, 2018. This dataset was generated on September 26, 2018. There are 4 *.csv files, from which we chose two files movies.cv and ratings.csv, for our down stream analysis.

Citation

F. Maxwell Harper and Joseph A. Konstan. 2015. The MovieLens Datasets: History and Context. ACM Transactions on Interactive Intelligent Systems (TiiS) 5, 4: 19:1–19:19. https://doi.org/10.1145/2827872

movies <- read.csv("https://raw.githubusercontent.com/forhadakbar/data612summer2020/master/Project%2002/movies.csv")
ratings <- read.csv("https://raw.githubusercontent.com/forhadakbar/data612summer2020/master/Project%2002/ratings.csv")

#Preview movies data
kable(head(movies, n = 10L)) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>%
  row_spec(0, bold = T, color = "white", background = "#fc5e5e") %>%
    scroll_box(width = "100%", height = "200px")

#Preview ratings data
kable(head(ratings, n = 10L)) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>%
  row_spec(0, bold = T, color = "white", background = "#fc5e5e") %>%
    scroll_box(width = "100%", height = "200px")

movie_ratings <- merge(ratings, movies, by="movieId")
#Preview ratings data
kable(head(movie_ratings, n = 10L)) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>%
  row_spec(0, bold = T, color = "white", background = "#fc5e5e") %>%
    scroll_box(width = "100%", height = "200px")

moviematrix <- ratings %>% select(-timestamp) %>% spread(movieId, rating)

row.names(moviematrix) <- moviematrix[, 1]

moviematrix <- moviematrix[-c(1)]

moviematrix <- as(as.matrix(moviematrix), "realRatingMatrix")

moviematrix

## 610 x 9724 rating matrix of class 'realRatingMatrix' with 100836 ratings.

dim(moviematrix)

## [1]  610 9724

head(getData.frame(moviematrix))

##      user item rating
## 1       1    1      4
## 326     1    3      4
## 434     1    6      4
## 2108    1   47      5
## 2380    1   50      5
## 2860    1   70      3

Data Visualization

# Vectorize and create unique vector.
vector_ratings <- as.vector(moviematrix@data)
unique(vector_ratings)

##  [1] 4.0 0.0 4.5 2.5 3.5 3.0 5.0 0.5 2.0 1.5 1.0

# The ratings are in the range 0-5. Let's count the occurrences of each of them.
table_ratings <- table(vector_ratings)
kable(table_ratings)

vector_ratings <- vector_ratings[vector_ratings != 0]
vector_ratings <- factor(vector_ratings)
qplot(vector_ratings) + ggtitle("Distribution of the ratings")

views_per_movie <- colCounts(moviematrix)

table_views <- data.frame(
movie = names(views_per_movie),
views = views_per_movie
)
names(table_views)[names(table_views) == "movie"] <- "movieId"
table_views <- merge(table_views, movies, by="movieId")
table_views <- table_views[order(table_views$views, decreasing =
TRUE), ]

ggplot(table_views[1:6, ], aes(x = title, y = views)) +
geom_bar(stat="identity") + theme(axis.text.x =
element_text(angle = 45, hjust = 1)) + ggtitle("Number of views
of the top movies")

average_ratings <- colMeans(moviematrix)
qplot(average_ratings, fill=..count.., geom="histogram",binwidth = 0.1, main= "Distribution of average movie rating", xlab = "Average Rating", ylab = "Count") 

# rowCounts returns the users
# colCounts returns the movies
(moviematrix <- moviematrix[rowCounts(moviematrix) > 50, colCounts(moviematrix) > 50])

## 378 x 436 rating matrix of class 'realRatingMatrix' with 36214 ratings.

dim(moviematrix)

## [1] 378 436

average_ratings <- colMeans(moviematrix)
# Histogram: average rating per user
qplot(average_ratings, fill=..count.., geom="histogram",binwidth = 0.1, main= "Histogram of average rating per user", xlab = "Average Rating", ylab = "No. of Ratings") 

Data Normalization

movie_Normalization <- normalize(moviematrix)
avg <- round(rowMeans(movie_Normalization), 5)
table(avg)

## avg
##   0 
## 378

min_Items <- quantile(rowCounts(moviematrix), 0.95)
min_Users <- quantile(colCounts(moviematrix), 0.95)

image(moviematrix[rowCounts(moviematrix) > min_Items, colCounts(moviematrix) > min_Users], 
    main = "Heatmap of the Top Users and Movies (Non-Normalized")

image(movie_Normalization[rowCounts(movie_Normalization) > min_Items, colCounts(movie_Normalization) > 
    min_Users], main = "Heatmap of the Top Users and Movies (Normalized)")

Recommendation algorithms

set.seed(80)
train_set <- sample(x = c(TRUE, FALSE), size = nrow(moviematrix), replace = TRUE, 
    prob = c(0.8, 0.2))

movie_Train <- moviematrix[train_set, ]
movie_Test <- moviematrix[!train_set, ]

Item-Item Collaborative Filtering

This is a filtering method, where similarity between items is calculated using users’ ratings of items. That means the algorithm recommends items similar to the users’ previous selections. In the algorithm, the similarities between different items are computed by one of the similarity measures, and then similarity values are used to predict ratings for user-item pairs absent in the data.

(model <- Recommender(movie_Train, method = "IBCF", parameter = list(k = 30)))

## Recommender of type 'IBCF' for 'realRatingMatrix' 
## learned using 302 users.

model

## Recommender of type 'IBCF' for 'realRatingMatrix' 
## learned using 302 users.

similarityMatrix <- getModel(model)$sim
which_max <- order(colSums(similarityMatrix > 0), decreasing = TRUE)[1:10]
topMovies <- as.data.frame(as.integer(rownames(similarityMatrix)[which_max]))
colnames(topMovies) <- c("movieId")

data <- topMovies %>% inner_join(movies, by = "movieId") %>% select(Movie = "title")

kable((data)) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>%
  row_spec(0, bold = T, color = "white", background = "#fc5e5e") %>%
    scroll_box(width = "100%", height = "200px")

(pred <- predict(model, newdata = movie_Test, n = 6))

## Recommendations as 'topNList' with n = 6 for 76 users.

user1 <- as.data.frame(movie_Test@data[1, movie_Test@data[1, ] > 0])
colnames(user1) <- c("Rating")
user1[c("movieId")] <- as.integer(rownames(user1))

data <- movies %>% inner_join(user1, by = "movieId") %>% select(Movie = "title", Rating, genres) %>% arrange(desc(Rating))

kable((data)) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>%
  row_spec(0, bold = T, color = "white", background = "#fc5e5e") %>%
    scroll_box(width = "100%", height = "200px")

recommended <- pred@itemLabels[pred@items[[1]]]
recommended <- as.data.frame(as.integer(recommended))
colnames(recommended) <- c("movieId")

data <- recommended %>% inner_join(movies, by = "movieId") %>% select(Movie = "title",genres)

kable((data)) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>%
  row_spec(0, bold = T, color = "white", background = "#fc5e5e") %>%
    scroll_box(width = "100%", height = "200px")

User-User Collaborative Filtering

(model <- Recommender(movie_Train, method = "UBCF"))

## Recommender of type 'UBCF' for 'realRatingMatrix' 
## learned using 302 users.

(pred <- predict(model, newdata = movie_Test, n = 6))

## Recommendations as 'topNList' with n = 6 for 76 users.

# Recommendations for the first user
recommended <- pred@itemLabels[pred@items[[1]]]
recommended <- as.data.frame(as.integer(recommended))
colnames(recommended) <- c("movieId")

data <- recommended %>% inner_join(movies, by = "movieId") %>% select(Movie = "title",genres)

kable((data)) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>%
  row_spec(0, bold = T, color = "white", background = "#fc5e5e") %>%
    scroll_box(width = "100%", height = "200px")

Comparison of Recommender Models

set.seed(101)

minimum = min(rowCounts(moviematrix))
minimum

## [1] 11

evaluation = evaluationScheme(data = moviematrix, method = "cross-validation", k = 10, given = 10, goodRating = 3.5)
evaluation

## Evaluation scheme with 10 items given
## Method: 'cross-validation' with 10 run(s).
## Good ratings: >=3.500000
## Data set: 378 x 436 rating matrix of class 'realRatingMatrix' with 36214 ratings.

ev_train = getData(evaluation, "train")
ev_known = getData(evaluation, "known")
ev_unknown = getData(evaluation, "unknown")

# Item
item_model = Recommender(data = ev_train, method = "IBCF", parameter = list(method = "Cosine"))
item_model_pred = predict(object = item_model, newdata = ev_known, n = 10, type = "ratings")
item = calcPredictionAccuracy(x = item_model_pred, data = ev_unknown, byUser = FALSE)

# User
user_model = Recommender(data = ev_train, method = "UBCF", parameter = list(method = "Cosine"))
user_model_pred = predict(object = user_model, newdata = ev_known, n = 10, type = "ratings")
user = calcPredictionAccuracy(x = user_model_pred, data = ev_unknown, byUser = FALSE)

# Comparison
kable(rbind(item, user))%>%
  kable_styling(bootstrap_options = c("striped","hover","condensed","responsive"),full_width   = F,position = "left",font_size = 12) %>%
  row_spec(0, background ="gray")

eval_sets = evaluationScheme(data = moviematrix, method = "cross-validation", k = 4, given = 10, goodRating = 3.5)
I_results = evaluate(x = eval_sets, method = "IBCF", n = seq(10, 100, 10))

## IBCF run fold/sample [model time/prediction time]
##   1  [0.35sec/0.03sec] 
##   2  [0.33sec/0.03sec] 
##   3  [0.34sec/0.03sec] 
##   4  [0.39sec/0.03sec]

kable(head(getConfusionMatrix(I_results)[[1]]))%>%
  kable_styling(bootstrap_options = c("striped","hover","condensed","responsive"),full_width   = F,position = "left",font_size = 12) %>%
  row_spec(0, background ="gray")

U_results = evaluate(x = eval_sets, method = "UBCF", n = seq(10, 100, 10))

## UBCF run fold/sample [model time/prediction time]
##   1  [0sec/0.12sec] 
##   2  [0sec/0.14sec] 
##   3  [0sec/0.13sec] 
##   4  [0sec/0.14sec]

kable(head(getConfusionMatrix(U_results)[[1]]))%>%
  kable_styling(bootstrap_options = c("striped","hover","condensed","responsive"),full_width   = F,position = "left",font_size = 12) %>%
  row_spec(0, background ="gray")

plot(U_results, annotate = TRUE, main = "ROC curve of UBCF")

plot(I_results, annotate = TRUE, main = "ROC curve of IBCF")

mult_models = list(
  IBCF_cos = list(name = "IBCF", param = list(method = "Cosine")),
  IBCF_pearson = list(name = "IBCF", param = list(method = "pearson")),
  UBCF_cos = list(name = "UBCF", param = list(method = "Cosine")),
  UBCF_pearson = list(name = "UBCF", param = list(method = "pearson")),
  Random = list(name = "RANDOM", param = NULL),
  Popular = list(name = "POPULAR", param = NULL)
)

# Testing models
models = evaluate(eval_sets, mult_models, n= c(1, 5, seq(10, 100, 10)))

## IBCF run fold/sample [model time/prediction time]
##   1  [0.42sec/0.05sec] 
##   2  [0.41sec/0.02sec] 
##   3  [0.57sec/0.01sec] 
##   4  [0.35sec/0.03sec] 
## IBCF run fold/sample [model time/prediction time]
##   1  [0.41sec/0.03sec] 
##   2  [0.41sec/0.03sec] 
##   3  [0.42sec/0.03sec] 
##   4  [0.41sec/0.03sec] 
## UBCF run fold/sample [model time/prediction time]
##   1  [0sec/0.15sec] 
##   2  [0.02sec/0.12sec] 
##   3  [0sec/0.12sec] 
##   4  [0.02sec/0.12sec] 
## UBCF run fold/sample [model time/prediction time]
##   1  [0sec/0.16sec] 
##   2  [0sec/0.14sec] 
##   3  [0sec/0.14sec] 
##   4  [0.02sec/0.12sec] 
## RANDOM run fold/sample [model time/prediction time]
##   1  [0sec/0.03sec] 
##   2  [0sec/0.03sec] 
##   3  [0sec/0.03sec] 
##   4  [0sec/0.04sec] 
## POPULAR run fold/sample [model time/prediction time]
##   1  [0sec/0.18sec] 
##   2  [0sec/0.28sec] 
##   3  [0sec/0.17sec] 
##   4  [0sec/0.17sec]

# Plotting models
plot(models, annotate = T, legend="topleft")

plot(models, "prec/rec", annotate = F, main="Precision/Recall", legend="topright")

Summary

By building the movie recommender system, we got a better understanding of how it works. The text book “Building Recommendation System with R” is not clear in some places. So, we had to google, to find out the implementation details.

The pros and cons of User based Collaborative Filtering (UBCF) and Item based Collaborative Filtering (IBCF) approaches.

• Recommendations of UBCF complements the item that the user was interactibg with. Since users might not be looking for direct substitutes to a movie, UBCF provides a better recommendation than IBCF.

• UBCF is memory intensive. So, with humongous number of users, processing time would be high.

• UBCF relies on historial choices of user to make future recommendations. It assumes that users’ preference to be by and large constant.