苏果超市R语言关联分析

一、超市总体销售情况
1.1.数据预处理
读取超市数据并命名数据集 dat，观察数据，并更改原始数据中时间的记录方式：

dat<-read.csv("某超市销售数据.csv")dat$销售时间<-format(dat$销售时间,scientific=FALSE)

由于售货员姓名对分析不产生影响，删除该列，并重新命名各列：

dat<-dat[,-c(1)]names(dat)<-c("ID","time","No.","item","price","num","total")as.factor(dat$item)#将产品名称设置为因子变量

为了分别按照日期和时间段进行分析，把销售时间拆分为两部分，销售日期和销售时间。

date<-substr(dat$time,1,8)hour<-substr(dat$time,9,10)#文本拆分，按照日期与时间dat<-data.frame(dat,date=date,hour=hour)#更新数据集

1.2不同产品的销售量及销售额
此处利用tapply函数进行分组计算，分别得到每种产品的销售额及销售量，并进行排序：

cp<-tapply(dat$total,dat$item,sum)#计算每种产品的销售额cpn<-tapply(dat$num,dat$item,sum)#计算每种产品的销售量cp<-data.frame(cp)cpn<-data.frame(cpn)ocpn<-cpn[order(cpn,decreasing = T),]#对产品销售量进行排序ocp<-cp[order(cp,decreasing = T),]#对产品销售额进行排序

可以发现，销量较高的产品中，小吃类占大多数。

销售额较高的则主要是香烟，对于烤肠这种成本低，销售额却高的产品，看来是每家超市必进的商品。
1.4对不同时间段超市运营情况的分析
想要从时间角度来对超市运营情况分析，首先要做的就是对数据集按照不同的时间分布来进行合并，此处我们分别按照日期和小时来进行数据的合并。

datecp<-tapply(dat$total,dat$date,sum)hourcp<-tapply(dat$total,dat$hour,sum)

tapply函数得到的结果是一组向量，并且是带行名的向量，因此需要对所得到数据集进行一个处理方便后续分析。

days<-rownames(datecp)hour<-rownames(hourcp)cp<-as.vector(hourcp)hourcp<-data.frame(hour=hour,cp=cp)#每小时销售总额datecp<-data.frame(days=days,cp=as.vector(datecp))#每日销售额

这一段代码是对行名进行提取，将日期和时间提取出来，分别作为新数据框的首列。

datecp$days<-as.Date(datecp$days,"%Y%m%d")#将日期转为时间序列数据hourcp$hour<-as.character(hourcp$hour)#将小时转为文本数据，方便后续作图。

完成对数据格式的处理后，可以按照日期和每天的时间点进行时间序列图的绘制：

es.csv", sep=",", quote=TRUE, row.names=FALSE)> plot(basketrule,control=list(jitter=2),shading 

由日销售额趋势图可以看到，十月和二月中旬的销售额分别因为国庆节和春节有一个明显的峰值，平时的销售额则基本在3000左右波动。

三、关联分析
3.1数据预处理
在进行关联分析前，需要将数据转化为适应的购物篮数据，首先对提取原数据集中我们需要的两类数据，一个是购物单据号，一个是商品货号

y<-data.frame(dat$ID,dat$item)head(y)y$dat.ID<-as.character(y$dat.ID)

得到该组数据框后，保存为数据集b，需要去除购物袋、合计分舍去、以及积点印花三项，分别为无关项、负项及0项。

b<-read.table("3333.csv",sep=",")head(b)b<-b[-c(which(b$V2==" 华润苏果大号购物袋"),which(b$V2==" 合计分舍去"),which(b$V2==" 华润苏果中号购物袋"),which(b$V2==" 苏果小号购物袋"),which(b$V2==" 积点印花")),]#去除塑料袋和合计分舍去head(b)

去掉新数据集的行名和列名后，保存为csv格式，可以适应read.transactions函数，将最终数据保存为购物篮数据。

basket <- read.transactions("finaldat.csv", format="single", sep=",",cols=c(1, 2),rm.duplicates=TRUE)

进一步地对该购物篮数据进行一个初步的了解，对其summary后得到

可以发现，有18936次购买是单一商品购买，这对我们的分析是没有意义的，因此删除单一商品购买的单据。

summary(basket)class(basket)basketsize<-size(basket)#购物篮大小basket_use<-basket[basketsize>1]#去除仅包含一种商品的购物篮。

我们可以查看此时支持度大于0.01的商品

并抽取1000个单据，观察每个商品在单据中出现的分布图：

temFrequencyPlot(basket_use, support=0.01)  #支持度大于0.01的商品image(sample(basket_use,1000))#抽样1000个项集中商品出现的次数

3.2利用apriori算法进行关联分析
完成了数据整理后，我们可以对购物篮进行关联分析，由于一共有31878次交易，认为至少发生30次以上的购物才有分析的意义，因此参数设置最小支持度为0.001，置信度为0.3。共生成了22条关联规则并保存关联结果：

basketrule<-apriori(basket_use, parameter = list(support =0.001, confidence = 0.3,minlen=2)) summary(basketrule)inspect(basketrule)write(basketrule, file="rules.csv", sep=",", quote=TRUE, row.names=FALSE) length(b$V1)plot(basketrule,control=list(jitter=2),shading = "lift")rules   support confidence  lift

{ 立顿香草白巧克力味奶茶饮料} => { 立顿醇香经典英式奶茶} 0.001035774 0.433333333 181.2922
{ 立顿醇香经典英式奶茶} => { 立顿香草白巧克力味奶茶饮料} 0.001035774 0.433333333 181.2922
{ 脆香米奶香白巧克力} => { 脆香米牛奶巧克力} 0.001354474 0.566666667 151.3241
{ 脆香米牛奶巧克力} => { 脆香米奶香白巧克力} 0.001354474 0.361702128 151.3241
{ 辛拉面(香菇牛肉面)} => { 农心辣白菜味辛拉面} 0.001354474 0.395348837 95.42352
{ 农心辣白菜味辛拉面} => { 辛拉面(香菇牛肉面)} 0.001354474 0.326923077 95.42352
{ 卫岗大红枣酸牛奶} => { 卫岗蓝莓味酸牛奶} 0.001354474 0.377777778 86.20889
{ 卫岗蓝莓味酸牛奶} => { 卫岗大红枣酸牛奶} 0.001354474 0.309090909 86.20889
{ 康师傅经典奶茶(香浓味)} => { 康师傅经典奶茶(炼乳味)} 0.001832523 0.450980392 75.47007
{ 康师傅经典奶茶(炼乳味)} => { 康师傅经典奶茶(香浓味)} 0.001832523 0.306666667 75.47007
{ 青菜包(燕诚)} => { 豆沙包(燕诚)} 0.001115449 0.341463415 66.96418
{ 卫岗蓝莓味酸牛奶} => { 卫岗草莓果料低脂酸奶} 0.001434149 0.327272727 57.05
{ 双汇Q趣儿香辣风味香肠} => { 双汇孜然风味Q趣儿火腿肠} 0.001274799 0.307692308 56.79186
{ 卫岗大红枣酸牛奶} => { 卫岗草莓果料低脂酸奶} 0.001115449 0.311111111 54.23272
{ 康师傅脆旋风黑椒牛排味点心面} => { 康师傅脆旋风BBQ烧烤味点心面} 0.002549598 0.4 53.9828
{ 康师傅脆旋风BBQ烧烤味点心面} => { 康师傅脆旋风黑椒牛排味点心面} 0.002549598 0.344086022 53.9828
{ 淮牌低钠盐(海盐)} => { 淮牌低钠盐(纸塑)} 0.001354474 0.369565217 53.31509
{ 雪碧汽水} => { 可口可乐汽水} 0.002071548 0.472727273 21.11459
{ 青菜包(燕诚)} => { 五香鸡蛋} 0.001035774 0.317073171 9.874902
{ 甜不辣, 五香鸡蛋} => { 烤肠} 0.001035774 0.464285714 4.183238
{ 甜不辣} => { 烤肠} 0.012110589 0.413043478 3.721542
{ 鱼丸} => { 烤肠} 0.001354474 0.369565217 3.329801
通过这组数据可以看到，除了同类商品的Trivial类，Actionable类的关联规则包括：
{ 雪碧汽水} => { 可口可乐汽水}
{ 青菜包(燕诚)} => { 五香鸡蛋}
{ 甜不辣, 五香鸡蛋} => { 烤肠}
{ 甜不辣} => { 烤肠}
{ 鱼丸} => { 烤肠}

代码附录：

dat<-read.csv("某超市销售数据.csv")dat$销售时间<-format(dat$销售时间,scientific=FALSE)head(dat)dat<-dat[,-c(1)]names(dat)<-c("ID","time","No.","item","price","num","total")date<-substr(dat$time,1,8)hour<-substr(dat$time,9,10)#文本拆分，按照日期与时间dat<-data.frame(dat,date=date,hour=hour)#形成新的数据框 as.factor(dat$item)#将产品名称设置为因子变量 cp<-tapply(dat$total,dat$item,sum)#计算每种产品的销售额cp[cp<0]cpn<-tapply(dat$num,dat$item,sum)#计算每种产品的销售量cp<-data.frame(cp)cpn<-data.frame(cpn)ocpn<-cpn[order(cpn,decreasing = T),]#对产品销售量进行排序ocp<-cp[order(cp,decreasing = T),]#对产品销售额进行排序ocpn[1:10]ocp[1:10]datecp<-tapply(dat$total,dat$date,sum)hourcp<-tapply(dat$total,dat$hour,sum)days<-rownames(data.frame(datecp))#天数hour<-rownames(hourcp)cp<-as.vector(hourcp)hourcp<-data.frame(hour=hour,cp=cp)#每小时销售总额datecp<-data.frame(days=days,cp=as.vector(datecp))#每日销售额datecp$days<-as.Date(datecp$days,"%Y%m%d")library(ggplot2)hourcp$hour<-as.character(hourcp$hour)ggplot(datecp,aes(x=days,y=cp))+geom_line(size=1.3,color=rgb(red = 200, green = 100, blue = 169, max = 255))ggplot(hourcp,aes(x=hour,y=cp))+geom_line(aes(group=1))+geom_point(size=3)#绘制销售额图与时段销售额图# dat$ID<-as.character(dat$ID)# dat$No.<-as.character(dat$No.)#datcombine<-tapply(dat$No.,dat$ID,print)#将ID和商品号设置为文本数据并合并#bas<-data.frame(ID=rownames(datcombine),basket=as.vector(datcombine))#head(bas)#head(dat)#length(bas$basket[6])#bas[6,2]library(arules)#x<-as.vector(datcombine)#x<-read.transactions(x,format="basket",sep="")y<-data.frame(dat$ID,dat$item)head(y)y$dat.ID<-as.character(y$dat.ID)#x<-read.transactions(y,format="single",cols=c(1,2),sep="")#is.character(y$dat.No.)# write.csv(y,sep=",",file="3333.csv")b<-read.table("3333.csv",sep=",")head(b)b<-b[-c(which(b$V2==" 华润苏果大号购物袋"),which(b$V2==" 合计分舍去"),which(b$V2==" 华润苏果中号购物袋"),which(b$V2==" 苏果小号购物袋"),which(b$V2==" 积点印花")),]#去除塑料袋和合计分舍去head(b)# write.csv(b,file="finaldat.csv",sep=",")#去掉行名和列名basket <- read.transactions("finaldat.csv", format="single", sep=",",cols=c(1, 2),rm.duplicates=TRUE) summary(basket)class(basket)basketsize<-size(basket)#购物篮大小basket_use<-basket[basketsize>1]#去除仅包含一种商品的购物篮itemFrequencyPlot(basket_use, support=0.01)  #支持度大于0.01的商品image(sample(basket_use,1000))#抽样1000个项集中商品出现的次数basketrule<-apriori(basket_use, parameter = list(support =0.001, confidence = 0.3,minlen=2)) summary(basketrule)inspect(basketrule)write(basketrule, file="rules.csv", sep=",", quote=TRUE, row.names=FALSE) length(b$V1)plot(basketrule,control=list(jitter=2),shading = "lift") plot(basketrule,method="grouped")library(arulesViz)library(grid)# install.packages("arulesViz")# install.packages("mclust")