Data Preparation

library(recommenderlab)
library(tidyverse)

# https://github.com/nicolastorresr/diversity

source('diversity\\R\\AAA.R')
source('diversity\\R\\calcPredictionAccuracy.R')
source('diversity\\R\\alpha_Measures.R')
source('diversity\\R\\BinomDiv.R')
source('diversity\\R\\evaluate.R')

# Increase the density of the data
set.seed(1)
data(MovieLense)
mratings <- MovieLense[rowCounts(MovieLense) > 100, colCounts(MovieLense) > 100]
mratings

358 x 332 rating matrix of class ‘realRatingMatrix’ with 45074 ratings.

# Define the evaluation parameters
eval_sets <-
  evaluationScheme(
    data = mratings,
    method = 'cross-validation',
    given = min(rowCounts(mratings)),
    goodRating = 4, #rating_threshold
    k = 10, n_fold
  )
eval_sets

Evaluation scheme with 41 items given
Method: ‘cross-validation’ with 10 run(s).
Good ratings: >=4.000000
Data set: 358 x 332 rating matrix of class ‘realRatingMatrix’ with 45074 ratings.

Model Selection

list(name = "IBCF", param = list(k = 20))

$name
[1] "IBCF"

$param
$param$k
[1] 20

models_to_evaluate <- list(
  IBCF_cos = list(name = "IBCF", param = list(method = "cosine")),
  IBCF_cor = list(name = "IBCF", param = list(method = "pearson")),
  UBCF_cos = list(name = "UBCF", param = list(method = "cosine")),
  UBCF_cor = list(name = "UBCF", param = list(method = "pearson")),
  random = list(name = "RANDOM", param=NULL)
)

n_recommendations <- c(1, 5, seq(10, 100, 10))

list_results <- evaluate(x = eval_sets, method = models_to_evaluate, n = n_recommendations)

IBCF run fold/sample [model time/prediction time]
     1  [0.27sec/0.06sec] 
     2  [0.23sec/0.05sec] 
     3  [0.31sec/0.02sec] 
     4  [0.39sec/0.03sec] 
     5  [0.2sec/0.01sec] 
     6  [0.22sec/0.02sec] 
     7  [0.25sec/0.01sec] 
     8  [0.24sec/0.01sec] 
     9  [0.22sec/0.02sec] 
     10  [0.24sec/0.02sec] 
IBCF run fold/sample [model time/prediction time]
     1  [0.27sec/0.01sec] 
     2  [0.28sec/0.02sec] 
     3  [0.3sec/0.01sec] 
     4  [0.25sec/0.01sec] 
     5  [0.27sec/0.01sec] 
     6  [0.28sec/0sec] 
     7  [0.28sec/0.02sec] 
     8  [0.41sec/0.02sec] 
     9  [0.27sec/0.02sec] 
     10  [0.29sec/0.02sec] 
UBCF run fold/sample [model time/prediction time]
     1  [0sec/0.06sec] 
     2  [0sec/0.06sec] 
     3  [0sec/0.05sec] 
     4  [0sec/0.05sec] 
     5  [0sec/0.05sec] 
     6  [0sec/0.06sec] 
     7  [0.02sec/0.04sec] 
     8  [0sec/0.05sec] 
     9  [0.02sec/0.07sec] 
     10  [0sec/0.05sec] 
UBCF run fold/sample [model time/prediction time]
     1  [0sec/0.06sec] 
     2  [0sec/0.06sec] 
     3  [0sec/0.05sec] 
     4  [0sec/0.14sec] 
     5  [0sec/0.07sec] 
     6  [0sec/0.16sec] 
     7  [0.01sec/0.07sec] 
     8  [0sec/0.06sec] 
     9  [0.02sec/0.08sec] 
     10  [0sec/0.06sec] 
RANDOM run fold/sample [model time/prediction time]
     1  [0sec/0.01sec] 
     2  [0sec/0.02sec] 
     3  [0.01sec/0.02sec] 
     4  [0sec/0.02sec] 
     5  [0sec/0sec] 
     6  [0sec/0.02sec] 
     7  [0sec/0.01sec] 
     8  [0sec/0.02sec] 
     9  [0sec/0.02sec] 
     10  [0sec/0.02sec] 

class(list_results)

[1] "evaluationResultList"
attr(,"package")
[1] "recommenderlab"

sapply(list_results, class) == "evaluationResults"

IBCF_cos IBCF_cor UBCF_cos UBCF_cor   random 
    TRUE     TRUE     TRUE     TRUE     TRUE 

avg_matrices <- lapply(list_results, avg)

head(avg_matrices$IBCF_cos[, 5:8])

   precision      recall         TPR         FPR
1  0.2209302 0.004651566 0.004651566 0.003188392
5  0.2000000 0.022833078 0.022833078 0.016511525
10 0.1909302 0.041788635 0.041788635 0.033390307
20 0.1816279 0.076640023 0.076640023 0.067558755
30 0.1764341 0.111853691 0.111853691 0.102098657
40 0.1730814 0.147216863 0.147216863 0.136755223

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

integer(0)

plot(list_results, "prec/rec", annotate = 1, legend = "bottomright") + title("Precision-recall")

integer(0)

models_to_evaluate <- lapply(vector_k, function(k) {
  list(name = "IBCF", param = list(method = "cosine", k = k))
})

names(models_to_evaluate) <- paste0("IBCF_k_", vector_k)
# Using the same commands as we did earlier, let's build and evaluate the models:
n_recommendations <- c(1, 5, seq(10, 100, 10))
list_results <-
  evaluate(x = eval_sets, method = models_to_evaluate, n = n_recommendations)

IBCF run fold/sample [model time/prediction time]
     1  [0.25sec/0.02sec] 
     2  [0.23sec/0.02sec] 
     3  [0.27sec/0.02sec] 
     4  [0.25sec/0sec] 
     5  [0.28sec/0.02sec] 
     6  [0.24sec/0.02sec] 
     7  [0.27sec/0sec] 
     8  [0.29sec/0.02sec] 
     9  [0.26sec/0sec] 
     10  [0.32sec/0.01sec] 
IBCF run fold/sample [model time/prediction time]
     1  [0.25sec/0sec] 
     2  [0.26sec/0.02sec] 
     3  [0.25sec/0.02sec] 
     4  [0.39sec/0.02sec] 
     5  [0.29sec/0sec] 
     6  [0.25sec/0.01sec] 
     7  [0.27sec/0.01sec] 
     8  [0.25sec/0.02sec] 
     9  [0.26sec/0sec] 
     10  [0.24sec/0.02sec] 
IBCF run fold/sample [model time/prediction time]
     1  [0.26sec/0.02sec] 
     2  [0.26sec/0.01sec] 
     3  [0.24sec/0.01sec] 
     4  [0.25sec/0.01sec] 
     5  [0.27sec/0.02sec] 
     6  [0.24sec/0.01sec] 
     7  [0.26sec/0.01sec] 
     8  [0.25sec/0.02sec] 
     9  [0.27sec/0.01sec] 
     10  [0.42sec/0.01sec] 
IBCF run fold/sample [model time/prediction time]
     1  [0.25sec/0.01sec] 
     2  [0.25sec/0.01sec] 
     3  [0.25sec/0.01sec] 
     4  [0.24sec/0.02sec] 
     5  [0.25sec/0sec] 
     6  [0.25sec/0.02sec] 
     7  [0.25sec/0.02sec] 
     8  [0.25sec/0.01sec] 
     9  [0.26sec/0.02sec] 
     10  [0.33sec/0.03sec] 
IBCF run fold/sample [model time/prediction time]
     1  [0.32sec/0.03sec] 
     2  [0.29sec/0.02sec] 
     3  [0.36sec/0.01sec] 
     4  [0.36sec/0.01sec] 
     5  [0.26sec/0.01sec] 
     6  [0.41sec/0sec] 
     7  [0.26sec/0.01sec] 
     8  [0.26sec/0.02sec] 
     9  [0.31sec/0.04sec] 
     10  [0.34sec/0.04sec] 

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

integer(0)

plot(list_results, "prec/rec", ylim = c(0.16,0.25), annotate = 1, legend = "topright")
title("Precision-recall")

Model Extension

r <- evaluate(eval_sets, method = "UBCF", nMatrix = "diversity/nuggets/Nuggets_ML100K.dat", type = "topNList", 
                subtype = "BinomDiv", n = 10, param = list(method = "cosine", nn = 50))

UBCF run fold/sample [model time/prediction time]
     1  Binomial Diversity (top-10):  0.7891 0.183 0.1474 [0sec/0.05sec] 
     2  Binomial Diversity (top-10):  0.8068 0.181 0.1491 [0.01sec/0.06sec] 
     3  Binomial Diversity (top-10):  0.8102 0.1942 0.158 [0.01sec/0.08sec] 
     4  Binomial Diversity (top-10):  0.785 0.1372 0.1092 [0sec/0.04sec] 
     5  Binomial Diversity (top-10):  0.7873 0.1626 0.1303 [0sec/0.04sec] 
     6  Binomial Diversity (top-10):  0.7979 0.1903 0.1542 [0.01sec/0.05sec] 
     7  Binomial Diversity (top-10):  0.8136 0.2229 0.1851 [0sec/0.08sec] 
     8  Binomial Diversity (top-10):  0.7928 0.1689 0.1358 [0sec/0.06sec] 
     9  Binomial Diversity (top-10):  0.7841 0.1812 0.1479 [0sec/0.03sec] 
     10  Binomial Diversity (top-10):  0.7825 0.1701 0.1371 [0sec/0.07sec] 

avg(r)

   Coverage  NonRed BinomDiv
10  0.79493 0.17914  0.14541

Conclusions

In the context of a website, recommendations systems should be gauged similarly to other content and advertisements. That it, metrics such as CTR and conversion rates can start to give us an idea of whether or not live customers find the recommendations useful and appealing (Řehořek, 2016).

References:

Gorakala, S. K., & Usuelli, M. (2015). Building a recommendation system with R. Retrieved from https://learning.oreilly.com/library/view/building-a-recommendation/9781783554492/

Mendoza, M., & Torres, N. (2019). Evaluating content novelty in recommender systems. Journal of Intelligent Information Systems, 1–20. https://doi.org/10.1007/s10844-019-00548-x

Vargas, S., Baltrunas, L., Karatzoglou, A., & Castells, P. (n.d.). Coverage, Redundancy and Size-Awareness in Genre Diversity for Recommender Systems. https://doi.org/10.1145/2645710.2645743

Řehořek, T. (2016). Evaluating Recommender Systems: Choosing the best one for your business. Retrieved July 3, 2019, from Recombee website: https://medium.com/recombee-blog/evaluating-recommender-systems-choosing-the-best-one-for-your-business-c688ab781a35