苏果超市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")