49-R语言机器学习：购物篮分析、推荐引擎与序列分析
2020-03-17 本文已影响0人
wonphen
《精通机器学习：基于R 第二版》学习笔记
1、购物篮分析简介
关联规则分析通常称为购物篮分析，因为我们试图发现人们会同时购买哪些商品。购物篮分析是一项数据挖掘技术，它的目标是找到最优的商品与服务组合，使市场营销人员以此为依据提供推荐意见，优化商品摆放，制定营销方案，最终提高交叉销售。简而言之，它的理念就是识别出哪些商品放在一起更好，并从中获益。
相关术语：
项集：数据集中一个或多个项目的集合。
支持度：包含某个项集的事务在整个数据中的比例。
置信度：如果某人购买了x（或做了x），那么他就会购买y（或做y）的条件概率；x被称为先导或左侧项，y被称为后继或右侧项。
提升度：它是一个比例，x发生的同时发生y的支持度是分子，分母是x和y在相互独立的情况下同时发生的概率。它等于置信度/(x的概率 * y的概率)。举例来说，假设x和y同时发生的概率是10%，x发生的概率是20%，y发生的概率是30%，那么提升度就是10%/(20% * 30%)，等于1.667%。
2、数据理解与数据准备
> library(pacman)
> p_load(arules, arulesViz)
> data(Groceries)
> str(Groceries)
## Formal class 'transactions' [package "arules"] with 3 slots
## ..@ data :Formal class 'ngCMatrix' [package "Matrix"] with 5 slots
## .. .. ..@ i : int [1:43367] 13 60 69 78 14 29 98 24 15 29 ...
## .. .. ..@ p : int [1:9836] 0 4 7 8 12 16 21 22 27 28 ...
## .. .. ..@ Dim : int [1:2] 169 9835
## .. .. ..@ Dimnames:List of 2
## .. .. .. ..$ : NULL
## .. .. .. ..$ : NULL
## .. .. ..@ factors : list()
## ..@ itemInfo :'data.frame': 169 obs. of 3 variables:
## .. ..$ labels: chr [1:169] "frankfurter" "sausage" "liver loaf" "ham" ...
## .. ..$ level2: Factor w/ 55 levels "baby food","bags",..: 44 44 44 44 44 44 44 42 42 41 ...
## .. ..$ level1: Factor w/ 10 levels "canned food",..: 6 6 6 6 6 6 6 6 6 6 ...
## ..@ itemsetInfo:'data.frame': 0 obs. of 0 variables
使用绝对频率，生成项目频率图，查看频率最高的10个项目：
> itemFrequencyPlot(Groceries, topN = 10, type = "absolute")
绝对频率前10项目
购买最多的项目是“whole milk”，在9835条事务记录中占了大约2500条。
使用相对频率查看频率最高的15个项目：
> itemFrequencyPlot(Groceries, topN = 15)
相对频率前15项目
我们看到，beer在杂货店“最常被购买的商品”中只排在第13位（bottle beer）和第15位（canned beer）。只有不到10%的购买记录中包括瓶装啤酒和罐装啤酒。
3、模型构建与模型评价
> # supp最小支持度，conf最小置信度，maxlen最大项数
> rules <- apriori(Groceries, parameter = list(supp = 0.001, conf = 0.9, maxlen = 4))
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.9 0.1 1 none FALSE TRUE 5 0.001 1
## maxlen target ext
## 4 rules FALSE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 9
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[169 item(s), 9835 transaction(s)] done [0.01s].
## sorting and recoding items ... [157 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 4 done [0.01s].
## writing ... [67 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
> rules
## set of 67 rules
可以看到算法产生了67条关联规则。查看最前面的5条规则：
> # 设置全局数字小数位为2位
> options(digits = 2)
> rules <- sort(rules, by = "lift", decreasing = T)
> inspect(rules[1:5])
## lhs rhs support confidence lift count
## [1] {liquor,
## red/blush wine} => {bottled beer} 0.0019 0.90 11.2 19
## [2] {root vegetables,
## butter,
## cream cheese } => {yogurt} 0.0010 0.91 6.5 10
## [3] {citrus fruit,
## root vegetables,
## soft cheese} => {other vegetables} 0.0010 1.00 5.2 10
## [4] {pip fruit,
## whipped/sour cream,
## brown bread} => {other vegetables} 0.0011 1.00 5.2 11
## [5] {butter,
## whipped/sour cream,
## soda} => {other vegetables} 0.0013 0.93 4.8 13
具有最高提升度的关联规则是，购买了liquor和red/blush wine的顾客也很可能购买bottled beer，这条规则的支持度只有0.0019，说明这种购买行为并不常见。
按照支持度和置信度排序，查看前5条关联规则：
> rules <- sort(rules, by = "confidence", decreasing = T)
> inspect(rules[1:5])
## lhs rhs support confidence lift count
## [1] {citrus fruit,
## root vegetables,
## soft cheese} => {other vegetables} 0.0010 1 5.2 10
## [2] {pip fruit,
## whipped/sour cream,
## brown bread} => {other vegetables} 0.0011 1 5.2 11
## [3] {rice,
## sugar} => {whole milk} 0.0012 1 3.9 12
## [4] {canned fish,
## hygiene articles} => {whole milk} 0.0011 1 3.9 11
## [5] {root vegetables,
## butter,
## rice} => {whole milk} 0.0010 1 3.9 10
下面专门研究一下与啤酒有关的交易：
> # 根据数据集建立交叉表
> tab <- crossTable(Groceries)
>
> # 检查商品之间的共同购买关系
> tab[1:3, 1:3]
## frankfurter sausage liver loaf
## frankfurter 580 99 7
## sausage 99 924 10
## liver loaf 7 10 50
可以看到，在9835笔交易记录中，顾客们只购买了50次liver loaf。此外，顾客购买了924次sausage时，有10次同时购买了liver loaf。
也可以指定具体商品名称查看：
> tab["bottled beer", "bottled beer"]
## [1] 792
查看人们购买bottled beer的同时，购买了多少次canned beer：
> tab["bottled beer", "canned beer"]
## [1] 26
生成关于bottled beer的关联规则：
> beer.rules <- apriori(data = Groceries,
+ # 可根据需要调整参数
+ parameter = list(support=0.0015,confidence=0.3),
+ appearance = list(default="lhs",rhs="bottled beer"))
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.3 0.1 1 none FALSE TRUE 5 0.0015 1
## maxlen target ext
## 10 rules FALSE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 14
##
## set item appearances ...[1 item(s)] done [0.00s].
## set transactions ...[169 item(s), 9835 transaction(s)] done [0.01s].
## sorting and recoding items ... [153 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 4 5 6 done [0.01s].
## writing ... [4 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
> beer.rules
## set of 4 rules
查看4条关联规则：
> beer.rules <- sort(beer.rules, decreasing = T, by = "lift")
> inspect(beer.rules)
## lhs rhs support confidence
## [1] {liquor,red/blush wine} => {bottled beer} 0.0019 0.90
## [2] {liquor} => {bottled beer} 0.0047 0.42
## [3] {soda,red/blush wine} => {bottled beer} 0.0016 0.36
## [4] {other vegetables,red/blush wine} => {bottled beer} 0.0015 0.31
## lift count
## [1] 11.2 19
## [2] 5.2 46
## [3] 4.4 16
## [4] 3.8 15
查看关联规则的统计图：
> plot(beer.rules, method = "graph", measure = "lift", shading = "confidence")
关联规则统计图
圆点的大小和颜色深浅表示提升度和置信度。
4、推荐引擎简介
推荐系统的设计有两种主要方式： 协同过滤和基于内容的推荐。
在协同过滤推荐方法中，推荐是基于数据库中一些或全部人员提供的多条评价进行的。从本质上来说，这种方法利用的是群体的智慧。我们重点讨论以下4种方法：
基于用户的协同过滤
基于项目的协同过滤
奇异值分解
主成分分析
4.1 基于用户的协同过滤
在基于用户的协同过滤算法中，先找到与用户相似的近邻，然后将这些近邻的评价综合起来产生一个推荐，将其中未被用户发现的部分推荐给用户先找到与用户相似的近邻，然后将这些近邻的评价综合起来产生一个推荐，将其中未被用户发现的部分推荐给用户。
基于用户的协同过滤算法的缺点是，为了计算所有用户的相似度，整个数据库必须驻留在内存中，这在计算能力和时间上都是一笔很大的开销。
4.2 基于项目的协同过滤
基于项目的协同过滤算法在进行推荐时使用的是项目之间的相似度，而不是用户之间的相似度。这种方法背后的假设是用户更倾向于那些和他们喜欢的其他项目类似的项目。
4.3 奇异值分解和主成分分析
大数据集的一个问题是，你很可能得到一个稀疏矩阵，其中很多评价是空白的。降维的方法是，建立一个更小的，但能反映高维矩阵中大部分信息的低维矩阵。降维技术的缺点是不能支持带有缺失值的矩阵，必须进行数据填补。
通过奇异值分解可以降低数据维度，并且可能发现有意义的潜在因子。具有和主成分分析相似的作用。它们之间的区别是主成分分析是基于协方差矩阵的，这个矩阵是对称的。要进行主成分分析，需要先从数据开始，对数据进行中心化，然后计算协方差矩阵并进行对角化，最后生成主成分。
5、数据理解与数据准备
> p_load(recommenderlab)
> data("Jester5k")
> str(Jester5k)
## Formal class 'realRatingMatrix' [package "recommenderlab"] with 2 slots
## ..@ data :Formal class 'dgCMatrix' [package "Matrix"] with 6 slots
## .. .. ..@ i : int [1:362106] 0 1 2 3 4 5 6 7 8 9 ...
## .. .. ..@ p : int [1:101] 0 3314 6962 10300 13442 18440 22513 27512 32512 35685 ...
## .. .. ..@ Dim : int [1:2] 5000 100
## .. .. ..@ Dimnames:List of 2
## .. .. .. ..$ : chr [1:5000] "u2841" "u15547" "u15221" "u15573" ...
## .. .. .. ..$ : chr [1:100] "j1" "j2" "j3" "j4" ...
## .. .. ..@ x : num [1:362106] 7.91 -3.2 -1.7 -7.38 0.1 0.83 2.91 -2.77 -3.35 -1.99 ...
## .. .. ..@ factors : list()
## ..@ normalize: NULL
评价矩阵包括362106个评价。
> # 查看用户10的所有评价
> as(Jester5k[10, ], "list")
## $u12843
## j1 j2 j3 j4 j5 j6 j7 j8 j9 j10 j11 j12 j13
## -1.99 -6.89 2.09 -4.42 -4.90 2.43 -3.06 3.98 -1.46 0.68 3.06 2.28 -2.91
## j14 j15 j16 j17 j18 j19 j20 j21 j22 j23 j24 j25 j26
## -5.44 -3.88 -0.63 -7.96 -1.70 -0.73 1.17 -6.94 -7.33 2.09 4.76 -7.09 -7.14
## j27 j28 j29 j30 j31 j32 j33 j34 j35 j36 j37 j38 j39
## 0.15 1.55 -6.02 2.09 -5.92 1.55 -1.60 -3.59 -5.39 2.14 -3.54 -0.97 -8.11
## j40 j41 j42 j43 j44 j45 j46 j47 j48 j49 j50 j51 j52
## 2.18 -6.26 -7.14 -3.11 -3.40 3.83 -5.78 1.12 -5.68 -5.78 -7.52 -6.50 -7.38
## j53 j54 j55 j56 j57 j58 j59 j60 j61 j62 j63 j64 j65
## -7.52 -2.62 -2.14 -5.92 -3.25 0.15 -1.55 -3.59 1.46 1.70 0.24 -3.88 -7.23
## j66 j67 j68 j69 j70 j71 j72 j73 j74 j75 j76 j77 j78
## 5.05 -3.69 1.60 -1.31 -1.02 1.84 1.80 1.75 -1.17 1.75 1.75 1.65 -3.79
## j79 j80 j81 j82 j83 j84 j85 j86 j87 j88 j89 j90 j91
## 1.99 1.99 -5.58 2.82 -3.30 0.97 -5.24 2.38 4.13 2.43 -0.92 1.80 1.94
## j92 j93 j94 j95 j96 j97 j98 j99 j100
## 2.77 1.75 -1.41 2.67 2.04 -0.29 -6.31 0.24 -6.50
> # 查看用户10的平均评价
> rowMeans(Jester5k[10, ])
## u12843
## -1.6
> # 查看笑话1的平均评价
> colMeans(Jester5k[, 1])
## j1
## 0.92
查看原始数据统计图：
p_load(magrittr,ggplot2)
> getRatings(Jester5k) %>% tibble::enframe() %>% ggplot(aes(value)) +
+ geom_histogram(binwidth = 0.3, col = "white") + theme_bw() +
+ labs(title = "Histogram of getRatings(Jester5k)", x = "", y = "")
原始数据统计图
可以看到，评价的分布稍稍偏向右边侧。看看对数据进行中心化后的分布：
> Jester5k %>% normalize() %>% getRatings() %>%
+ tibble::enframe() %>% ggplot(aes(value)) +
+ geom_histogram(binwidth = 0.3, col = "white") +
+ theme_bw() +
+ labs(title = "Normalized Jester5k", x = "", y = "")
中心化后的统计图
规范化后的数据也反映出这个趋势。稍微右偏，非常像正态分布。
按80/20的比例拆分为训练集和测试集：
> set.seed(123)
> e <- evaluationScheme(Jester5k,method="split",train=0.8,
+ # 使用15个评价进行预测，其余用于计算误差
+ given=15,
+ # 大于等于5为“好评价”的阈值
+ goodRating=5)
> e
## Evaluation scheme with 15 items given
## Method: 'split' with 1 run(s).
## Training set proportion: 0.800
## Good ratings: >=5.000000
## Data set: 5000 x 100 rating matrix of class 'realRatingMatrix' with 362106 ratings.
查看函数的全部参数设置：
> recommenderRegistry$get_entries(dataType = "realRatingMatrix")
## $ALS_realRatingMatrix
## Recommender method: ALS for realRatingMatrix
## Description: Recommender for explicit ratings based on latent factors, calculated by alternating least squares algorithm.
## Reference: Yunhong Zhou, Dennis Wilkinson, Robert Schreiber, Rong Pan (2008). Large-Scale Parallel Collaborative Filtering for the Netflix Prize, 4th Int'l Conf. Algorithmic Aspects in Information and Management, LNCS 5034.
## Parameters:
## normalize lambda n_factors n_iterations min_item_nr seed
## 1 NULL 0.1 10 10 1 NULL
##
## $ALS_implicit_realRatingMatrix
## Recommender method: ALS_implicit for realRatingMatrix
## Description: Recommender for implicit data based on latent factors, calculated by alternating least squares algorithm.
## Reference: Yifan Hu, Yehuda Koren, Chris Volinsky (2008). Collaborative Filtering for Implicit Feedback Datasets, ICDM '08 Proceedings of the 2008 Eighth IEEE International Conference on Data Mining, pages 263-272.
## Parameters:
## lambda alpha n_factors n_iterations min_item_nr seed
## 1 0.1 10 10 10 1 NULL
##
## $IBCF_realRatingMatrix
## Recommender method: IBCF for realRatingMatrix
## Description: Recommender based on item-based collaborative filtering.
## Reference: NA
## Parameters:
## k method normalize normalize_sim_matrix alpha na_as_zero
## 1 30 "Cosine" "center" FALSE 0.5 FALSE
##
## $LIBMF_realRatingMatrix
## Recommender method: LIBMF for realRatingMatrix
## Description: Matrix factorization with LIBMF via package recosystem (https://cran.r-project.org/web/packages/recosystem/vignettes/introduction.html).
## Reference: NA
## Parameters:
## dim costp_l2 costq_l2 nthread
## 1 10 0.01 0.01 1
##
## $POPULAR_realRatingMatrix
## Recommender method: POPULAR for realRatingMatrix
## Description: Recommender based on item popularity.
## Reference: NA
## Parameters:
## normalize
## 1 "center"
## aggregationRatings
## 1 new("standardGeneric", .Data = function (x, na.rm = FALSE, dims = 1,
## aggregationPopularity
## 1 new("standardGeneric", .Data = function (x, na.rm = FALSE, dims = 1,
##
## $RANDOM_realRatingMatrix
## Recommender method: RANDOM for realRatingMatrix
## Description: Produce random recommendations (real ratings).
## Reference: NA
## Parameters: None
##
## $RERECOMMEND_realRatingMatrix
## Recommender method: RERECOMMEND for realRatingMatrix
## Description: Re-recommends highly rated items (real ratings).
## Reference: NA
## Parameters:
## randomize minRating
## 1 1 NA
##
## $SVD_realRatingMatrix
## Recommender method: SVD for realRatingMatrix
## Description: Recommender based on SVD approximation with column-mean imputation.
## Reference: NA
## Parameters:
## k maxiter normalize
## 1 10 100 "center"
##
## $SVDF_realRatingMatrix
## Recommender method: SVDF for realRatingMatrix
## Description: Recommender based on Funk SVD with gradient descend (https://sifter.org/~simon/journal/20061211.html).
## Reference: NA
## Parameters:
## k gamma lambda min_epochs max_epochs min_improvement normalize verbose
## 1 10 0.015 0.001 50 200 1e-06 "center" FALSE
##
## $UBCF_realRatingMatrix
## Recommender method: UBCF for realRatingMatrix
## Description: Recommender based on user-based collaborative filtering.
## Reference: NA
## Parameters:
## method nn sample normalize
## 1 "cosine" 25 FALSE "center"
5.1 推荐系统的建模与评价
在训练集上使用6种推荐技术方法，分别为基于用户的推荐、基于项目的推荐、基于流行度的推荐、奇异值分解、主成分分析以及随机推荐。：
> ubcf <- Recommender(getData(e, "train"), "UBCF")
> ibcf <- Recommender(getData(e, "train"), "IBCF")
> svd <- Recommender(getData(e, "train"), "SVD")
> popular <- Recommender(getData(e, "train"), "POPULAR")
> random <- Recommender(getData(e, "train"), "RANDOM")
在测试集上使用15个项目进行预测：
> user_pred <- predict(ubcf, getData(e, "known"), type = "ratings")
> item_pred <- predict(ibcf, getData(e, "known"), type = "ratings")
> svd_pred <- predict(svd, getData(e, "known"), type = "ratings")
> pop_pred <- predict(popular, getData(e, "known"), type = "ratings")
> rand_pred <- predict(random, getData(e, "known"), type = "ratings")
计算预测值和测试集未知部分的误差，包括所有方法的均方根误差（RMSE）、均方误差（MSE）和平均绝对误差（MAE）：
> error <- data.frame(
+ UBCF = calcPredictionAccuracy(user_pred, getData(e, "unknown")),
+ IBCF = calcPredictionAccuracy(item_pred, getData(e, "unknown")),
+ SVD = calcPredictionAccuracy(svd_pred, getData(e, "unknown")),
+ Popular = calcPredictionAccuracy(pop_pred, getData(e, "unknown")),
+ Random = calcPredictionAccuracy(rand_pred, getData(e, "unknown")))
>
> print(error)
## UBCF IBCF SVD Popular Random
## RMSE 4.7 5.3 4.7 4.6 6.4
## MSE 21.6 28.1 22.0 20.8 41.0
## MAE 3.7 4.2 3.7 3.6 5.0
可以看到，基于用户的推荐、基于流行度的推荐和奇异值分解技术表现得比基于项目的协同过滤稍好一点，但它们都优于随机推荐。
使用另一种比较方式：
> # 建立要比较的算法列表
> algorithms <- list(POPULAR = list(name = "POPULAR"), UBCF = list(name = "UBCF"),
+ IBCF = list(name = "IBCF"))
> algorithms
## $POPULAR
## $POPULAR$name
## [1] "POPULAR"
##
##
## $UBCF
## $UBCF$name
## [1] "UBCF"
##
##
## $IBCF
## $IBCF$name
## [1] "IBCF"
> # 比较前5、10、15个笑话推荐，可以看到每种算法的运行时间
> evlist <- evaluate(e, algorithms, n = c(5, 10, 15))
## POPULAR run fold/sample [model time/prediction time]
## 1 [0.06sec/2.2sec]
## UBCF run fold/sample [model time/prediction time]
## 1 [0.04sec/4.8sec]
## IBCF run fold/sample [model time/prediction time]
## 1 [0.31sec/0.25sec]
> # 检查各种技术的表现
> set.seed(123)
> avg(evlist)
## $POPULAR
## TP FP FN TN precision recall TPR FPR
## 5 2.0 3.0 12 68 0.39 0.19 0.19 0.042
## 10 3.7 6.3 10 65 0.37 0.34 0.34 0.086
## 15 5.2 9.8 9 61 0.34 0.45 0.45 0.135
##
## $UBCF
## TP FP FN TN precision recall TPR FPR
## 5 1.9 3.1 12.3 68 0.38 0.18 0.18 0.043
## 10 3.5 6.5 10.7 64 0.35 0.32 0.32 0.088
## 15 5.0 10.0 9.2 61 0.33 0.43 0.43 0.137
##
## $IBCF
## TP FP FN TN precision recall TPR FPR
## 5 0.75 4.2 13 67 0.15 0.055 0.055 0.06
## 10 1.51 8.5 13 62 0.15 0.109 0.109 0.12
## 15 2.29 12.7 12 58 0.15 0.166 0.166 0.18
基于流行度的方法和基于用户的协同过滤算法的表现几乎没有什么差别。绘制受试者工作特征曲线看看，在图中可以比较TPR和FPR，或者精确度/召回度：
> par(mfrow = c(1, 2))
> # annotate是否在旁边显示数字
> plot(evlist, legend = "topleft", annotate = T)
> plot(evlist, "prec", legend = "bottomright", annotate = T)
受试者工作特征曲线
可以清楚地看到，基于流行度和基于用户的推荐算法几乎是等同的，并且都优于基于项目的算法。
针对具体的用户，模型会给出怎样的推荐呢？
> # 在整个数据集上建立流行度推荐引擎
> R1 <- Recommender(Jester5k, method = "POPULAR")
> R1
## Recommender of type 'POPULAR' for 'realRatingMatrix'
## learned using 5000 users.
> # 查看为前2个用户做出的前5个推荐
> recommend <- predict(R1, Jester5k[1:2], n = 5) %>% as("list")
> recommend
## $u2841
## [1] "j89" "j72" "j76" "j88" "j83"
##
## $u15547
## [1] "j89" "j93" "j76" "j88" "j91"
> # 查看10个用户对3个笑话的评价
> rating <- predict(R1, Jester5k[300:309], type = "ratings") %>% as("matrix")
> rating[, 71:73]
## j71 j72 j73
## u7628 -2.04 1.5 -0.291
## u8714 NA NA NA
## u24213 -2.94 NA -1.184
## u13301 2.39 5.9 4.142
## u10959 NA NA NA
## u23430 -0.43 3.1 NA
## u11167 -1.72 1.8 0.033
## u4705 -1.20 2.3 0.552
## u24469 -1.58 2.0 0.169
## u13534 -1.55 2.0 NA
在二值评价（好/坏、1/0）的情况下建立推荐引擎：
> # 将评价分数转换成二值形式，大于等于5的评价记为1，小于5的评价记为0
> jester.bin <- binarize(Jester5k, minRating = 5)
>
> # 找出具有一定数量的评价为1的记录
> jester.bin <- jester.bin[rowCounts(jester.bin) > 10]
> jester.bin
## 3054 x 100 rating matrix of class 'binaryRatingMatrix' with 84722 ratings.
> # 使用5折交叉验证
> set.seed(123)
> e.bin <- evaluationScheme(jester.bin, method = "cross-validation", k = 5, given = 10)
>
> # 使用三种技术进行比较
> algorithms.bin <- list(random = list(name = "RANDOM", param = NULL), popular = list(name = "POPULAR",
+ param = NULL), UBCF = list(name = "UBCF"))
>
> # 建立模型
> result.bin <- evaluate(e.bin, algorithms.bin, n = c(5, 10, 15))
## RANDOM run fold/sample [model time/prediction time]
## 1 [0sec/0.1sec]
## 2 [0sec/0.09sec]
## 3 [0sec/0.08sec]
## 4 [0sec/0.09sec]
## 5 [0sec/0.09sec]
## POPULAR run fold/sample [model time/prediction time]
## 1 [0sec/0.66sec]
## 2 [0sec/0.65sec]
## 3 [0sec/0.67sec]
## 4 [0sec/0.72sec]
## 5 [0sec/0.71sec]
## UBCF run fold/sample [model time/prediction time]
## 1 [0sec/2.3sec]
## 2 [0sec/2.5sec]
## 3 [0sec/2.3sec]
## 4 [0sec/2.4sec]
## 5 [0sec/2.9sec]
查看统计图：
> par(mfrow = c(1, 2))
> plot(result.bin, legend = "topleft")
> plot(result.bin, "prec", legend = "bottomright")
对比统计图
基于用户的算法比基于流行度的算法稍稍好一点，但二者明显优于随机推荐。
6、序列数据分析
> p_load(TraMineR)
> df <- read.csv("./data_set/data-master/sequential.csv")
> str(df)
## 'data.frame': 5000 obs. of 9 variables:
## $ Cust_Segment: Factor w/ 4 levels "Segment1","Segment2",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ Purchase1 : Factor w/ 7 levels "Product_A","Product_B",..: 1 2 7 3 1 4 1 4 4 4 ...
## $ Purchase2 : Factor w/ 8 levels "","Product_A",..: 2 1 3 1 1 1 2 1 4 7 ...
## $ Purchase3 : Factor w/ 8 levels "","Product_A",..: 1 1 3 1 1 1 1 1 4 4 ...
## $ Purchase4 : Factor w/ 8 levels "","Product_A",..: 1 1 4 1 1 1 1 1 4 4 ...
## $ Purchase5 : Factor w/ 8 levels "","Product_A",..: 1 1 3 1 1 1 1 1 5 4 ...
## $ Purchase6 : Factor w/ 8 levels "","Product_A",..: 1 1 3 1 1 1 1 1 5 7 ...
## $ Purchase7 : Factor w/ 8 levels "","Product_A",..: 1 1 3 1 1 1 1 1 6 8 ...
## $ Purchase8 : Factor w/ 8 levels "","Product_A",..: 1 1 8 1 1 1 1 1 6 7 ...
该数据集包含5000条观测，每条观测都是某位顾客的购买历史记录，还包含9个变量。
Cust_segment ：一个因子变量，表示顾客分类
8个离散型购买事件，分别为 Purchase1 ~ Purchase8 ：顾客可以同时购买所有8种商品，但要有一定的顺序。每个购买变量中保存着购买商品的名称，共有7种商品，ProductA~ProductG。
> # 查看各个顾客分类中的顾客数量
> table(df$Cust_Segment)
##
## Segment1 Segment2 Segment3 Segment4
## 2900 572 554 974
> # 查看第一次商品购买的分类数量
> table(df$Purchase1)
##
## Product_A Product_B Product_C Product_D Product_E Product_F Product_G
## 1451 765 659 1060 364 372 329
> # 查看所有商品的购买次数
> table(unlist(df[, -1]))
##
## Product_A Product_B Product_C Product_D Product_E Product_F Product_G
## 3855 3193 3564 3122 1688 1273 915
##
## 22390
> # 检查第一次购买行为和第二次购买行为之间的序列频率
> df %>% count(Purchase1, Purchase2) %>% arrange(desc(n)) %>% head()
## # A tibble: 6 x 3
## Purchase1 Purchase2 n
## <fct> <fct> <int>
## 1 Product_A "Product_A" 548
## 2 Product_D "" 548
## 3 Product_B "" 346
## 4 Product_C "Product_C" 345
## 5 Product_B "Product_B" 291
## 6 Product_D "Product_D" 281
使用TraMineR包进行更深入的探索：
> # 转换数据到一个序列类的对象中,xtstep指定绘图函数中刻度线的距离
> seq <- seqdef(df[, -1], xtstep = 1)
> head(seq)
## Sequence
## 1 Product_A-Product_A------
## 2 Product_B-------
## 3 Product_G-Product_B-Product_B-Product_C-Product_B-Product_B-Product_B-Product_G
## 4 Product_C-------
## 5 Product_A-------
## 6 Product_D-------
查看索引图：
> seqiplot(seq)
索引图
查看状态分布图：
> seqdplot(seq)
状态图
查看不同顾客类别之间是否有区别：
> seqdplot(seq, group = df$Cust_Segment)
不同顾客间的区别
可以看出，Segment2与其他顾客分类相比，购买ProductA的比例是最高的。
查看模态图：
> seqmsplot(seq, group = df$Cust_Segment)
模态图
大约有50%的Segment2类别的顾客首次购买商品是ProductA，而对于Segment4类别的顾客，最频繁的首次购买商品则是ProductD。
查看时间均值图：每种状态下花费的平均“时间”：
> seqmtplot(seq, group = df$Cust_Segment)
时间均值图
筛选出现频率大于5%的序列，绘制前10个序列：
> seqE <- seqecreate(seq)
> sub.seq <- seqefsub(seqE, pMinSupport = 0.05)
> plot(sub.seq[1:10], col = "dodgerblue")
筛选序列
这张图表示出序列在8种转换状态下的频率百分比。如果想进行简化，比如只使用前两种转换，可以在 seqecreate() 函数中设定索引。
使用数据创建一个转换矩阵，从而表示从一个状态转换到另一个状态的概率。一种矩阵包括所有状态之间的全部概率，另一种矩阵则表示从某个状态转换到另一种状态的概率，也就是时间变化矩阵。
> # time.varying=T则建立第二种矩阵
> seq.mat <- seqtrate(seq)
> options(digits = 2)
> seq.mat[2:4, 1:3]
## [-> ] [-> Product_A] [-> Product_B]
## [Product_A ->] 0.19 0.417 0.166
## [Product_B ->] 0.26 0.113 0.475
## [Product_C ->] 0.19 0.058 0.041
从矩阵中可以看出，购买ProductA之后，有差不多42%的概率还会再购买一次ProductA，有19%的概率不再购买商品，有17%的概率会购买ProductB。
检查的最后一项结果是对于每种购买行为，随后不再购买商品的概率：
> seq.mat[, 1]
## [ ->] [Product_A ->] [Product_B ->] [Product_C ->] [Product_D ->]
## 1.00 0.19 0.26 0.19 0.33
## [Product_E ->] [Product_F ->] [Product_G ->]
## 0.18 0.25 0.41
从矩阵中可以看出，如果没有购买行为，那么随后也不再购买商品的概率为100%。还有，我们发现，获得ProductD之后，不再购买商品的概率是33%。
