[R语言]关联规则2---考虑items之间严格的时序关系

OStack程序员社区-中国程序员成长平台 › 门户 › 编程› R语言›R语言教程

原作者: [db:作者] 来自: [db:来源] 收藏邀请

前面介绍了关联规则1---不考虑用户购买的items之间的时序关系，但在一些情况下用户购买item是有严格的次序关系了，比如在某些休闲游戏中，用户购买了道具A才能购买道具B，且道具A和B只能购买一次，也就是说购买了道具A是购买道具B的充分条件，如果购买道具A的用户通常会购买道具A，在不考虑时序关系的时候，会得出“BàA”这样的关联规则，这会给运营的同事这样的结论：“购买了道具B的用户也非常有可能会购买道具A，当用户购买了道具B时应向其推荐道具A”，这从数据角度来说是没有问题的，但是从业务的角度来看是完全错误的，因为购买了道具B的用户一定是已经购买了道具A，且道具AB只能购买一次，再次向其推荐道具A是没用的。

基于这样的背景，本文介绍的是--- 考虑items之间严格的时序关系，来分析用户道具购买路径以及关联规则挖掘。（本文所需的代码和数据集可以在这里下载）

本文重点讲解的是关联规则的R语言实现以及关联规则的可视化，这里不对关联规则的原理进行讲解，可以参考百度百科---关联规则、维基百科--- Apriori algorithm、维基百科--- Association rule learning

目录
0.创建购买记录的数据集    
1.将购买记录转换为0-1矩阵    
2.得到每个用户的道具购买路径    
3.执行apriori算法并删除冗余规则    
4.关联规则的可视化

0.创建购买记录的数据集

下面创建一个1W条购买记录的数据集，一行代表一个用户，列分别是：用户id、道具名称pname、付费金额amount、购买时间time

数据的样式如下：

创建模拟数据集的代码详细讲解，请参考上一讲，这里只贴出代码：

rm(list=ls())
setwd("E:/cnblogs")

#下面创建一个1W条购买记录的数据集：
#列分别是：用户id、道具名称pname、付费金额amount、购买时间time

###有放回地抽取1W个从10000000到10002000，作为用户id
uid<-sample(10000000:10002000,10000,replace=T)

###将日期限定在20160401 10:01:01~20160408 10:01:01
start_time<-as.numeric(as.POSIXct("2016/04/01 10:01:01", format="%Y/%m/%d %H:%M:%S"))
end_time<-as.numeric(as.POSIXct("2016/04/08 10:01:01", format="%Y/%m/%d %H:%M:%S"))
time<-sample(start_time:end_time,10000,replace=T)
#将两者合并成一个数据框orders
orders<-data.frame(uid,time)
head(orders)

###下面用P1~P20来表示购买的道具名称
pname_list<-c(1:20)
for(i in 1:20){
  pname_list[i]<-paste('P',i,sep="")
}

#随机将道具名称传递到1W行上
orders$pname<-'P1'

for(i in 1:20){
  orders[sample(1:nrow(orders),1000,replace=T),'pname']<-pname_list[i]
}

orders$pname<-as.factor(orders$pname)

#随机将付费金额amount（1到50）传递到1W行上
orders$amount<-10
for(i in 1:50){
  orders[sample(1:nrow(orders),1000,replace=T),'amount']<-i
}

head(orders)
summary(orders)

#将数据集写回本地
write.table(orders,'orders_test.txt',sep='\t',row.names = F,col.names = T)

1.将购买记录转换为0-1矩阵

以上只是完成了第一步：创建数据集。下面进行第二步：将购买记录转换为0-1矩阵形式，其中行表示用户，列表示商品，用1表示用户购买了该道具。

#读取数据集

payer<-read.table("orders_test.txt",sep='\t',header=T)
head(payer)
dim(payer)

#将数据按照uid,pname,time 同一个用户id中购买的道具“pname”，按照购买时间time从小到大排序

library(sqldf)
payer2<-sqldf("select uid,pname,time from payer group by uid,pname,time order by uid,time")

#数据样式如下

head(payer2)

#从数据来看记录已经按照时间先后顺序来排列，将第3列时间去掉

payer3<-payer2[,-3]

#将用户id转换为因子型，是为了后面split函数使用

payer3$uid<-as.factor(payer3$uid)

2.得到每个用户的道具购买路径

#将道具名称pname按照相同的uid进行分组

trans.list<-split(payer3[,'pname'],payer3[,'uid'])

#此时相当于得到了用户的购买路径了，但是其中可能会有一个用户重复购买某个道具的情况

head(trans.list) 
str(trans.list)#共有1991个用户的购买路径

#测试一下，看用户的购买次序是不是按时间的先后次序

trans.list['10000003']#查看uid=10000003的用户购买道具的情况。
payer2[which(payer2$uid==10000003),]

从测试来看，trans.list中的数据是按照时间的先后次序来排列的

#####将数据变成关联规则函数Apriori可用的transactions形式

library(arules)
trans<-as(trans.list,'transactions')

#因为存在“一个用户重复购买某个道具的情况”，所以出现了以下错误：

Error in asMethod(object) :

can not coerce list with transactions with duplicated items

########因此这里需要加一步：在player3中将uid和pname重复的记录删除（为了后面transactions转换）

index<-duplicated(payer3[,c(1,2)])
payer6<-payer3[!index,]

trans.list<-split(payer6[,'pname'],payer6[,'uid'])
head(trans.list)#此时相当于“道具去重后”的用户购买路径了
str(trans.list)

#转换为apriori函数可以用的transactions形式

arules<-as(trans.list,'transactions')

3.执行apriori算法并删除冗余规则

######下面执行apriori算法（此部分与上一篇的内容相同，这里就不再进行详述，可参考上一篇）

rules<-apriori(arules,parameter = list(support=0.01,confidence=0.5))
inspect(rules)

#可以按照提升度排序
sorted_lift<-sort(rules,by='lift')
inspect(sorted_lift)

#规则较多，需要删除冗余规则：如果rules2的lhs和rhs是包含于rules1的，而且rules2的lift小于或者等于rules1，则称rules2是rules1的冗余规则。

subset.matrix<-is.subset(rules,rules)#生成一个所有规则的子集矩阵,行和列分别是每条rules，其中的值是TRUE和FALSE，当rules2是rules1的子集时，rules2在rules1的值为TRUE
subset.matrix[lower.tri(subset.matrix,diag=T)]<-NA#将矩阵对角线以下的元素置为空，只保留上三角
redundant<-colSums(subset.matrix,na.rm=T)>=1#R会将矩阵中的TRUE当做1，统计每列的和（忽略缺失值），如果该列的和大于等于1，也就是表示该列（规则）是别的规则的子集，应该删除。
which(redundant)

rules.pruned<-rules[!redundant]#去掉冗余的规则
inspect(rules.pruned)

#写回本地
#write(rules.pruned,"rules_pruned.txt",col.names=NA)

4.关联规则的可视化

########关联规则的可视化（此部分与上一篇的内容相同，这里就不再进行详述，可参考上一篇）

library("arulesViz")

#关联规则的散点图
plot(rules)# 直接plot画出散点图

plot(rules,interactive=TRUE)#可以使用interactive=TRUE来实现散点图的互动功能

plot(rules, method = "grouped")#类似“气泡图”的展现形式

plot(rules.pruned, method = "graph")#通过箭头和圆圈来表示关联规则，利用顶点代表项集，边表示规则中关系。