电商平台关联法则模型及推荐系统实现（R语言）
电商平台推荐系统
关联规则算法在电商行业中的应用
Apriori算法应用广泛，可用于消费市场价格分析，猜测顾客的消费习惯，比如较有名的“尿布和啤酒”的故事。其核心思想是通过连接产生候选项及其支持度，然后通过剪枝生成频繁项集，这里的频繁项集是指所有支持度大于等于给定最小支持度的项集。
项集：在关联分析中，包含0个或多个项的集合被称为项集（itemset）。如果一个项集包含k个项，则称它为k-项集。空集是指不包含任何项的项集。
数据集情况
现有数据集如下：
说明：数据量：564169 原始字段：12
字段介绍：
-
Unnamed: 行号
event_time：下单时间
order_id：订单编号
product_id:产品标号
category_id :类别编号
category_code :类别
brand :品牌
price :价格
user_id :用户编号
age :年龄
sex :性别
local:省份
X event_time order_id product_id category_id category_code brand price user_id age sex local count time
<int> <chr> <int> <int> <int> <chr> <chr> <dbl> <int> <dbl> <chr> <chr> <dbl> <drtn>
1 0 2020-04-24 11:50:39 UTC 1 6 313 electronics.tablet samsung 162.01 2477 24 女 海南 1 210.9305 days
2 1 2020-04-24 11:50:39 UTC 1 6 313 electronics.tablet samsung 162.01 2477 24 女 海南 1 210.9305 days
3 2 2020-04-24 14:37:43 UTC 2 2962 345 electronics.audio.headphone huawei 77.52 10872 38 女 北京 1 210.8144 days
4 3 2020-04-24 14:37:43 UTC 2 2962 345 electronics.audio.headphone huawei 77.52 10872 38 女 北京 1 210.8144 days
5 4 2020-04-24 19:16:21 UTC 3 2929 619 karcher 217.57 4685 32 女 广东 1 210.6209 days
数据预处理
①导入数据：
#导入数据
data<- read.csv("taobaodata.csv",,encoding='UTF-8')
#增加计数变量
count<-rep(1,564169)
count<-as.data.frame(count)
data$count<-count$count
每个订单都加入一个计数count=1，便于数量统计。
销售数量统计：
#按用户进行销售额统计
user_id_pay<-aggregate(x =data$price, by= list(data$user_id), FUN = sum)
user_id_count<-aggregate(x =data$count, by= list(data$user_id), FUN = sum)
head(user_id_pay)
head(user_id_count)
提取数据：商品类别ID，用户ID
payrules<-aggregate(x =count, by= list(data$user_id,data$category_id), FUN = sum)
colnames(payrules)<-c('userID','categoryID','payrules')
head(payrules)
#筛选有两次以上购买行为的用户进行分析
userstat<-user_id_count[which(user_id_count$x>=2),]
colnames(userstat)<-c('userID','count')
#inner模式匹配,将购买超过两次的用户和用户-产品表连接
rulestable<-merge(payrules,userstat,all=TRUE,sort=TRUE,by = 'userID')
#筛选出需要建模的部分
payrules2<-rulestable[which(rulestable$count>=2),]
payrules2
结果如下：
userID categoryID payrules
<int> <int> <dbl>
1 211 1 2
2 342 1 1
3 374 1 1
4 411 1 1
5 562 1 1
6 661 1 1
userID categoryID payrules count
<int> <int> <dbl> <dbl>
2 2 165 1 2
3 2 179 1 2
4 3 499 1 14
5 3 330 1 14
6 3 522 1 14
7 3 627 1 14
将购买事项集转换为购买矩阵：
# 利用cast函数对数据进行重组
library(reshape)
data_matrix<-cast(payrules2,userID~categoryID,value = "payrules")
# 进行替换，将NA转化为0，其他数字为1
data_matrix_new <- apply(data_matrix[,-1],2,function(x) {ifelse(is.na(x),0,1)})
# 对矩阵行名称、列名称进行赋值
data_matrix_new <- matrix(data_matrix_new,nrow=dim(data_matrix_new)[1],
ncol=dim(data_matrix_new)[2],
dimnames = list(data_matrix[,1],colnames(data_matrix)[-1]))
# 查看前三行五列数据
data_matrix_new[1:3,1:5]
结果如下：
②可发现，未购买某种产品记为NA。应当将NA转化为0，其余的转换为1.
# 进行替换，将NA转化为0，其他数字为1
data_matrix_new <- apply(data_matrix[,-1],2,function(x) {ifelse(is.na(x),0,1)})
# 对矩阵行名称、列名称进行赋值
data_matrix_new <- matrix(data_matrix_new,nrow=dim(data_matrix_new)[1],
ncol=dim(data_matrix_new)[2],
dimnames = list(data_matrix[,1],colnames(data_matrix)[-1]))
# 查看前三行五列数据
data_matrix_new[1:5,1:6]
结果如下：
1 2 3 4 5
2 0 0 0 0 0
3 0 0 0 0 0
4 0 0 1 0 0
进行数据建模
③再利用as函数将矩阵转换为事务型。
library(arules)
data_class <- as(data_matrix_new,"transactions")
inspect(data_class[1:6]) # 查看前六条交易记录
summary(data_class) # 查看汇总信息
结果如下：
Loading required package: Matrix
Attaching package: ‘Matrix’
The following object is masked from ‘package:reshape’:
expand
Attaching package: ‘arules’
The following object is masked from ‘package:dplyr’:
recode
The following objects are masked from ‘package:base’:
abbreviate, write
items transactionID
[1] {165,
179} 2
[2] {250,
329,
330,
345,
499,
522,
627,
828} 3
[3] {3,
63,
139,
277,
309,
320,
329,
345,
395,
396,
455,
463,
569,
745,
787} 4
[4] {399,
818} 5
[5] {15,
30,
150,
329,
333,
828} 6
[6] {30,
141,
186,
329} 7
transactions as itemMatrix in sparse format with
59474 rows (elements/itemsets/transactions) and
824 columns (items) and a density of 0.005793488
most frequent items:
329 150 345 828 15 (Other)
30253 9022 8750 7126 6202 222566
element (itemset/transaction) length distribution:
sizes
1 2 3 4 5 6 7 8 9 10 11 12 13
9929 19464 10120 6038 3797 2442 1714 1187 849 631 445 369 293
14 15 16 17 18 19 20 21 22 23 24 25 26
210 182 153 118 98 79 72 61 67 39 41 44 36
.......省略了
Min. 1st Qu. Median Mean 3rd Qu. Max.
1.000 2.000 3.000 4.774 4.000 176.000
includes extended item information - examples:
labels
1 1
2 2
3 3
includes extended transaction information - examples:
transactionID
1 2
2 3
3 4
⑤绘制描述所包含的特定商品交易比例的柱状图。
par(mfrow=c(2,1))
# 输出支持度support大于0.05的项集的支持度频率图
itemFrequencyPlot(data_class,support=0.05,main="support大于0.05的项集支持度频率图")
# 输出支持度support最大的前20个项集的支持度频率图
itemFrequencyPlot(data_class,topN=20,main="support最大的前20个项集的支持度频率图")
par(mfrow=c(1,1))
⑥建立关联规则rules，设定最小支持度阈值为0.005，最小置信度阈值为0.1，每项集最小项目数为2，并通过summer函数查看规则的汇总信息。
# 建立关联规则rules
rules <- apriori(data_class,
parameter=list(support=0.005,confidence=0.1,target="rules",minlen=2))
summary(rules) # 查看规则汇总信息
结果如下：
Apriori
Parameter specification:
confidence minval smax arem aval originalSupport maxtime support minlen
0.1 0.1 1 none FALSE TRUE 5 5e-05 2
maxlen target ext
10 rules TRUE
Algorithmic control:
filter tree heap memopt load sort verbose
0.1 TRUE TRUE FALSE TRUE 2 TRUE
Absolute minimum support count: 2
set item appearances ...[0 item(s)] done [0.00s].
set transactions ...[824 item(s), 59474 transaction(s)] done [0.03s].
sorting and recoding items ... [683 item(s)] done [0.01s].
creating transaction tree ... done [0.02s].
checking subsets of size 1 2 3 4
Warning message in apriori(data_class, parameter = list(support = 5e-05, confidence = 0.1, :
“Mining stopped (time limit reached). Only patterns up to a length of 4 returned!”
第一部分：规则的长度分布（前项+后项）及其对应的5个分位数和均值的统计信息。len=2有42条规则，len=3有6条规则。
第二部分：支持度，置信度和提升度的描述统计信息。
第三部分：挖掘的相关信息。
⑦可以通过inspect函数查看关联规则，quality函数提取每条规则的支持度，置信度和提升度信息。
inspect(rules[1:6]) # 查看前六条规则
quality(rules[1:6]) # 提取前六条规则信息
# 对规则按照提升度排序，并输出提升度最大的前六条规则
inspect(sort(rules,by="lift")[1:6])
结果如下：
> inspect(rules[1:8]) # 查看前8条规则
lhs rhs support confidence coverage lift count
[1] {45} => {329} 0.05168645 0.5195200 0.09948885 1.021318 3074
[2] {329} => {45} 0.05168645 0.1016098 0.50867606 1.021318 3074
[3] {15} => {329} 0.05661297 0.5428894 0.10428086 1.067260 3367
[4] {329} => {15} 0.05661297 0.1112947 0.50867606 1.067260 3367
[5] {30} => {329} 0.05632713 0.5603881 0.10051451 1.101660 3350
[6] {329} => {30} 0.05632713 0.1107328 0.50867606 1.101660 3350
[7] {828} => {329} 0.06673504 0.5569745 0.11981706 1.094949 3969
[8] {329} => {828} 0.06673504 0.1311936 0.50867606 1.094949 3969
> quality(rules[1:6]) # 提取前六条规则信息
support confidence coverage lift count
1 0.015994882 0.9009009 0.01775432 13.190708 100
2 0.015994882 0.2341920 0.06829814 13.190708 100
3 0.007677543 0.2330097 0.03294946 3.411655 48
4 0.007677543 0.1124122 0.06829814 3.411655 48
5 0.008957134 0.2718447 0.03294946 1.463887 56
6 0.007517594 0.2061404 0.03646833 2.210617 47
由此说明APRIORI算法是不考虑物品购买先后顺序的。 如果需要考虑顺序因素，利用arulesSequences包中的cspade函数实现cSPADE算法。
⑨可视化
利用rulesViz包中的plot()函数对关联规则进行可视化。 例如，相对提升度大于2 的规则绘制关联图形(method=“graph”)。
# 对关联规则进行可视化
rules_lift <- subset(rules,subset=lift>2)
library(arulesViz)
#绘制关联图形
plot(rules_lift,method="graph",
control = list(nodeCol = grey.colors(10),
edgeCol = grey(.7), alpha = 1))
图中圆圈代表 规则的支持度（0.006~0.019），圆圈越大表示支持度越大。圆圈的颜色深浅代表 规则的提升度 (2.211~13.191)，颜色从灰色到黑色表示提升度由小到大。
支持度： 一个项集或者规则在所有事物中出现的频率，确定规则可以用于给定数据集的频繁程度。σ(X):表示项集X的支持度计数项集X的支持度：s(X)=σ(X)/N；规则X → Y的支持度：s(X → Y) = σ(X∪Y) / N
置信度：
确定Y在包含X的事务中出现的频繁程度。c(X → Y) = σ(X∪Y)/σ(X)
通俗解释：简单地说，可信度就是指在出现了物品集X 的事务T 中，物品集Y 也同时出现的概率有多大。
概率描述：物品集X对物品集Y的置信度confidence（X==>Y）=P（X|Y）
实例说明：上该关联规则的可信度就回答了这样一个问题：如果一个顾客购买了10000金币，那么他也购买50个滑板的可能性有多大呢？在上述例子中，购买10000金币的顾客中有65％的人购买了50个滑板, 所以可信度是50％。
期望置信度（Expected confidence）
定义：设W 中有e ％的事务支持物品集B，e ％称为关联规则A→B 的期望可信度度。
通俗解释：期望可信度描述了在没有任何条件影响时，物品集B 在所有事务中出现的概率有多大。
实例说明：如果某天共有1000 个用户到购买物品，其中有250 个顾客购买了10000个金币，则上述的关联规则的期望可信度就是25 ％。
概率描述：物品集A对物品集B的期望置信度为support（B）=P（B）
提升度（lift）
定义：提升度是可信度与期望可信度的比值
通俗解释：提升度反映了“物品集A的出现”对物品集B的出现概率发生了多大的变化。
实例说明：上述的关联规则的提升度=65%/25%=2.6
概率描述：物品集A对物品集B的期望置信度为lift（A==>B）=confidence（A==>B）/support(B)=p(B|A)/p(B)
提升度判断： 如果lift=1 ，说明两个事项没有任何关联 ；如果lift<1 ，说明A事件的发生与B事件是相斥 的。一般在数据挖掘中当提升度大于3 时，我们才承认挖掘出的关联规则是有价值的 。
总结：
支持度：就是概率（一项就是其出现的概率，多项就是其同时出现的概率）
置信度：条件概率（A出现后，B也出现的概率）
总之，可信度是对关联规则的准确度的衡量，支持度是对关联规则重要性的衡量。支持度说明了这条规则在所有事务中有多大的代表性，显然支持度越大，关联规则越重要。
有些关联规则可信度虽然很高，但支持度却很低，说明该关联规则实用的机会很小，因此也不重要。
将method设置为"grouped"，可以绘制分组矩阵。
#绘制分组矩阵
plot(rules_lift,method = "grouped",
control = list(col = grey.colors(10)))
# 将规则导出到本地
write(rules,"rules.txt",sep="|",row.names=F)
圆圈表示支持度，圆圈越大表示支持度越大，颜色代表提升度，颜色由灰到黑色表示提升度由小到大。
上面是LHS（前项），是道具名称和规则数目；右边是RHS（后项），是道具名称。
导出数据可得到：
lhs rhs support confidence coverage lift count
[1] {30} => {329} 0.05632713 0.5603881 0.10051451 1.101660 3350
[2] {329} => {30} 0.05632713 0.1107328 0.50867606 1.101660 3350
[3] {345} => {329} 0.08228806 0.5593143 0.14712311 1.099549 4894
[4] {329} => {345} 0.08228806 0.1617691 0.50867606 1.099549 4894
[5] {828} => {329} 0.06673504 0.5569745 0.11981706 1.094949 3969
[6] {329} => {828} 0.06673504 0.1311936 0.50867606 1.094949 3969
[7] {15} => {329} 0.05661297 0.5428894 0.10428086 1.067260 3367
规则分布可视化：
library(arulesViz)
plot(rules, method="scatterplot",control=list(jitter=2), shading = "lift")
plot(rules,shading = "lift",method ='grouped')
#plot(rules, method="grouped",control=list(col = rev(brewer.pal(9, "Greens")[4:9])))
#注，该矩阵展示图采用聚类的方式将rhs进行聚集，然后以矩阵方式加以表现，rhs的items可使用RHS<-unique(arules::rhs(groceryrules))查看
可发现潜在规则巨量，且集中在左侧，可提取较显著的规则进行分析。
通过购物网络进行聚类，建立产品分类模型
#玩家物品购买分类分析
# 将data_matrix_new数据转换成from、to的形式
data_new <- c()
for(i in 1:nrow(data_matrix_new)){
item.i <- colnames(data_matrix_new)[which(data_matrix_new[i,]==1)]
item.i.num <- length(item.i)
from <- c();to <- c()
for(m in 1:(item.i.num-1)){
from <- c(from,item.i[-c((item.i.num-m+1):item.i.num)])
to <- c(to,item.i[-c(1:m)])
}
data_new <- rbind(data_new,matrix(c(from,to),ncol = 2))
}
data_new <- as.data.frame(data_new)
head(data_new)
# 对转换后的数据进行汇总，并按照频数进行降序排序
结果如下：
V1 V2
<chr> <chr>
1 165 179
2 250 329
3 329 330
4 330 345
5 345 499
6 499 522
利用sql语法进行数据处理，发现社群结构
library(sqldf)
data_count <- sqldf("select V1,V2,count(*) from data_new group by V1,V2")
colnames(data_count) <- c("from","to","qty")
data_count <- data_count[order(data_count$qty,decreasing = T),]
head(data_count)
# 将数据转换为graph.object，并利用多种聚类算法发现社群结构
结果如下：
from to qty
<chr> <chr> <int>
54065 329 345 4894
17668 150 329 4831
54503 329 828 3969
17073 15 329 3367
47518 30 329 3350
76146 45 329 3074
进行聚类：
library(igraph)
G <- graph.data.frame(data_count[1:100,],directed = F)
E(G)$weight <- data_count[1:100,"qty"]
fc1 <- multilevel.community(G) # 多层次聚类
fc2 <- edge.betweenness.community(G) # 边中间性聚类
fc3 <- walktrap.community(G) #随机游走聚类
fc4 <- infomap.community(G) #infomap算法聚类
fc5 <- spinglass.community(G) # 自旋玻璃社群聚类
fc6 <- label.propagation.community(G) # 标签传播
fc_list <- list(fc1,fc2,fc3,fc4,fc5,fc6)
algorithm_list <- c("Multi-level clustering","Edge intermediate clustering","Random walk clustering",
"Infomap algorithm clustering","Spin glass community clustering","Label propagation clustering")
par(mfrow=c(2,3))
for(i in 1:6){
plot(fc_list[[i]],G,main=algorithm_list[[i]])
}
par(mfrow=c(1,1))
选取较为优良的聚类方法进行聚类：
fc2 <- edge.betweenness.community(G) # 边中间性聚类
fc_list <- list(fc5)
algorithm_list <- c("Spin glass community clustering")
plot(fc_list[[1]],G,main=algorithm_list[[1]])
可根据聚类结果进行进一步分析，，探究该社群结构的特点。
为电商平台建立推荐系统
数据处理
转化为binaryRatingMatrix对象
#install.packages('recommenderlab')
library(recommenderlab)
# 将矩阵转化为binaryRatingMatrix对象
data_class <- as(data_matrix_new,"binaryRatingMatrix")
as(data_class,"matrix")[1:13,1:15] #显示部分物品购买情况
结果如下：
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
2 FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
3 FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
4 FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
5 FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
6 FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
7 FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
8 FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
9 FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
10 FALSE TRUE FALSE TRUE TRUE TRUE FALSE FALSE FALSE TRUE FALSE FALSE TRUE FALSE TRUE
搭建模型
搭建模型：
# 建立三种模型，并对模型进行评价
# 创建一个评分方案 (十折交叉验证)
scheme <- evaluationScheme(data_class, method="cross-validation",
k=10, given=-1)
## 创建用于评估模型的算法列表
algorithms <- list(
POPULAR = list(name = "POPULAR", param = NULL),
UBCF=list(name="UBCF",param=NULL),
IBCF=list(name="IBCF",param=NULL)
)
# 对模型进行评价
result <- evaluate(scheme,algorithms,n=1:5)
# 输出ROC曲线和precision-recall曲线
par(mfrow=c(1,2))
plot(result,lty=1:3,annotate=1:3,legend="topleft") # ROC
plot(result,"prec/rec",lty=1:3,annotate=1:3) #precision-recall
par(mfrow=c(1,1))
可发现：基于流行度的推荐系统更合适。
上图是得到的三个推荐模型的ROC曲线和PR曲线。ROC曲线越凸向左上角效果越好，有时不同分类算法的ROC曲线存在交叉，可用AUC（Area Under Curve，曲线下的面积）值作为算法好坏的评价标准，AUC越大算法效果越好；与ROC曲线左上凸不同的是，PR曲线是右上凸效果好，可见，无论是ROC曲线还是PR曲线，基于POPULAR（流行度推荐模型）的AUC都是最大的，因此认为基于流行度的推荐系统模型比其他的两个模型的效果更好。 最后选取POPULAR建立推荐模型，对用户进行top3推荐。
训练模型并进行对比
# 按照评价方案建立推荐模型
model.popular <- Recommender(getData(scheme,"train"),method="POPULAR")
model.ubcf <- Recommender(getData(scheme,"train"),method="UBCF")
model.ibcf <- Recommender(getData(scheme,"train"),method="IBCF")
# 对推荐模型进行预测
predict.popular <- predict(model.popular,getData(scheme,"known"),type="topNList")
predict.ubcf <- predict(model.ubcf,getData(scheme,"known"),type="topNList")
predict.ibcf <- predict(model.ibcf,getData(scheme,"known"),type="topNList")
# calcPredictionAccuracy()的参数"know"和"unknow"表示对测试集的进一步划分：
# "know"表示用户已经评分的，要用来预测的items；
# "unknow"表示用户已经评分，要被预测以便于进行模型评价的item
predict.err <- rbind(calcPredictionAccuracy(predict.popular,getData(scheme,"unknow"),given=3),
calcPredictionAccuracy(predict.ubcf,getData(scheme,"unknow"),given=3),
calcPredictionAccuracy(predict.ibcf,getData(scheme,"unknow"),given=3))
rownames(predict.err) <- c("POPULAR",'UBCF','IBCF')
round(predict.err,3)
TP FP FN TN N precision recall TPR FPR
POPULAR 0.4720950 9.527905 0.5279050 809.4721 820 0.04720950 0.4720950 0.4720950 0.011633584
IBCF 0.2061917 8.129432 0.7938083 810.8706 820 0.02471695 0.2061917 0.2061917 0.009926046
进行商品推荐
对用户进行推荐即可得到推荐产品情况：
#选择POPULAR作为最优模型
model.best <- Recommender(data_class,method="POPULAR")
$`2`
'329''150''345''828''15'
$`3`
'150''15''30''45''141'
$`4`
'150''828''15''30''45'
$`5`
'329''150''345''828''15'
$`6`
'345''45''141''425''418'
$`7`
'150''345''828''15''45'
$`8`
'329''345''45''425''418'
$`9`
'150''345''15''30''45'
$`10`
'329''150''345''828''425'
$`11`
'150''828''30''45''141'
$`12`
'329''150''345''15''30'
关于产品的可视化：
itemFrequencyPlot(data_class, support = 0.05, cex.names=0.8, xlim = c(0,0.3),
type = "relative", horiz = TRUE, col = "dark red", las = 1,
xlab = paste("Analysis of the association of online shopping goods",
"\n(Item Relative Frequency or Support)"))
227
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
