1 Project Introduction

Music streaming service companies such as Spotify and Pandora have built recommendation systems to recommend songs and artists to users based upon user information. These systems mainly leverage user based collaborative filtering and content based models to implement the system. They continously learn fron the users behvior, interest and listening pattern.

The goal of this project is to implement a musical artist recommendations. Below are the details of the system implementaion:

  • Build a recommendation model using user-based collaborative filtering algorithm or UBCF
  • Recommend Similar Artists via the Artist-Genre Matrix
  • Recommend Artists for a Given User

2 Project Data - HetRec 2011

The datasets were generated by the Information Retrieval Group at Universidad Autónoma de Madrid (http://ir.ii.uam.es). Before using these datasets, please review the README files for the usage license and other details.

link: https://grouplens.org/datasets/hetrec-2011/

This dataset contains social networking, tagging, and music artist listening information from a set of 2K users from Last.fm online music system. http://www.last.fm

Data statistics

  • 1892 users
  • 17632 artists
  • 12717 bi-directional user friend relations, i.e. 25434 (user_i, user_j) pairs
    • avg. 13.443 friend relations per user
  • 92834 user-listened artist relations, i.e. tuples [user, artist, listeningCount]
    • avg. 49.067 artists most listened by each user
    • avg. 5.265 users who listened each artist
  • 11946 tags
  • 186479 tag assignments (tas), i.e. tuples [user, tag, artist]
    • avg. 98.562 tas per user
    • avg. 14.891 tas per artist
    • avg. 18.930 distinct tags used by each user
    • avg. 8.764 distinct tags used for each artist

3 Data Loading

artists.dat file contains information about music artists listened and tagged by the users.

# load list of last.fm artists: 
artists <- read_delim("https://raw.githubusercontent.com/niteen11/MSDS/master/DATA643/dataset/hetrec2011-lastfm-2k/artists.dat", delim = "\t") %>% select(id, name)
dim(artists)
## [1] 16423     2
kable(head(artists,10))
id name
1 MALICE MIZER
2 Diary of Dreams
3 Carpathian Forest
4 Moi dix Mois
5 Bella Morte
6 Moonspell
7 Marilyn Manson
8 DIR EN GREY
9 Combichrist
10 Grendel

user_artists.dat file contains the artists listened by each user. It also provides a listening count for each [user, artist] pair.

# loading last.fm user_artists file
ratings <- read.table("https://raw.githubusercontent.com/niteen11/MSDS/master/DATA643/dataset/hetrec2011-lastfm-2k/user_artists.dat", header = TRUE, sep = "", stringsAsFactors = FALSE)
dim(ratings)
## [1] 92834     3
kable(head(ratings,10))
userID artistID weight
2 51 13883
2 52 11690
2 53 11351
2 54 10300
2 55 8983
2 56 6152
2 57 5955
2 58 4616
2 59 4337
2 60 4147

4 Exploratory Data Analysis and Visualization

4.3 Create User-Artist Matrix

One of the goals for this project include the use of a user-based collaborative filter for purposes of generating recommendations of musical artists to last.fm users, we need to convert our reduced user-artists data to a user-item matrix

# convert to wide format
lastfm_mat <- spread(lastfm.ua, artistID, weight)
user_ids <- as.vector(lastfm_mat$userID)
lastfm_rating_mat <- as.matrix(lastfm_mat[,2:ncol(lastfm_mat)])

Calculate density / sparsity

nratings <- length(as.vector(lastfm_rating_mat))
nratings
## [1] 1524050
sum(!is.na(as.vector(lastfm_rating_mat)) ) / 
1 - sum(!is.na(as.vector(lastfm_rating_mat)) ) / nratings
## [1] 51364.97

4.4 Create Artist - Genre Matrix

For content-based recommendation efforts for this project, we need to create artist-genre matrix and provide similar artist recommendations to users.

# convert to wide format
tmp_mat <- spread(user.topTags, tagID, Count)
ag_artistID <- as.vector(tmp_mat$artistID)
art.genre.mat <- as.matrix(tmp_mat[,2:ncol(tmp_mat)])

Validating the content of artist-genre matrix against original user-tags data

nrow(subset(users.tags, artistID == 89 & tagID == 24))
## [1] 99
nrow(subset(users.tags, artistID == 72 & tagID == 18))
## [1] 68

Calculate density / sparsity

ntags <- length(as.vector(art.genre.mat))
ntags
## [1] 163000
sum(!is.na(as.vector(art.genre.mat)) ) / ntags
## [1] 0.09107975
1 - sum(!is.na(as.vector(art.genre.mat)) ) / ntags
## [1] 0.9089202

The artist-genre matrix can be binarized as follows:

bin_art.gen.mat <- art.genre.mat
bin_art.gen.mat[,][is.na(bin_art.gen.mat[,])] <- 0
bin_art.gen.mat[,][bin_art.gen.mat[,] > 0] <- 1

The user-item matrix can be binarized as follows:

bin.ua.rating.mat <- lastfm_rating_mat
bin.ua.rating.mat[,][is.na(bin.ua.rating.mat[,])] <- 0
bin.ua.rating.mat[,][bin.ua.rating.mat[,] > 0] <- 1

5 Building a User-Based Collaborative Filter

In this model building section, we will take a look at different models, algorightms and techniques. We’ll also verify that how the model real rating matrix and binary rating matrix perform.

5.1 Real Rating Matrix

ratings_matrix <- as(bin.ua.rating.mat, "realRatingMatrix")
ratings_matrix
## 1870 x 815 rating matrix of class 'realRatingMatrix' with 1524050 ratings.
image(ratings_matrix[1:100, 1:100], main = "Visualization of Real Ratings Matrix")

5.2 Binary Rating Matrix

userArtist_binaryMat <- as(bin.ua.rating.mat,"binaryRatingMatrix")
userArtist_binaryMat
## 1870 x 815 rating matrix of class 'binaryRatingMatrix' with 51365 ratings.
image(userArtist_binaryMat[1:100, 1:100], main = "Visualization of Binary Ratings Matrix")

In order to recommend items to new users, collaborative filtering estimates the ratings of items that are not yet listened Then, it recommends the top-rated items. We can evaluate the model by comparing the estimated ratings with the real ones.

e <- evaluationScheme(ratings_matrix, method="split", train=0.8, k=1, given=10, goodRating=1 )
e_bin <- evaluationScheme(userArtist_binaryMat, method="split", train=0.8, given = 1, goodRating = 1)
ubcf_rec <- Recommender(getData(e, "train"), "UBCF")
ibcf_rec <- Recommender(getData(e, "train"), "IBCF")
rand_rec <- Recommender(getData(e, "train"), "RANDOM")
pop_rec <- Recommender(getData(e, "train"), "POPULAR")
svd_rec <- Recommender(getData(e, "train"), "SVD")
bin_rec <-  Recommender(getData(e_bin, "train"), "UBCF", parameter = list(method = "Jaccard"))
ubcf_pred <- predict(ubcf_rec, getData(e, "known"), type="ratings")
ibcf_pred <- predict(ibcf_rec, getData(e, "known"), type="ratings")
rand_pred <- predict(rand_rec, getData(e, "known"), type="ratings")
pop_pred <- predict(pop_rec, getData(e, "known"), type="ratings")
svd_pred <- predict(svd_rec, getData(e, "known"), type="ratings")
bin_pred <- predict(bin_rec, getData(e_bin, "known"))
errs <- rbind(
  ubcf = calcPredictionAccuracy(ubcf_pred, getData(e, "unknown")), 
  ibcf = calcPredictionAccuracy(ibcf_pred, getData(e, "unknown")), 
  rand = calcPredictionAccuracy(rand_pred, getData(e, "unknown")), 
  pop = calcPredictionAccuracy(pop_pred, getData(e, "unknown")),
  svd = calcPredictionAccuracy(svd_pred, getData(e, "unknown")),
  bin = calcPredictionAccuracy(bin_pred, getData(e_bin, "unknown"),given = 10, goodRating = 1)
)
## Warning in rbind(ubcf = calcPredictionAccuracy(ubcf_pred, getData(e,
## "unknown")), : number of columns of result is not a multiple of vector
## length (arg 1)

Two accuracy metrics are as follows:

  • Precision: This is the percentage of recommended items that have been listened. It’s the number of FP divided by the total number of positives (TP + FP).

  • Recall: This is the percentage of listented items that have been recommended. It’s the number of TP divided by the total number of artists listened (TP + FN). It’s also equal to the True Positive Rate.

kable(errs)
TP FP FN TN precision recall TPR FPR
ubcf 0.2099523 0.0440800 0.1390747 0.2099523 0.0440800 0.1390747 0.2099523 0.0440800
ibcf 0.4612241 0.2127277 0.2289113 0.4612241 0.2127277 0.2289113 0.4612241 0.2127277
rand 0.4789870 0.2294285 0.3001085 0.4789870 0.2294285 0.3001085 0.4789870 0.2294285
pop 0.1852863 0.0343310 0.0799117 0.1852863 0.0343310 0.0799117 0.1852863 0.0343310
svd 0.1884342 0.0355075 0.0647944 0.1884342 0.0355075 0.0647944 0.1884342 0.0355075
bin 3.2834225 6.7165775 22.9786096 772.0213904 0.3283422 0.1364956 0.1364956 0.0086011

  • True Positive Rate (TPR): This is the percentage of listented items that have been recommended. It’s the number of TP divided by the number of listented items (TP + FN).

  • False Positive Rate (FPR): This is the percentage of not listented items that have been recommended. It’s the number of FP divided by the number of not listented items (FP + TN)

We can clearly see how binraizing the data really making a big difference here in terms of overall performance.

algorithms <- list("Random" = list(name="RANDOM", param=NULL),
                   "Popular" = list(name="POPULAR", param=NULL),
                   "UBCF"= list(name="UBCF", param=list(nn=50)),
                   "IBCF"= list(name="IBCF", param=list(k=50)),
                   "SVD"= list(name="SVD")
                   #"BIN_UBCF"= list(name="UBCF")
                   )

results <- evaluate(e, algorithms, type = "topNList", n=c(1, 5, 10, 20, 30, 50))
## RANDOM run fold/sample [model time/prediction time]
##   1  [0.04sec/0.97sec] 
## POPULAR run fold/sample [model time/prediction time]
##   1  [0.45sec/2.85sec] 
## UBCF run fold/sample [model time/prediction time]
##   1  [0.22sec/7.27sec] 
## IBCF run fold/sample [model time/prediction time]
##   1  [14.69sec/0.26sec] 
## SVD run fold/sample [model time/prediction time]
##   1  [1.36sec/1.01sec]
results_bin <- evaluate(e_bin, "UBCF", type = "topNList", n=c(1, 5, 10, 20, 30, 50))
## UBCF run fold/sample [model time/prediction time]
##   1  [0.05sec/4.12sec]
plot(results_bin, "prec/rec")
title("Binary Rating prec/rec ")

In order to evaluate the models properly, we need to test them, varying the number of items.

plot(results, "prec/rec", annotate=c(1,3), legend="bottomright")
title("Real Rating prec/rec ")

plot(results_bin, "ROC")
title("Binary Rating ROC ")

plot(results, "ROC", annotate=c(4, 3))
title("Real Rating prec/rec ")

Now checking for the suppress warnings for real rating matrix

eval_results <- suppressWarnings(evaluate(x =e , method = algorithms, n = seq(10, 100, 10)))
## RANDOM run fold/sample [model time/prediction time]
##   1  [0.01sec/0.75sec] 
## POPULAR run fold/sample [model time/prediction time]
##   1  [0.23sec/1.83sec] 
## UBCF run fold/sample [model time/prediction time]
##   1  [0.21sec/7.03sec] 
## IBCF run fold/sample [model time/prediction time]
##   1  [13.03sec/0.35sec] 
## SVD run fold/sample [model time/prediction time]
##   1  [0.37sec/1.04sec]
plot(eval_results, "prec/rec", annotate = T, main = "Precision-recall")
title("Precision-recall")

plot(eval_results, annotate = 1, legend = "topleft") 
title("ROC curve")

n_recommended <- 10
bin_rec <- Recommender(getData(e_bin, "train"), "UBCF", parameter = list(method = "Jaccard"))
bin_pred <- predict(bin_rec, getData(e_bin, "known"), n = n_recommended, goodRating = 1)
error_b <- calcPredictionAccuracy(bin_pred, getData(e_bin, "unknown"), 
                                  given = n_recommended, goodRating = 1)
kable(error_b, caption = "Performance Metrics")
Performance Metrics
x
TP 3.2834225
FP 6.7165775
FN 22.9786096
TN 772.0213904
precision 0.3283422
recall 0.1364956
TPR 0.1364956
FPR 0.0086011

The performance metrics for the model are shown above. As we can clearly see that for binarized UBCF the precision and recall are both comaparatively low, and also the true positive rate.

bin_pred@items[1:4]
## [[1]]
##  [1] 326  37 140 172 254 129 458 184 185 509
## 
## [[2]]
##  [1] 129  37 128 135  23 338  21 421 140 173
## 
## [[3]]
##  [1]  99  53 362 561 300 357 352 406 399 320
## 
## [[4]]
##  [1]  47 196  32 505 770  15 364  28  20  11
n_recommended <- 20
bin_pred <- predict(bin_rec, userArtist_binaryMat, n = n_recommended, goodRating = 1)
bin_pred@items[12:15]
## $`12`
##  [1] 129 128 338 145 117 131 133 331 231 326 156 418 458 340 165 376 328
## [18] 475 615 141
## 
## $`13`
##  [1] 810  99 300 357 362 561 653 408 765 599 633 406 402  47 358 450 602
## [18]  90 559 608
## 
## $`14`
##  [1] 196 404 349 215 505  79  92 195  53  75 402 209 211  89  88 399  97
## [18]  71  32 753
## 
## $`15`
##  [1] 140 128 129 338 135 132 142  23 233 145 169 229 117 458 149 130  13
## [18] 161 426 254

6 Recommend Artists for a Given User

Le’s create a data frame to hold the 10 recommendations adn then extracts a subset of 10 artists from the list of 20 generated above

#create a data frame to hold 10 recommendations for each artist
u_tenRec <- data.frame(matrix(ncol = 11, nrow = length(user_ids)))
u_tenRec[,1] <- user_ids
colnames(u_tenRec) <- c("userID", "r1", "r2", "r3", "r4", "r5",
                            "r6", "r7", "r8", "r9", "r10")
# load the recommendations
for (i in 1:length(bin_pred@items)){
  tmp_recs <- as.vector(bin_pred@items[[i]])
  num_trecs <- length(tmp_recs)
  user_arts <- unique(subset(lastfm.ua, userID == user_ids[i])$artistID)
  new_recs <- tmp_recs[!(tmp_recs %in% user_arts) ]
  num_newrecs <- length(new_recs)
  if(num_newrecs < 10) {
    new_recs <- sample(top_815$artistID[!(top_815$artistID %in% user_arts)], 10)
  }
  
  if (num_newrecs < 13) {
    topten <- new_recs[1:10]
  } else {
    t_seven <- sample(new_recs[1:10], 7)
    t_three <- sample(new_recs[11:length(new_recs)], 3)
    topten <- c(t_seven, t_three)
  } 
  topten <- sample(topten, 10)
  u_tenRec[i,2:11 ] <- topten
  
}

6.1 Recommend Top 10 Aritsts

Now, build a list of top ten artists that our recommender system suggests that they might like

# randomly select a user
user <- sample(user_ids, 1)
urecs <- sort(as.vector(subset(u_tenRec, userID == user)[2:11]) )
rec_names <- subset(artists, id %in% urecs)$name
kable(rec_names, col.names = "Artists You Might Like")
Artists You Might Like
Sade
Kosheen
The Decemberists
Sara Tavares
Katy Perry
2NE1
Crossfade
The Cribs
Jethro Tull
Watch Tower Bible and Tract Society of PA

7 Recommend Similar Artists via the Artist-Genre Matrix

In order to make recommendations of artists similar to a specific artist, we need to create an artist similarity matrix using cosine distance as the metric of similarity using similarity function of the recommenderlab package. In this way, we can calculate the “similarity” of any two artists with a cosine distance function

Create a similarity matrix using cosine distance as metric of similarity

# calculate artist similarity matrix
artist_sim <- similarity(as(bin_art.gen.mat, "binaryRatingMatrix"), method = "cosine",
                     which = "users")
artist_sim <- as(artist_sim, "matrix")
artist_sim[][] <- round(artist_sim[][],3)
colnames(artist_sim) <- ag_artistID
rownames(artist_sim) <- ag_artistID
image(as.matrix(artist_sim), main = "Artists similarity")

n_recommended <- 5
  artist <- sample(ag_artistID, 1)
a_name <- artists[artists$id == artist,]$name
arecs <- sort(artist_sim[as.character(artist),], decreasing = TRUE)[1:n_recommended]
arecs_IDs <- as.numeric(names(arecs))
arec_names <- artists[artists$id %in% arecs_IDs,]$name
table_head <- sprintf("Artists Similar to %s", a_name)
kable(arec_names, col.names = table_head)
Artists Similar to Radiohead
Coldplay
Depeche Mode
Placebo
Muse
The Beatles

8 Conclusion

This was a wonderful dataset to build recommendation system driven by collaborative user based filtering and content based model technques. We evaluated and compared multiple techniques, models and algorithms. By binarizing the data the model did work better and with the low precision and recall rate and also true positive stayed low. We made recommendation on top 10 artists for a given user and also tacked similar artists recommendations successfully. We learned how to evaluate the performance of different models in order to choose the most accurate one. There are different ways to evaluate performances that might potentially lead to different choices. Depending on the business target, the evaluation metric is different. This project also demonstrates how data and modeling tehniques should be combined to achieve the final goal.