zoukankan      html  css  js  c++  java
  • [R语言]关联规则2---考虑items之间严格的时序关系

    前面介绍了关联规则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='	',row.names = F,col.names = T)

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

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

    #读取数据集

    payer<-read.table("orders_test.txt",sep='	',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")#通过箭头和圆圈来表示关联规则,利用顶点代表项集,边表示规则中关系。

    (本文所需的代码和数据集可以在这里下载)

  • 相关阅读:
    UVA
    codevs3196 黄金宝藏
    UVA
    UVA
    3424:Candies(差分约束,Dijkstra)(配对堆优化
    1062:昂贵的聘礼(最短路/枚举)
    01分数规划问题(二分法与Dinkelbach算法)
    Desert King(01分数规划问题)(最优斜率生成树)
    Enlarge GCD(素数筛)
    hdu2085-2086
  • 原文地址:https://www.cnblogs.com/lzllovesyl/p/5436944.html
Copyright © 2011-2022 走看看