1.As in your previous assignments, compare the accuracy of at least two recommender system algorithms against your offline data. 2. Implement support for at least one business or user experience goal such as increased serendipity, novelty, or diversity. 3. Compare and report on any change in accuracy before and after you’ve made the change in #2. 4. As part of your textual conclusion, discuss one or more additional experiments that could be performed and/or metrics that could be evaluated only if online evaluation was possible. Also, briefly propose how you would design a reasonable online evaluation environment.

#include appropriate packages
library(ggplot2)
library(tidyverse)
## ── Attaching packages ───────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──
## ✔ tibble  2.0.1     ✔ purrr   0.3.0
## ✔ tidyr   0.8.3     ✔ dplyr   0.7.8
## ✔ readr   1.3.1     ✔ stringr 1.3.1
## ✔ tibble  2.0.1     ✔ forcats 0.4.0
## ── Conflicts ──────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
library(kableExtra)
library(knitr)
library(recommenderlab)
## Loading required package: Matrix
## 
## Attaching package: 'Matrix'
## The following object is masked from 'package:tidyr':
## 
##     expand
## Loading required package: arules
## 
## Attaching package: 'arules'
## The following object is masked from 'package:dplyr':
## 
##     recode
## The following objects are masked from 'package:base':
## 
##     abbreviate, write
## Loading required package: proxy
## 
## Attaching package: 'proxy'
## The following object is masked from 'package:Matrix':
## 
##     as.matrix
## The following objects are masked from 'package:stats':
## 
##     as.dist, dist
## The following object is masked from 'package:base':
## 
##     as.matrix
## Loading required package: registry
library(data.table)
## 
## Attaching package: 'data.table'
## The following objects are masked from 'package:dplyr':
## 
##     between, first, last
## The following object is masked from 'package:purrr':
## 
##     transpose
library(reshape2)
## 
## Attaching package: 'reshape2'
## The following objects are masked from 'package:data.table':
## 
##     dcast, melt
## The following object is masked from 'package:tidyr':
## 
##     smiths
#load data
data("Jester5k")

#only choose jokes that have more than 50 ratings
Jester50 <- Jester5k[rowCounts(Jester5k) >50,]

#create train and test set
train <- Jester50[1:50,]
test <- Jester50[51:53,]
#create 2 models
scheme <- evaluationScheme(Jester50, method="split", 
                           train=0.8, 
                           given= 1, 
                           goodRating=7)
set.seed(1492)


evaluation_models <-list(POP = list(name='POPULAR', 
                         param = list(
                            normalize = 'z-score')),
                         RAN = list(name='RANDOM', 
                         param = list( 
                           normalize = 'center')))

list_results <- evaluate(x =scheme, 
                    method = evaluation_models,
                    n = seq(10, 20))
## POPULAR run fold/sample [model time/prediction time]
##   1  [0.282sec/1.798sec] 
## RANDOM run fold/sample [model time/prediction time]
##   1  [0.003sec/0.218sec]
average_matrices <- lapply(list_results, avg)
average_matrices
## $POP
##          TP        FP       FN       TN precision    recall       TPR
## 10 2.273548  7.726452 8.705806 80.29419 0.2273548 0.2574611 0.2574611
## 11 2.452903  8.547097 8.526452 79.47355 0.2229912 0.2793032 0.2793032
## 12 2.659355  9.340645 8.320000 78.68000 0.2216129 0.2966547 0.2966547
## 13 2.859355 10.140645 8.120000 77.88000 0.2199504 0.3155487 0.3155487
## 14 3.059355 10.940645 7.920000 77.08000 0.2185253 0.3398129 0.3398129
## 15 3.272258 11.727742 7.707097 76.29290 0.2181505 0.3599766 0.3599766
## 16 3.468387 12.531613 7.510968 75.48903 0.2167742 0.3776676 0.3776676
## 17 3.664516 13.335484 7.314839 74.68516 0.2155598 0.3945005 0.3945005
## 18 3.812903 14.187097 7.166452 73.83355 0.2118280 0.4076736 0.4076736
## 19 3.980645 15.019355 6.998710 73.00129 0.2095076 0.4242041 0.4242041
## 20 4.158710 15.841290 6.820645 72.17935 0.2079355 0.4422617 0.4422617
##           FPR
## 10 0.08605345
## 11 0.09518294
## 12 0.10394048
## 13 0.11280014
## 14 0.12187671
## 15 0.13065920
## 16 0.13957603
## 17 0.14844310
## 18 0.15811590
## 19 0.16739799
## 20 0.17657827
## 
## $RAN
##          TP        FP       FN       TN precision    recall       TPR
## 10 1.131613  8.868387 9.847742 79.15226 0.1131613 0.1019822 0.1019822
## 11 1.243871  9.756129 9.735484 78.26452 0.1130792 0.1124089 0.1124089
## 12 1.358710 10.641290 9.620645 77.37935 0.1132258 0.1218531 0.1218531
## 13 1.498065 11.501935 9.481290 76.51871 0.1152357 0.1351070 0.1351070
## 14 1.606452 12.393548 9.372903 75.62710 0.1147465 0.1427471 0.1427471
## 15 1.709677 13.290323 9.269677 74.73032 0.1139785 0.1527571 0.1527571
## 16 1.820645 14.179355 9.158710 73.84129 0.1137903 0.1628628 0.1628628
## 17 1.918710 15.081290 9.060645 72.93935 0.1128653 0.1725617 0.1725617
## 18 2.040000 15.960000 8.939355 72.06065 0.1133333 0.1855333 0.1855333
## 19 2.147097 16.852903 8.832258 71.16774 0.1130051 0.1933338 0.1933338
## 20 2.247742 17.752258 8.731613 70.26839 0.1123871 0.2017847 0.2017847
##          FPR
## 10 0.1005115
## 11 0.1105888
## 12 0.1206186
## 13 0.1302949
## 14 0.1403662
## 15 0.1505438
## 16 0.1605741
## 17 0.1708748
## 18 0.1808794
## 19 0.1909480
## 20 0.2011534

We can see that the precision is not very high for the random model. The popular is much better.

#compare the models
plot(average_matrices$POP)

plot(average_matrices$RAN)

From the ROC curve, we can see that the models are almost identical.

#create recommender
rec_pop <- Recommender(train, method = "POPULAR")
rec_pop
## Recommender of type 'POPULAR' for 'realRatingMatrix' 
## learned using 50 users.
getModel(rec_pop)
## $topN
## Recommendations as 'topNList' with n = 100 for 1 users. 
## 
## $ratings
## 1 x 100 rating matrix of class 'realRatingMatrix' with 100 ratings.
## Normalized using center on rows.
## 
## $normalize
## [1] "center"
## 
## $aggregationRatings
## new("standardGeneric", .Data = function (x, na.rm = FALSE, dims = 1, 
##     ...) 
## standardGeneric("colMeans"), generic = "colMeans", package = "base", 
##     group = list(), valueClass = character(0), signature = c("x", 
##     "na.rm", "dims"), default = new("derivedDefaultMethod", .Data = function (x, 
##         na.rm = FALSE, dims = 1, ...) 
##     base::colMeans(x, na.rm = na.rm, dims = dims, ...), target = new("signature", 
##         .Data = "ANY", names = "x", package = "methods"), defined = new("signature", 
##         .Data = "ANY", names = "x", package = "methods"), generic = "colMeans"), 
##     skeleton = (new("derivedDefaultMethod", .Data = function (x, 
##         na.rm = FALSE, dims = 1, ...) 
##     base::colMeans(x, na.rm = na.rm, dims = dims, ...), target = new("signature", 
##         .Data = "ANY", names = "x", package = "methods"), defined = new("signature", 
##         .Data = "ANY", names = "x", package = "methods"), generic = "colMeans"))(x, 
##         na.rm, dims, ...))
## <bytecode: 0x7f852cbbd2a0>
## <environment: 0x7f85306af650>
## attr(,"generic")
## [1] "colMeans"
## attr(,"generic")attr(,"package")
## [1] "base"
## attr(,"package")
## [1] "base"
## attr(,"group")
## list()
## attr(,"valueClass")
## character(0)
## attr(,"signature")
## [1] "x"     "na.rm" "dims" 
## attr(,"default")
## Method Definition (Class "derivedDefaultMethod"):
## 
## function (x, na.rm = FALSE, dims = 1, ...) 
## base::colMeans(x, na.rm = na.rm, dims = dims, ...)
## <bytecode: 0x7f852cbce718>
## <environment: 0x7f85316fe458>
## 
## Signatures:
##         x    
## target  "ANY"
## defined "ANY"
## attr(,"skeleton")
## (new("derivedDefaultMethod", .Data = function (x, na.rm = FALSE, 
##     dims = 1, ...) 
## base::colMeans(x, na.rm = na.rm, dims = dims, ...), target = new("signature", 
##     .Data = "ANY", names = "x", package = "methods"), defined = new("signature", 
##     .Data = "ANY", names = "x", package = "methods"), generic = "colMeans"))(x, 
##     na.rm, dims, ...)
## attr(,"class")
## [1] "standardGeneric"
## attr(,"class")attr(,"package")
## [1] "methods"
## 
## $aggregationPopularity
## new("standardGeneric", .Data = function (x, na.rm = FALSE, dims = 1, 
##     ...) 
## standardGeneric("colSums"), generic = "colSums", package = "base", 
##     group = list(), valueClass = character(0), signature = c("x", 
##     "na.rm", "dims"), default = new("derivedDefaultMethod", .Data = function (x, 
##         na.rm = FALSE, dims = 1, ...) 
##     base::colSums(x, na.rm = na.rm, dims = dims, ...), target = new("signature", 
##         .Data = "ANY", names = "x", package = "methods"), defined = new("signature", 
##         .Data = "ANY", names = "x", package = "methods"), generic = "colSums"), 
##     skeleton = (new("derivedDefaultMethod", .Data = function (x, 
##         na.rm = FALSE, dims = 1, ...) 
##     base::colSums(x, na.rm = na.rm, dims = dims, ...), target = new("signature", 
##         .Data = "ANY", names = "x", package = "methods"), defined = new("signature", 
##         .Data = "ANY", names = "x", package = "methods"), generic = "colSums"))(x, 
##         na.rm, dims, ...))
## <bytecode: 0x7f852cbbb5e8>
## <environment: 0x7f852e337988>
## attr(,"generic")
## [1] "colSums"
## attr(,"generic")attr(,"package")
## [1] "base"
## attr(,"package")
## [1] "base"
## attr(,"group")
## list()
## attr(,"valueClass")
## character(0)
## attr(,"signature")
## [1] "x"     "na.rm" "dims" 
## attr(,"default")
## Method Definition (Class "derivedDefaultMethod"):
## 
## function (x, na.rm = FALSE, dims = 1, ...) 
## base::colSums(x, na.rm = na.rm, dims = dims, ...)
## <bytecode: 0x7f852cbbde38>
## <environment: 0x7f85316fe458>
## 
## Signatures:
##         x    
## target  "ANY"
## defined "ANY"
## attr(,"skeleton")
## (new("derivedDefaultMethod", .Data = function (x, na.rm = FALSE, 
##     dims = 1, ...) 
## base::colSums(x, na.rm = na.rm, dims = dims, ...), target = new("signature", 
##     .Data = "ANY", names = "x", package = "methods"), defined = new("signature", 
##     .Data = "ANY", names = "x", package = "methods"), generic = "colSums"))(x, 
##     na.rm, dims, ...)
## attr(,"class")
## [1] "standardGeneric"
## attr(,"class")attr(,"package")
## [1] "methods"
## 
## $verbose
## [1] FALSE
p <- predict(rec_pop, test)

err <-calcPredictionAccuracy(p, test, given = 50, goodRating = "7")

rec_ran <- Recommender(train, method = "RANDOM")
rec_ran
## Recommender of type 'RANDOM' for 'realRatingMatrix' 
## learned using 50 users.
getModel(rec_ran)
## $range
## [1] -9.95  9.37
## 
## $labels
##   [1] "j1"   "j2"   "j3"   "j4"   "j5"   "j6"   "j7"   "j8"   "j9"   "j10" 
##  [11] "j11"  "j12"  "j13"  "j14"  "j15"  "j16"  "j17"  "j18"  "j19"  "j20" 
##  [21] "j21"  "j22"  "j23"  "j24"  "j25"  "j26"  "j27"  "j28"  "j29"  "j30" 
##  [31] "j31"  "j32"  "j33"  "j34"  "j35"  "j36"  "j37"  "j38"  "j39"  "j40" 
##  [41] "j41"  "j42"  "j43"  "j44"  "j45"  "j46"  "j47"  "j48"  "j49"  "j50" 
##  [51] "j51"  "j52"  "j53"  "j54"  "j55"  "j56"  "j57"  "j58"  "j59"  "j60" 
##  [61] "j61"  "j62"  "j63"  "j64"  "j65"  "j66"  "j67"  "j68"  "j69"  "j70" 
##  [71] "j71"  "j72"  "j73"  "j74"  "j75"  "j76"  "j77"  "j78"  "j79"  "j80" 
##  [81] "j81"  "j82"  "j83"  "j84"  "j85"  "j86"  "j87"  "j88"  "j89"  "j90" 
##  [91] "j91"  "j92"  "j93"  "j94"  "j95"  "j96"  "j97"  "j98"  "j99"  "j100"
p1 <- predict(rec_ran, test)
err1 <-calcPredictionAccuracy(p1, test, given = 50, goodRating = "7")

err
##         TP         FP         FN         TN  precision     recall 
##  0.0000000  4.3333333 15.6666667 30.0000000  0.0000000  0.0000000 
##        TPR        FPR 
##  0.0000000  0.1357759
err1
##         TP         FP         FN         TN  precision     recall 
##  0.0000000  4.3333333 15.6666667 30.0000000  0.0000000  0.0000000 
##        TPR        FPR 
##  0.0000000  0.1357759

We can see that the FPR is fairly high and the TPR is 0 for both methods. This is not really a good sign.

We will combine all the methods into one model to create a recommender system that recommends popular jokes, random jokes, and jokes that the are similar to jokes the user has expressed interest in.

## mix popular jokes with a random recommendations for diversity and
## rerecommend some joes the user liked.
recom <- HybridRecommender(
Recommender(train, method = "POPULAR"),
Recommender(train, method = "RANDOM"),
Recommender(train, method = "RERECOMMEND"),
weights = c(.6, .1, .3)
)

recom
## Recommender of type 'HYBRID' for 'ratingMatrix' 
## learned using NA users.
getModel(recom)
## $recommender
## $recommender[[1]]
## Recommender of type 'POPULAR' for 'realRatingMatrix' 
## learned using 50 users.
## 
## $recommender[[2]]
## Recommender of type 'RANDOM' for 'realRatingMatrix' 
## learned using 50 users.
## 
## $recommender[[3]]
## Recommender of type 'RERECOMMEND' for 'ratingMatrix' 
## learned using 50 users.
## 
## 
## $weights
## [1] 0.6 0.1 0.3
as(predict(recom, test), "list")
## $u1044
##  [1] "j93" "j72" "j81" "j88" "j87" "j95" "j73" "j94" "j83" "j89"
## 
## $u7905
## character(0)
## 
## $u343
## [1] "j72" "j73" "j71"

For each user, a set of recommended jokes is given. Each set contains similar jokes, random jokes, and jokes that haven’t been seen before. This recommender model provides serendipitous choices.

p2 <- predict(recom, test)
err2 <-calcPredictionAccuracy(p2, test, given = 50, goodRating = "7")
err2
##         TP         FP         FN         TN  precision     recall 
##  0.0000000  4.3333333 15.6666667 30.0000000  0.0000000  0.0000000 
##        TPR        FPR 
##  0.0000000  0.1357759

The errors didn’t change rate. This means the model didn’t really improve through combining methods.