Project 3
Sie Siong Wong
6/19/2020
Introduction
The goal of this project is to practice working with Matrix Factorization techniques. The task is to implement a matrix factorization method. But I will create movie recommender systems using the Singular Value Decomposition (SVD), Funk Singular Value Decomposition (SVDF), and Alternating Least Squares (ALS) algorithms available from the recommenderlab package, and evaluate and compare the accuracy of these 3 techniques.
Load R Packages
# Load required packages
library(tidyverse)
library(recommenderlab)
library(psych)
library(reshape2)
library(ggpubr)
library(purrr)Load Data
Both the movies and ratings datasets are taken from https://grouplens.org/datasets/movielens/latest/. There are two versions of these datasets. The small datasets are chosen due to limited computing power available on my laptop.
# Load movies and ratings datasets
movies <- read.csv("https://raw.githubusercontent.com/SieSiongWong/DATA-612/master/movies.csv")
ratings <- read.csv("https://raw.githubusercontent.com/SieSiongWong/DATA-612/master/ratings.csv")
head(movies)## movieId title
## 1 1 Toy Story (1995)
## 2 2 Jumanji (1995)
## 3 3 Grumpier Old Men (1995)
## 4 4 Waiting to Exhale (1995)
## 5 5 Father of the Bride Part II (1995)
## 6 6 Heat (1995)
## genres
## 1 Adventure|Animation|Children|Comedy|Fantasy
## 2 Adventure|Children|Fantasy
## 3 Comedy|Romance
## 4 Comedy|Drama|Romance
## 5 Comedy
## 6 Action|Crime|Thrillerhead(ratings)## userId movieId rating timestamp
## 1 1 1 4 964982703
## 2 1 3 4 964981247
## 3 1 6 4 964982224
## 4 1 47 5 964983815
## 5 1 50 5 964982931
## 6 1 70 3 964982400Data Exploration & Preprocessing
Statistic Summary
The movies dataset contain 3 columns and 9742 observations. The ratings dataset contain 4 columns and 100,836 observations.
We can see that the mean of the rating variable is at 3.5 and the standard deviation is 1.04 and the distribution is left skewed a little.
# Summary of movies and ratings datasets
str(movies)## 'data.frame': 9742 obs. of 3 variables:
## $ movieId: int 1 2 3 4 5 6 7 8 9 10 ...
## $ title : Factor w/ 9737 levels "'71 (2014)","'burbs, The (1989)",..: 8895 4662 3676 9250 2979 3859 7348 8834 8159 3544 ...
## $ genres : Factor w/ 951 levels "(no genres listed)",..: 352 418 733 688 635 261 733 400 2 134 ...str(ratings)## 'data.frame': 100836 obs. of 4 variables:
## $ userId : int 1 1 1 1 1 1 1 1 1 1 ...
## $ movieId : int 1 3 6 47 50 70 101 110 151 157 ...
## $ rating : num 4 4 4 5 5 3 5 4 5 5 ...
## $ timestamp: int 964982703 964981247 964982224 964983815 964982931 964982400 964980868 964982176 964984041 964984100 ...# Statistical summary of rating variable
describe(ratings$rating)## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 100836 3.5 1.04 3.5 3.57 0.74 0.5 5 4.5 -0.64 0.12 0Matrix Conversion
First of all, we have to convert the raw dataset into matrix format that can be used for building recommendation systems through the recommenderlab package.
# Convert to rating matrix
ratings_matrix <- dcast(ratings, userId~movieId, value.var = "rating", na.rm = FALSE)
# remove userid column
ratings_matrix <- as.matrix(ratings_matrix[,-1])
# Convert rating matrix into a recommenderlab sparse matrix
ratings_matrix <- as(ratings_matrix, "realRatingMatrix")
ratings_matrix## 610 x 9724 rating matrix of class 'realRatingMatrix' with 100836 ratings.Each row of the ratings_matrix corresponds to a user, and each column corresponds to a movie id. There are more than 610 x 9724 = 5,931,640 combinations between a user and a movie id. So, it requires 5,931,640 cells to build the matrix. As we know that not every user has watched every movie. There are only 100,836 observations, so this matrix is sparse.
Exploring the Values of the Rating
# Convert the ratings matrix into a vector
vec_ratings <- as.vector(ratings_matrix@data)
# Unique ratings
unique(vec_ratings)## [1] 4.0 0.0 4.5 2.5 3.5 3.0 5.0 0.5 2.0 1.5 1.0# Count the occurrences for each rating
table_ratings <- table(vec_ratings)
table_ratings## vec_ratings
## 0 0.5 1 1.5 2 2.5 3 3.5 4 4.5
## 5830804 1370 2811 1791 7551 5550 20047 13136 26818 8551
## 5
## 13211As we know a rating equal to 0 means a missing value in the matrix, so we can remove all of them before building a frequency plot of the ratings to visualize the ratings distribution.
# Remove zero rating and convert the vector to factor
vec_ratings <- vec_ratings[vec_ratings != 0] %>% factor()
# Visualize through qplot
qplot(vec_ratings, fill = I("steelblue")) +
ggtitle("Distribution of the Ratings") +
labs(x = "Ratings")
Explore Most Viewed Movies
# Search for the top 10 most viewed movies
most_views <- colCounts(ratings_matrix) %>% melt()
most_views <- tibble::rowid_to_column(most_views, "movieId") %>%
rename(count = value) %>%
merge(movies, by = "movieId") %>%
top_n(count, n = 10)
# Visualize the top 10 most viewed movies
ggplot(most_views, aes(x = reorder(title, count), y = count, fill = 'lightblue')) +
geom_bar(stat = "identity") +
theme(axis.text.x =element_text(angle = 60, hjust = 1)) +
ggtitle("Top 10 Most Viewed Movies") +
theme(legend.position = "none", axis.title.x = element_blank())
Explore the Average Ratings
# Average rating for each movie
avg_ratings_mv <- colMeans(ratings_matrix)
# Average rating for each user
avg_ratings_us <- rowMeans(ratings_matrix)
# Visualize the distribution of the average movie rating
avg1 <- qplot(avg_ratings_mv) +
stat_bin(binwidth = 0.1) +
ggtitle("Average Movie Rating Distribution") +
labs(x = 'Average Rating', y = 'Frequency')
# Visualize the distribution of the average user rating
avg2 <- qplot(avg_ratings_us) +
stat_bin(binwidth = 0.1) +
ggtitle("Average User Rating Distribution") +
labs(x = 'Average Rating', y = 'Frequency')
figure <- ggarrange(avg1, avg2, ncol = 1, nrow = 2)
figure
From both of the plots above, we can see that there are some movies have only few ratings and some users only rated few movies. For building recommendation systems, we don’t want take these movies and users into account as these ratings might be biased. To remove these least-watched movies and least-rated users, we can set a threshold of minimum number for example, 50.
# Filter users and movies more than 50
ratings_matrix <- ratings_matrix[rowCounts(ratings_matrix) > 50, colCounts(ratings_matrix) > 50]
# Average rating for each movie
avg_ratings_mv2 <- colMeans(ratings_matrix)
# Average rating for each user
avg_ratings_us2 <- rowMeans(ratings_matrix)
# Visualize the distribution of the average movie rating
avg3 <- qplot(avg_ratings_mv2) +
stat_bin(binwidth = 0.1) +
ggtitle("Average Movie Rating Distribution") +
labs(x = 'Average Rating', y = 'Frequency')
# Visualize the distribution of the average user rating
avg4 <- qplot(avg_ratings_us2) +
stat_bin(binwidth = 0.1) +
ggtitle("Average User Rating Distribution") +
labs(x = 'Average Rating', y = 'Frequency')
figure2 <- ggarrange(avg1, avg2, avg3, avg4,
labels = c("A", "B", "C", "D"),
ncol = 2, nrow = 2)
figure2
The effect of removing those potential biased ratings to the distribution is obvious. From above figure, we can see that the curve is much narrow and has less variance compared to before.
Recommenderlab
Let’s see what are some of the recommender options are available from the recommenderlab package applicable to the realRatingMatrix objects for building recommendation systems.
# Display the list of options for real rating matrix
rec <- recommenderRegistry$get_entries(dataType = "realRatingMatrix")
names(rec)## [1] "ALS_realRatingMatrix" "ALS_implicit_realRatingMatrix"
## [3] "IBCF_realRatingMatrix" "LIBMF_realRatingMatrix"
## [5] "POPULAR_realRatingMatrix" "RANDOM_realRatingMatrix"
## [7] "RERECOMMEND_realRatingMatrix" "SVD_realRatingMatrix"
## [9] "SVDF_realRatingMatrix" "UBCF_realRatingMatrix"“SVD_realRatingMatrix”, “SVDF_realRatingMatrix”, “ALS_realRatingMatrix” are the three models used to demonstrate in this project. SVD_realRatingMatrix is the SVD approximation with column-mean imputation. SVDF_realRatingMatrix is the Funk SVD with stochastic gradient descend. ALS_realRatingMatrix is the ALS based on latent factors.
# Description for the SVD method
lapply(rec, `[[`, 'description') %>% `[[`('SVD_realRatingMatrix')## [1] "Recommender based on SVD approximation with column-mean imputation."# Description for the SVDF method
lapply(rec, `[[`, 'description') %>% `[[`('SVDF_realRatingMatrix')## [1] "Recommender based on Funk SVD with gradient descend (https://sifter.org/~simon/journal/20061211.html)."# Description for the SVDF method
lapply(rec, `[[`, 'description') %>% `[[`('ALS_realRatingMatrix')## [1] "Recommender for explicit ratings based on latent factors, calculated by alternating least squares algorithm."# Default parameter values for the SVD method
rec$SVD_realRatingMatrix$parameters## $k
## [1] 10
##
## $maxiter
## [1] 100
##
## $normalize
## [1] "center"# Default parameter values for the SVDF method
rec$SVDF_realRatingMatrix$parameters## $k
## [1] 10
##
## $gamma
## [1] 0.015
##
## $lambda
## [1] 0.001
##
## $min_epochs
## [1] 50
##
## $max_epochs
## [1] 200
##
## $min_improvement
## [1] 1e-06
##
## $normalize
## [1] "center"
##
## $verbose
## [1] FALSE# Default parameter values for the ALS method
rec$ALS_realRatingMatrix$parameters## $normalize
## NULL
##
## $lambda
## [1] 0.1
##
## $n_factors
## [1] 10
##
## $n_iterations
## [1] 10
##
## $min_item_nr
## [1] 1
##
## $seed
## NULLRecommendation Models
Split Dataset
We will build the recommender models by using the splitting method that randomly assign a predefined proportion of the users to the training set and all others to the test set. For this project, we allocate 80% of the dataset to the training set and 20% to the test set. 10 ratings per user will be given to the recommender to make predictions and the other ratings are held out for computing prediction accuracy.
evaluation <- evaluationScheme(ratings_matrix, method = "split", train = 0.8, given = 10)
evaluation## Evaluation scheme with 10 items given
## Method: 'split' with 1 run(s).
## Training set proportion: 0.800
## Good ratings: NA
## Data set: 378 x 436 rating matrix of class 'realRatingMatrix' with 36214 ratings.train <- getData(evaluation, "train")
train## 302 x 436 rating matrix of class 'realRatingMatrix' with 28477 ratings.test_known <- getData(evaluation, "known")
test_known## 76 x 436 rating matrix of class 'realRatingMatrix' with 760 ratings.test_unknown <- getData(evaluation, "unknown")
test_unknown## 76 x 436 rating matrix of class 'realRatingMatrix' with 6977 ratings.SVD
Create a recommender based on SVD approximation with column-mean imputation and using 10 number of features (rank of approximation).
# Create an item-based CF recommender using training data
rec_svd <- Recommender(data = train, method = "SVD",
parameter = list(k = 10))
# Create predictions for the test items using known ratings with type as ratings
pred_svd_acr <- predict(object = rec_svd, newdata = test_known, type = "ratings")
# Create predictions for the test items using known ratings with type as top n recommendation list
pred_svd_n <- predict(object = rec_svd, newdata = test_known, n = 5)Exploring the Recommender Model on the Test Set
Top 5 recommendations for the first 5 users.
# Recommendations for the first 5 users.
first_5_users <- pred_svd_n@items[1:5] %>% data.frame()
colnames(first_5_users) <- c("user1", "user2", "user3", "user4", "user5")
first_5_users <- first_5_users %>% melt() %>%
rename(movieId = value) %>%
merge(movies, by = "movieId") %>%
rename(users = variable) %>%
select(users:title) %>%
group_by(users) %>%
mutate(id = 1:n()) %>%
spread(users, title, convert = TRUE) %>%
select(-id)
first_5_users## # A tibble: 5 x 5
## user1 user2 user3 user4 user5
## <chr> <chr> <chr> <chr> <chr>
## 1 French Twist (Gazo~ Chungking Expre~ To Die For~ Batman Fo~ Tales from the Cr~
## 2 Once Upon a Time..~ Down Periscope ~ Mute Witne~ Boys on t~ Village of the Da~
## 3 Beautiful Girls (1~ White Man's Bur~ White Man'~ Ladybird ~ Adventures of Pri~
## 4 Interview with the~ Clerks (1994) <NA> Legends o~ Backbeat (1993)
## 5 <NA> <NA> <NA> To Live (~ <NA>From the table, we can see that not every movie id in ratings dataset exist in movies dataset. That’s why you’ll see some user 1 and user 2 only have 4 recommendations.
Distribution of the number of recommended movies
# Define a matrix with the recommendations to the test set users
rec_matrix <- as.matrix(data.frame(pred_svd_n@items))
# Define a vector with all recommendations
num_of_items <- factor(table(rec_matrix))
# Visualize the distribution of the number of recommended movies
qplot(num_of_items) + ggtitle("Distribution of the Number of Recommended Movies") + labs(x = "Number of Count")
We can see from above plot that most of the movies have been recommended only a few times, and a few movies have been recommended many times.
Top 5 most recommended movies
# Top 5 most recommended movies
top5_rec_mv <- num_of_items %>% data.frame()
top5_rec_mv <- cbind(movieId = rownames(top5_rec_mv), top5_rec_mv)
rownames(top5_rec_mv) <- 1:nrow(top5_rec_mv)
colnames(top5_rec_mv)[2] <- "count"
top5_rec_mv <- top5_rec_mv %>%
mutate_if(is.factor, ~ as.integer(levels(.x))[.x]) %>%
merge(movies, by = "movieId") %>%
top_n(count, n = 5)
top5_rec_mv <- top5_rec_mv[order(top5_rec_mv$count, decreasing = TRUE),] %>%
select(title)
top5_rec_mv## title
## 2 Usual Suspects, The (1995)
## 1 To Die For (1995)
## 3 Down Periscope (1996)
## 4 Free Willy 2: The Adventure Home (1995)
## 5 Wild Bill (1995)SVDF
Create a recommender based on Funk SVD (SVDF) with stochastic gradient descend and using 10 number of features (rank of approximation).
# Create an item-based CF recommender using training data
rec_svdf <- Recommender(data = train, method = "SVDF",
parameter = list(k = 10))
# Create predictions for the test items using known ratings with type as ratings
pred_svdf_acr <- predict(object = rec_svdf, newdata = test_known, type = "ratings")
# Create predictions for the test items using known ratings with type as top n recommendation list
pred_svdf_n <- predict(object = rec_svdf, newdata = test_known, n = 5)Exploring the Recommender Model on the Test Set
Top 5 recommendations for the first 5 users.
# Recommendations for the first 5 users.
first_5_users <- pred_svdf_n@items[1:5] %>% data.frame()
colnames(first_5_users) <- c("user1", "user2", "user3", "user4", "user5")
first_5_users <- first_5_users %>% melt() %>%
rename(movieId = value) %>%
merge(movies, by = "movieId") %>%
rename(users = variable) %>%
select(users:title) %>%
group_by(users) %>%
mutate(id = 1:n()) %>%
spread(users, title, convert = TRUE) %>%
select(-id)
first_5_users## # A tibble: 5 x 5
## user1 user2 user3 user4 user5
## <chr> <chr> <chr> <chr> <chr>
## 1 Lamerica (1994) Big Green, ~ To Die Fo~ Big Green, The (1~ Usual Suspec~
## 2 Young Poisoner's Han~ Mr. Holland~ Big Green~ Mr. Holland's Opu~ If Lucy Fell~
## 3 Burnt by the Sun (Ut~ Immortal Be~ Dunston C~ Far From Home: Th~ Awfully Big ~
## 4 Interview with the V~ Perez Famil~ Immortal ~ Immortal Beloved ~ Man of the H~
## 5 <NA> Crow, The (~ <NA> Perez Family, The~ <NA>From the table, we can see that not every movie id in ratings dataset exist in movies dataset. That’s why you’ll see some user 1, user 2, and user 5 only have 4 recommendations. Compare to the SVD approximation method, you’ll notice that the recommendations for the first 5 users are all different.
Distribution of the number of recommended movies
# Define a matrix with the recommendations to the test set users
rec_matrix <- as.matrix(data.frame(pred_svdf_n@items))
# Define a vector with all recommendations
num_of_items <- factor(table(rec_matrix))
# Visualize the distribution of the number of recommended movies
qplot(num_of_items) + ggtitle("Distribution of the Number of Recommended Movies") + labs(x = "Number of Count")
Compare to SVD approximation method, we can see from above plot that the number of the movies have been recommended much equally.
Top 5 most recommended movies
# Top 5 most recommended movies
top5_rec_mv <- num_of_items %>% data.frame()
top5_rec_mv <- cbind(movieId = rownames(top5_rec_mv), top5_rec_mv)
rownames(top5_rec_mv) <- 1:nrow(top5_rec_mv)
colnames(top5_rec_mv)[2] <- "count"
top5_rec_mv <- top5_rec_mv %>%
mutate_if(is.factor, ~ as.integer(levels(.x))[.x]) %>%
merge(movies, by = "movieId") %>%
top_n(count, n = 5)
top5_rec_mv <- top5_rec_mv[order(top5_rec_mv$count, decreasing = TRUE),] %>%
select(title)
top5_rec_mv## title
## 1 Big Green, The (1995)
## 3 Rumble in the Bronx (Hont faan kui) (1995)
## 5 Man of the House (1995)
## 2 Dunston Checks In (1996)
## 4 Immortal Beloved (1994)Compare to SVD approximation method, we can see the top 5 most recommended movies are different.
ALS
Create a recommender based on Funk SVD (SVDF) with stochastic gradient descend.
# Create an item-based CF recommender using training data
rec_als <- Recommender(data = train, method = "ALS")
# Create predictions for the test items using known ratings with type as ratings
pred_als_acr <- predict(object = rec_als, newdata = test_known, type = "ratings")
# Create predictions for the test items using known ratings with type as top n recommendation list
pred_als_n <- predict(object = rec_als, newdata = test_known, n = 5)Exploring the Recommender Model on the Test Set
Top 5 recommendations for the first 5 users.
# Recommendations for the first 5 users.
first_5_users <- pred_als_n@items[1:5] %>% data.frame()
colnames(first_5_users) <- c("user1", "user2", "user3", "user4", "user5")
first_5_users <- first_5_users %>% melt() %>%
rename(movieId = value) %>%
merge(movies, by = "movieId") %>%
rename(users = variable) %>%
select(users:title) %>%
group_by(users) %>%
mutate(id = 1:n()) %>%
spread(users, title, convert = TRUE) %>%
select(-id)
first_5_users## # A tibble: 5 x 5
## user1 user2 user3 user4 user5
## <chr> <chr> <chr> <chr> <chr>
## 1 Virtuosit~ Big Green, The (~ Sudden De~ Waterworl~ Sudden Death (1995)
## 2 Red Rock ~ Dunston Checks I~ Stargate ~ Immortal ~ Beyond Rangoon (1995)
## 3 Timecop (~ Rumble in the Br~ Bad Compa~ Only You ~ Tales from the Hood (1995)
## 4 Wyatt Ear~ If Lucy Fell (19~ <NA> To Live (~ Four Weddings and a Funera~
## 5 <NA> Boomerang (1992) <NA> Bad Girls~ Highlander III: The Sorcer~From the table, we can see that not every movie id in ratings dataset exist in movies dataset. That’s why you’ll see some user 1, user 2, and user 3 have less than 5 recommendations. Compare to SVD approximation and SVDF methods, the recommendations for each user are different.
Distribution of the number of recommended movies
# Define a matrix with the recommendations to the test set users
rec_matrix <- as.matrix(data.frame(pred_als_n@items))
# Define a vector with all recommendations
num_of_items <- factor(table(rec_matrix))
# Visualize the distribution of the number of recommended movies
qplot(num_of_items) + ggtitle("Distribution of the Number of Recommended Movies") + labs(x = "Number of Count")
Compare to SVDF method, we can see the distribution looks like the result of SVD approximation method where most of the movies have been recommended only a few times, and a few movies have been recommended many times.
Top 5 most recommended movies
# Top 5 most recommended movies
top5_rec_mv <- num_of_items %>% data.frame()
top5_rec_mv <- cbind(movieId = rownames(top5_rec_mv), top5_rec_mv)
rownames(top5_rec_mv) <- 1:nrow(top5_rec_mv)
colnames(top5_rec_mv)[2] <- "count"
top5_rec_mv <- top5_rec_mv %>%
mutate_if(is.factor, ~ as.integer(levels(.x))[.x]) %>%
merge(movies, by = "movieId") %>%
top_n(count, n = 5)
top5_rec_mv <- top5_rec_mv[order(top5_rec_mv$count, decreasing = TRUE),] %>%
select(title)
top5_rec_mv## title
## 1 Big Green, The (1995)
## 5 Basketball Diaries, The (1995)
## 6 Far From Home: The Adventures of Yellow Dog (1995)
## 4 Rumble in the Bronx (Hont faan kui) (1995)
## 2 Mr. Holland's Opus (1995)
## 3 Dunston Checks In (1996)Again, compare to SVD approximation and SVDF methods, the top 5 most recommended movies are different except the Big Green, The (1995) movie is same as result from SVDF method.
Evaluate & Compare
Evaluate the accuracy of SVD approximation, Funk SVD, and ALS recommenders on unknown ratings.
# Evaluate the SVD approximated recommendations on unknown ratings
acr_svd <- calcPredictionAccuracy(pred_svd_acr, test_unknown)
# Evaluate the Funk SVD recommendations on unknown ratings
acr_svdf <- calcPredictionAccuracy(pred_svdf_acr, test_unknown)
# Evaluate the ALS recommendations on unknown ratings
acr_als <- calcPredictionAccuracy(pred_als_acr, test_unknown)
acr <- rbind(SVD = acr_svd, SVDF = acr_svdf, ALS = acr_als)
acr## RMSE MSE MAE
## SVD 0.9438573 0.8908666 0.7246573
## SVDF 0.9029110 0.8152482 0.6890921
## ALS 0.9445920 0.8922541 0.7308595Let’s try another evaluation scheme with “Cross Validation” method with 5-fold cross validation.
# Setup the evaluation scheme
evaluation_2 <- evaluationScheme(ratings_matrix,
method = "cross",
k = 5,
train = 0.8,
given = 10,
goodRating = 3
)
evaluation_2## Evaluation scheme with 10 items given
## Method: 'cross-validation' with 5 run(s).
## Good ratings: >=3.000000
## Data set: 378 x 436 rating matrix of class 'realRatingMatrix' with 36214 ratings.# Set up list of algorithms
algorithms <- list(
"SVD Approximation" = list(name = "SVD", parameter = list(k = 10)),
"Funk SVD" = list(name = "SVDF", parameter = list(k = 10)),
"Alternating Least Squares" = list(name = "ALS")
)
# Estimate the models with top N recommendation lists
results <- evaluate(evaluation_2,
algorithms,
type = "topNList",
n = c(1, 3, 5, 10, 15, 20)
)## SVD run fold/sample [model time/prediction time]
## 1 [0.09sec/0.11sec]
## 2 [0.05sec/0.09sec]
## 3 [0.06sec/0.1sec]
## 4 [0.08sec/0.08sec]
## 5 [0.07sec/0.1sec]
## SVDF run fold/sample [model time/prediction time]
## 1 [27.98sec/5.56sec]
## 2 [28.64sec/6.22sec]
## 3 [27.95sec/5.48sec]
## 4 [25.88sec/4.58sec]
## 5 [27.46sec/5.67sec]
## ALS run fold/sample [model time/prediction time]
## 1 [0sec/32.08sec]
## 2 [0.02sec/32.55sec]
## 3 [0sec/32.66sec]
## 4 [0sec/32.37sec]
## 5 [0sec/32.88sec]results## List of evaluation results for 3 recommenders:
## Evaluation results for 5 folds/samples using method 'SVD'.
## Evaluation results for 5 folds/samples using method 'SVDF'.
## Evaluation results for 5 folds/samples using method 'ALS'.# Create a function to get average of precision, recall, TPR, FPR
avg_cf_matrix <- function(results) {
avg <- results %>%
getConfusionMatrix() %>%
as.list()
as.data.frame( Reduce("+", avg) / length(avg)) %>%
mutate(n = c(1, 3, 5, 10, 15, 20)) %>%
select('n', 'precision', 'recall', 'TPR', 'FPR')
}
# Using map() to iterate the avg function across both models
results_tbl <- results %>% map(avg_cf_matrix) %>% enframe() %>% unnest()## Warning: `cols` is now required when using unnest().
## Please use `cols = c(value)`results_tbl## # A tibble: 18 x 6
## name n precision recall TPR FPR
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 SVD Approximation 1 0.487 0.00791 0.00791 0.00139
## 2 SVD Approximation 3 0.438 0.0206 0.0206 0.00459
## 3 SVD Approximation 5 0.407 0.0314 0.0314 0.00810
## 4 SVD Approximation 10 0.362 0.0546 0.0546 0.0176
## 5 SVD Approximation 15 0.335 0.0736 0.0736 0.0277
## 6 SVD Approximation 20 0.316 0.0912 0.0912 0.0381
## 7 Funk SVD 1 0.528 0.00941 0.00941 0.00129
## 8 Funk SVD 3 0.456 0.0228 0.0228 0.00448
## 9 Funk SVD 5 0.423 0.0335 0.0335 0.00791
## 10 Funk SVD 10 0.368 0.0557 0.0557 0.0176
## 11 Funk SVD 15 0.342 0.0758 0.0758 0.0275
## 12 Funk SVD 20 0.328 0.0947 0.0947 0.0376
## 13 Alternating Least Squares 1 0.372 0.00607 0.00607 0.00176
## 14 Alternating Least Squares 3 0.343 0.0162 0.0162 0.00550
## 15 Alternating Least Squares 5 0.345 0.0269 0.0269 0.00912
## 16 Alternating Least Squares 10 0.336 0.0519 0.0519 0.0186
## 17 Alternating Least Squares 15 0.326 0.0737 0.0737 0.0283
## 18 Alternating Least Squares 20 0.322 0.0970 0.0970 0.0380# Plot ROC curves for each model
results_tbl %>%
ggplot(aes(FPR, TPR, color = fct_reorder2(as.factor(name), FPR, TPR))) +
geom_line() +
geom_label(aes(label = n)) +
labs(title = "ROC Curves", color = "Model") +
theme_grey(base_size = 14)
# Plot Precision-Recall curves for each model
results_tbl %>%
ggplot(aes(recall, precision, color = fct_reorder2(as.factor(name), recall, precision))) +
geom_line() +
geom_label(aes(label = n)) +
labs(title = "Precision-Recall Curves", colour = "Model") +
theme_grey(base_size = 14)
Summary
From both the evaluation results, the more advance technique Funk SVD (SVDF) model with stochastic gradient descent is the clear winner. We can see its RMSE and MAE are the lowest among the 3 models. Also, we can clearly see from the ROC curves that the SVDF model achieves higher True Positive Rate (TPR) for any given level of False Negative Rate (FPR) and has the highest area under the curve (AUC). This means that the SVDF model is producing higher number of relevant recommendations (true positives) for the same level of non-relevant recommendations (false positives). In addition to that, the SVDF model also has the highest AUC in Precision-Recall curves and achieves higher Precision for any given level of Recall. You notice that the values of Recall is one decimal digit smaller than the Precision values. This low recall and high precision means that the SVDF model is only returning few relevant recommendations but highly accurate.
Reference
Gorakala, K.G. & Usuelli, M. (2015, Sept). Building a Recommendation System with R (pp. 50-92). Packt Publishing Ltd.
Hashler, M. & Vereet, B. (2019, Aug 27). Package ‘recommenderlab’. CRAN. Retrieved from https://cran.r-project.org/web/packages/recommenderlab/recommenderlab.pdf.