基于R语言的关联规则分析项目

转自http://blog.163.com/dm_team/blog/static/2379750132014891084989/

摘要

抱着成为一名优秀的数据分析师/数据挖掘师的理想，我们组成了一个数据分析团队。

在完成两周的关联规则自主学习后，我们开展了为期半个月的团队第一个合作分析项目——消费者购买情况的关联分析。

项目的数据来自于团队成员贡献的某公司2013年至2014年客户交易明细数据。根据商品购买情况、消费者的购买行为，最终做出商品之间的关联规则，多件购买和单件购买的关联规则，以及多次购买和单次购买的关联规则。这些生成的规则，揭示了客户购买行为的规律。这些规律可以对终端店铺销售人员起到指导作用，为公司的业务决策提供数据支持与依据。此外，生成的规则可以在后续的工作中，运用其他的挖掘方法（如预测等），挖掘更深层次的购买规律。

项目代码通过R语言进行撰写。由于团队中大部分成员的R语言尚处于入门阶段，故在数据处理中，使用了sqldf包实现。

项目通过arules包实现频繁项集和关联规则的生成，并通过余弦度量、lift等对规则进行评估和筛选。

项目代码主要由天真、沫沫和关东煮编写，后期整理及博客撰写由关东煮完成。

关联规则介绍

关联规则是反映一个事物与其他事物之间的关联性。若两个或者多个事物之间存在着关联关系，那么其中的一个事物就能通过其他事物预测到。关联规则也是数据挖掘中最活跃的研究方法之一，广泛运用于购物篮数据、生物信息学、医疗诊断、网页挖掘和科学数据分析中。由其所发现的关系可由关联规则或者频繁项集的形式来表示。

关联规则产生过程通过两个重要的步骤实现：一是频繁项集的生成，二是形成关联规则。

基本概念：

关联规则是形如A→B的蕴含式，即：A∈I，B∈I，且A∩B=?。若上述规则成立，需满足支持度s和置信度C。

支持度是事务集合D中包含A∪B的事务所占百分比，即可以理解为A和B同时发生在总事物集合D里的百分比。而置信度C，是D中B在出现A的事务的百分比，即条件概率P（B|A）。

项的集合称为项集，包含K个项的集合被称为K-项集，若k-项集满足人为设定的最小支持度，即称之频繁k-项集。

频繁项集的产生

apriori算法

apriori性质：即为先验原理，如果一个项集是频繁的，则它的所有非空子集也一定是频繁的。反过来说，如果一个项集是不频繁的，那么它的所有超集一定是不频繁的。若项集A不满足最小支持度阈值s，则A不频繁，P(A)<s.而若添加b到A，那么结果项集{A,b}的支持度肯定会小于A的支持度，那么{A,b}也是不频繁的。

连接步的原理：假设事物和项集中的项按字典排序，若k-1频繁项集中i1和i2的前k-2个元素是相同的，那么i1和i2可连接产生新的项集ck。

剪枝步原理：ck为lk的超集，扫描ck中的每一个项集在总事物数据库中的计数以计算支持度，大于支持度阈值的则为超集，不满足条件项集的将被抛弃。在这其中因可能产生的项集数目过大，导致计算量过大，则可在此步使用apriori性质，即若k项集的子集k-1不在频繁k-1项集中，那么该候选将肯定不是频繁的，直接予以删除。

算法步骤：

输入：事物数据库D；最小支持度阈值

运行步骤：

扫描数据库，产生1项集；

计数1项集，剪枝1项集，得到频繁1项集；

根据频繁1项集进行连接，产生候选2项集；

扫描数据库，抛弃C2中计数不足的部分产生L2；

使用apriori性质，产生并同时剪枝（剪掉非频繁）得到C3；

扫描数据库，抛弃C3中计数不足的部分产生L3；

……

输出：频繁项集

算法缺点：需要多次扫描数据库；生成大量候选项集；计算量太大。

算法优化：

1.减少扫描数据库次数

划分事务集，将原始事务集划分为N个非重叠部分，产生局部频繁项集后再评估全局频繁项集。

动态候选项集计数，动态计数已被计数的所有项集的支持度，若一个项集的所有子集都是频繁的，才会被添加为新的候选项集。

2. 减少候选项集

在Apriori剪枝规则基础上引入哈希表的方法，将候选项集划分为不同的桶。支持度计数时，将候选项集与同一桶内候选项集匹配，而不是将事务中每个项集与所有候选项集进行比较。

FP-GROWTH算法

FP-GROWTH算法原理：FP树以null为根节点，第一次扫描数据库，对每个1项集进行支持度排序，丢弃非频繁项，并根据支持度递减排序，1项集作为子节点，同时树上有其支持度计数。然后第二次扫描数据库，为一个事物增加分支时，沿前共同前缀上的每个节点增加1，并为前缀之后创建新的节点。

FP-树的挖掘：自下向上探索FP树。每一个事物都映射到FP树中的一条路径，因此只考察包含特定节点的路径，就可以发现以特定项结尾的频繁项集。

FP-GROWTH算法步骤：

输入：事物数据库D；最小支持度阈值

1. FP-树构建

扫描数据库，收集1-项集的支持度，并对生成的频繁1-项集F按支持度降序排序；

创建树的根节点NULL，对于数据库中的每一个trans，执行：

选择trans中的频繁项，按F的秩序排序。

对于trans，其链接在排序第1的频繁项上，并在此树节点的计数增加1；

若后续频繁项已在此父节点上有链接，那么依次增加计数1；

若无链接，则新增树节点，计数设置为1；

递归计算树的增长

2. FP树挖掘

遍历表头项中的每一项，对于各项（例如：F）都执行以下操作：

（1） 从FP-Tree中找到所有的包含F的节点，向上遍历它的祖先节点，得到N条路径。

（2） 对于每一条路径上的节点，其计数都设置为F的计数。

（3） 统计满足支持度计数的项集，生成频繁项集

FP-GROWTH算法特点：

FP-树是一个高度压缩的结构，它存储了用于挖掘频繁项集的全部信息。FP-树所占用的内存空间与树的深度和宽度成比例，树的深度一般是单个事务中所含项目数量的最大值；树的宽度是平均每层所含项目的数量。由于在事务处理中通常会存在着大量的共享频繁项，所以树的大小通常比原数据库小很多。频繁项集中的项以支持度降序排列，支持度越高的项与FP-tree的根距离越近，因此有更多的机会共享结点，这进一步保证了FP-tree的高度压缩。

但FP-树也可能发生最坏的情况，即树的子结点过多，例如生成了只包含前缀的树，那么也会导致算法效率大幅度下降。

关联规则的产生

规则的生成

关联规则是形如X→Y的蕴含式，其中X被称为LHS（左手），Y被称为RHS（右手）。可将其置信度理解为条件概率，即X发生时，Y发生的概率。若其概率大于预先设定的最小支持度阈值，则此规则符合产生的条件。

规则的评判指标

主观兴趣度量：关联规则的兴趣度量可以建立在主观之上，通过规则的可视化、限定左右手、概念分层、序列限定等等均可以排除显而易见的或者没有实际价值的规则。

客观性去度量：

1. 提升度：计算规则置信度和规则后件中项集的支持度之间的比率。其等于1为左右手相互独立，大于1为正相关，小于1为负相关。

2. IS度量，用于处理二元非对称变量。在数学上，等价于二元变量的余弦度量。因其取决于左右手的支持度，其同样也可能产生与置信度相同的问题（辛普森悖论）。

3. 其他度量：

1） 对称变量的度量：相关性、兴趣因子、IS、全置信度等。

2） 非对称变量的度量：Gini指标、信任度等。

4. 客观度量的性质

反演性：如果度量在反演操作下是不变的，则交换计数频度后其值保持不变。

相关系数、几率、K、集体强度保持反演不变。（用于对称二元数据）

兴趣因子、IS、PS、Jaccard系数非反演不变。（用于非对称二元数据）

零加性：向事务集中添加不相关数据的过程中，客观度量保持不变。

IS、Jaccard满足该性质；而兴趣因子、PS、几率和相关系数不满足。

缩放不变性：在行列缩放操作下，客观度量保持不变。

只有几率在此操作下保持不变。

5. 辛普森悖论：在某些情况下，隐藏的变量可能会导致观察到的一堆变量间的联系小或相关关系逆转，即为辛普森悖论。对于此种现象，需做适当的概念分层以避免虚假规则的产生。

多层关联规则

由于多维数据的稀疏性，可能在低层无法找到强关联规则，在较高层能发现的强关联规则也可能意义不大，并非新颖的，故考虑在多个抽象层中进行挖掘，并且容易在不同抽象层间进行转换。

挖掘多层关联规则的方法

对较低层采用递减的支持度

逐层独立，完全的宽度搜索，考察每一个节点，不管父节点是否频繁（比较蛮力）

层交叉单项过滤，当一个第i层的节点是频繁的，那么它作为父节点的第i+1层的项也将被考察，反之则不。

层交叉k项集过滤，一个第i层的项被考察，当前仅当第i-1层的父节点k-1项集是频繁的。

逐层独立会产生大量低层非频繁项集，层交叉k项集仅考察频繁k项集的子女，但这一限制太强。而层交叉单项过滤为折中方法，也可能丢失低层项的关联。

受控的层交叉单项过滤策略：设置层传递阈值的阈值，若满足该阈值，则即使k-1项集不频繁，但仍可以考察不满足阈值项的子女。每个层有自己的概念层传递阈值。

检查冗余的关联规则：若规则R1是R2的祖先，若R2中的项用它在概念分层中的祖先替换，就能得到R1，那么，这个规则被认为是冗余的。

多维关联规则

多维关联规则是涉及多个属性或者谓词的规则。

分类属性的关联，考虑可能有些属性值不够频繁，可将相关属性分组，形成少数类别。或者将不太频繁的属性聚合起成为一个其他的类别。某些属性值的品类可能比其他属性高很多，那么会产生许多的冗余规则。且因为维数增加，虽然事务宽度可能不变，但计算时间可能会增加。

连续属性的关联

离散化：离散化区间太宽，会因缺乏置信度丢失某些模式。太窄因支持度较低而丢失某些模式。离散化未做好的话，可能导致计算开销较大，产生过多的频繁项集和候选项集，而且会提取较多的冗余规则。

分箱：动态离散化（基于距离的关联规则）：1.第一遍使用聚类方法找出区间或聚类，可以规定规定距离度量和聚类组中最少元素个数，第二遍搜索频繁的一起出现的聚类组得到 基于聚类的关联规则。

基于统计的关联规则：从频繁项集中提取又去总体段的统计度量。规则确认一般基于假设检验。

其他关联规则

另外，还有一些基于其他模式的关联规则，如基于序列的关联规则，增加了时间序列维度，其目的为挖掘出当数据集内顾客在某时间段内购买了某商品后，阈值时间段内购买其他商品的规则；非频繁模式的挖掘，其目的是寻找竞争项，挖掘正频繁项集的负项。

关联规则项目

本次项目通过分析交易数据，探索数据内的关联规律，为业务部门的促销活动和销售培训提供数据支持。并为后期的深入项目提供前期探索，如在经过对规则的解释后，可能会产生对客户和门店的细分需求，为后期的客户标签化等项目提供支持等等。

项目代码主要由天真、沫沫和关东煮撰写，雪墨凝和子欣全程参与了项目分析。

项目所使用的R语言程序包为：sqldf，arules，plyr，RODBC，arulesViz。开发环境为windows系统下的Rstudio，R版本为3.1.1。

library(sqldf)

library(arules)

library(plyr)

library(RODBC)

library(arulesViz)

#载入需要的包

rm(list=ls())#清空变量环境

gc()#释放内存

options(digits=14)#设置全局变量，因产品条码的关系调整数字显示位数

数据录入与探索

在数据录入方式上，为了让大家了解不同方式的数据的录入，我们选择了载入RData和通过RODBC包读取Excel文件的方式录入数据。

#主要数据录入

load("record.RData")

head(crmd,6)#查看数据集前5行，以初看数据的性质

names(crmd)#查看数据集变量名

range(crmd$TXDATE)#查看数据日期跨度

format(length(subset(crmd$KC_AMTSOLD,crmd$KC_AMTSOLD<0))*2

/dim(crmd)[1]*100,digits=4)#对于要销售为负数据是否清洗的探索

发现销售为负的数据约占7%，那么相应的购买数据也有同样条数，总占14%左右，是一个较大的比例。鉴于我们做的是用户购买的产品行为的关联，在这么高的退货率的情况下，暂时决定删除负记录，而保留相应的购买。

#次要店铺数据录入

channel=odbcConnectExcel2007("店铺信息.xlsx")#使用RODBC包打开Excel文件的连接

storeInfo=sqlFetch(channel,"Sheet1")#读取工作表sheet1里的店铺数据集

head(storeInfo)

# storeInfo$开店日期=as.Date(ymd("19000101")+ddays(storeInfo$开店日期))#处理时间数据

odbcCloseAll();rm(channel);gc()#关闭所有odbc连接，并删除连接，释放内存

#次要的城市规模表

channel=odbcConnectExcel2007("city.xlsx")#使用RODBC包打开Excel文件的连接

cityLev=sqlFetch(channel,"Sheet1")#读取工作表sheet1里的店铺城市规模数据集

head(cityLev)

odbcCloseAll();rm(channel);gc()#关闭所有odbc连接，并删除连接，释放内存

#次要的大类信息

channel=odbcConnectExcel2007("dalei.xlsx")#使用RODBC包打开Excel文件的连接

Dalei=sqlFetch(channel,"dalei")#读取工作表sheet1里的店铺大类信息数据集

head(Dalei,20)

Dalei$dailei=as.character(Dalei$dailei)#转成字符变量

for(i in 1:dim(Dalei)[1]){

if(nchar(Dalei$dailei[i])==1){

Dalei$dailei[i]=paste("0",Dalei$dailei[i],sep="")

}

}#与后续的一致

odbcCloseAll();rm(channel);gc()#关闭所有odbc连接，并删除连接，释放内存

使用RODBC包导入原存于EXCEL中的次要数据，为了使提高程序的运行效率，我们每读入一个文件后就对内存做一次释放，养成良好的代码习惯。

初步探索分析

#分析关联规则可行性

saleCount=sqldf("select VIP_ID,TXDATE,IS_VIP,count(VIP_ID) N,

sum(KC_AMTSOLD) SOLD from crmd group by VIP_ID,TXDATE")#按客户购买次数生成汇总数据

table(ifelse(saleCount$N==1 ,"单次购买1件","单次大于1件"))#查看单次多件购买和单件购买频数

初步对数据做出探索，对客户购买行为做频数表，可以看出分布相对均衡，可以支持关联分析。

#分析业务可行性

#查看客户总购买次数

buyTimes=sqldf("select VIP_ID,count(VIP_ID) num from saleCount group by VIP_ID")

table(ifelse(buyTimes$num==1,"购买一次","购买多次"))

查看客户多次购买与单次购买的频数分布，可以看出分布相对均衡，可以支持关联分析。

#分析原始SKU是否可作为变量使用

length(unique(crmd$ITEM_CODE))#查看总SKU数

#查看去除订货方式和尺码后的总产品样式数

length(unique(paste(substr(crmd$ITEM_CODE,1,8),substr(crmd$ITEM_CODE,11,13),sep = "")))#sku太多不作为考虑

SKU（商品编码）数量太多，不考虑使用SKU作为分析维度，结合业务，对SKU做拆分。

数据清洗

#数据整理操作(针对销售关联)

names(storeInfo)

names(storeInfo)[c(1,3,4)]=c("City","BMS_SHOP_CD","Brand")#将店铺信息的店铺编码和crmd数据集内的名称统一

mergeData=merge(crmd,storeInfo[,c(1,3,4)],by="BMS_SHOP_CD")#将品牌和城市合并至crmd数据

unique(crmd[,3])[!unique(crmd[,3])%in%(unique(storeInfo[,3]))]#发现数据无丢失

mergeData=subset(mergeData,mergeData$KC_AMTSOLD>0)#删除购买金额不大于0的记录#简单处理

将店铺信息和交易数据集合并，并删除购买金额为负的记录。

toltalSold=round(sort(tapply(mergeData$KC_AMTSOLD,mergeData$Brand,sum,na.rm=TRUE)/

sum(mergeData$KC_AMTSOLD,na.rm=TRUE)*100,decreasing =T),2)#查看品牌销售金额占比

toltalSold

names(toltalSold)=1:length(toltalSold)

cumsum(toltalSold)#查看累计结果

mergeData=subset(mergeData,mergeData$Brand%in%

c("Brand1","Brand2"," Brand3"))

#根据计算结果，决定筛选出前三的品牌的购买

排名前三的品牌销售占据了总销售的85%以上，故其余的数个品牌因所占比例太低，剔除出关联数据。

mergeData$dalei=substr(mergeData$ITEM_CODE,2,3)#拆分出大类

mergeData$season=substr(mergeData$ITEM_CODE,4,4)#拆分出季节

mergeData$year=substr(mergeData$ITEM_CODE,7,7)#拆分出商品年份

mergeData$color=substr(mergeData$ITEM_CODE,11,13)#拆分出颜色

mergeData$size=substr(mergeData$ITEM_CODE,14,14)#拆分出尺码

mergeData$year=as.numeric(mergeData$year)+2010#将年份加上2010

mergeData$year[which(mergeData$year==2019)]=mergeData$year[which(mergeData$year==2019)]-10#将2019转化为2009

从SKU（商品编码）中取出商品相关信息，大类、季节、商品年份、颜色、尺码等等。

mergeData$year1=as.POSIXlt(mergeData$TXDATE)$year+1900#取出销售年份

mergeData$xinjiu=ifelse(mergeData$year1==mergeData$year|mergeData$year1

==mergeData$year+1,”新品”,”旧品”)#按照业务要求分新旧产品

table(mergeData$xinjiu)

按照业务要求划分新旧产品购买行为，并通过检测发现新旧产品频数分布过于悬殊，故决定不将新旧品购买作为一个变量考虑。

mergeData$month=months(mergeData$TXDATE)#得到月份

mergeData$jijie=ifelse(mergeData$month %in%

c("四月","五月","六月","七月","八月","九月"),"春夏","秋冬")#根据业务理解添加季节

mergeData$tempBand=ifelse(mergeData$City%in%c("北京","大同","济南 ","石家庄","太原","西安",

"郑州","青岛","天津","威海","烟台","兰州","呼和浩特"),"暖温带","亚热带")

#划分成2个温度带

根据业务需求，将购买行为划分为春夏和秋冬购买，并对店铺所在城市进行了温度带划分，但通过后续的关联规则分析，发现这两个变量对于规则的解释不够明显，故后来弃除。

names(cityLev)[1]="City"#统一名称

mergeData=sqldf("select a.*,b.level from mergeData as a left

join cityLev as b on a.City=b.City " )#合并城市规模

queshi=mergeData[which(is.na(mergeData$level)),]

unique(queshi$City)#检查是否有不全匹配

mergeData$level[mergeData$City=="济南 "]="二线发达城市"

names(Dalei)[c(1,3)]=c("dalei","name")#统一名称

mergeData=sqldf("select a.*,b.name, b.xiaolei from mergeData as a left

join Dalei as b on a.dalei=b.dalei " )#合并类别

queshi=mergeData[which(is.na(mergeData$name)),]#查看缺失

unique(queshi$dalei)

将城市信息和中文的大类信息合并至数据集，对于某些缺失的信息进行填补。

#查看品牌是否需要分开分析

intersect(unique(mergeData$color[mergeData$Brand=="Brand1"]),

unique(mergeData$color[mergeData$Brand=="Brand2"]))#探索品牌颜色交集

unique(mergeData$color[mergeData$Brand==" Brand1"])

#可以看出不同品牌使用的颜色有明显差异

查看不同品牌的服装的颜色是否有差异，如果存在较大差异，那么说明品牌的独立性较大，各个品牌所面向的客户群体有差异，数据显示其的确差异很大。故品牌是一个跟购买行为强相关的变量。

#得到事务号

tselect distinct VIP_ID,TXDATE from mergeData1")

tid=cbind(tid,obs=1:dim(tid)[1])

mergeData1=sqldf("select a.*,b.obs from mergeData1 as a left

join tid as b on a.VIP_ )

生成单次购买事务号。

商品关联分析

变量选取

#筛选变量

itemList=mergeData1[,c("obs","name")]

商品的关联中，仅仅选用了商品大类这个变量。起初我们认为选用更多的变量进入可能会得到更好的结果，但我们忽略了这样得到的结果其实并不是我们想要的,过多的变量将会导致信息出现不对等。我们的目标是探索商品之间的关联关系。

数据变形

#保留同类别商品组合

dupItem=itemList[duplicated(itemList),]#取出重复数据

dupItem$name=paste(dupItem$name,"1",sep='')#添加标识符

trans=rbind(unique(itemList),unique(dupItem))#重新合并

trans=trans[order(trans[,1]),]#排序

head(trans,50)#观察处理是否正确

trans = as(split(trans[,"name"], trans[,"obs"]), "transactions")#转成事务集

inspect(trans[1:5])

对于那些发生重复购买的交易中，即例如一位顾客在购买了一件上衣继续选择另一件上衣，我们把这样的一次交易中的有大类的重复购买的事件标记出来。

规则生成及探索

#关联分析阶段

rule=apriori(trans,parameter=list(support=0.05,confidence=0.6,minlen=2))#支持度0.05置信度0.6最小规则长度2

quality(rule) = cbind(quality(rule),hyperConfidence = interestMeasure

(rule, method = "hyperConfidence",transactions = trans),

improvement=interestMeasure(rule, method = "improvement",transactions = trans)

,leverage=interestMeasure(rule, method = "leverage",transactions = trans),

coverage=interestMeasure(rule, method = "coverage",transactions = trans))

#在rule中添加指标

quality(rule)=round(quality(rule),digits=3)

rule=subset(rule,leverage>0&hyperConfidence>0.95)

rule=sort(rule,by="support")

inspect(rule)

plot(rule, method="graph")#画图

plot(rule, method="graph", control=list(type="items"))

在生成事务集后，直接使用apriori算法产生规则。我们发现生成的规则很多，在主观度量之前，必须使用客观兴趣度量剔除冗余规则，于是对规则做了删减，使用了全局置信度（衡量随机的规则）、提高度、杠杆（衡量是否相关）、coverage（衡量前项支持度）等指标选取出了强规则。并对得到的结果使用arulesViz包作图。

从上图可以看出，在顾客购买一件上衣以后，接下来推荐第二件上衣购买的概率会大于其他产品，这是从（上衣1→上衣）和（裤子，上衣1→上衣）这两条规则推断出来的。

但仅根据这样的规则对于业务的帮助并不大，所以，考虑对小类继续做关联规则。

#探究小类

itemList1=mergeData1[,c("obs","xiaolei")]#重新选取变量

dupItem1=itemList1[duplicated(itemList1),]#取出重复数据

dupItem1$xiaolei=paste(dupItem1$xiaolei,"1",sep='')#添加标识符

trans1=rbind(unique(itemList1),unique(dupItem1))#重新合并

trans1=trans1[order(trans1[,1]),]#排序

head(trans1,50)#观察处理是否正确

trans1=as(split(trans1[,"xiaolei"], trans1[,"obs"]), "transactions")#转成事务集

inspect(trans1[1:5])

length(trans1)

rule1=apriori(trans1,parameter=list(support=0.01,confidence=0.6,

minlen=2))#支持度0.01也就是1千多个置信度0.6最小规则长度2

quality(rule1) = cbind(quality(rule1),hyperConfidence = interestMeasure

(rule1, method = "hyperConfidence",transactions = trans1),

leverage=interestMeasure(rule1, method = "leverage",transactions = trans1),

coverage=interestMeasure(rule1, method = "coverage",transactions = trans1),

is=interestMeasure(rule1, method = "cosine",transactions = trans1))

quality(rule1)=round(quality(rule1),digits=3)

rule1=subset(rule1,leverage>0&hyperConfidence>0.95)

rule1=sort(rule1,by="is")

inspect(rule1[1:20])

# 规则太多想去除冗余规则

subset.matrix = is.subset(rule1, rule1)

subset.matrix[lower.tri(subset.matrix, diag=T)]=NA

redundant=colSums(subset.matrix, na.rm=T) >= 1

rule2=rule1[!redundant]

inspect(rule2)

plot(rule2, method="graph")

最终生成13条规则,在筛选规则的过程中，添加了IS度量。前面有过介绍，IS度量是使用于非对称二元变量的规则的衡量的，其主要用于发现隐藏在规则中的可能导致辛普森悖论的现象。

最终规则解释

从支持度高且提升度相对较高的规则来入手，例如可以清晰地从图中看出（外套1→外套）是一个非常强的规则。在销售过程中，若一个客户购买一件外套后，可以优先向这位客户推荐另一件外套，如果其对外套不感兴趣的话，就需另加考虑。通过对（打底衫，围巾→外套），（鞋子，长裤→外套），（打底衫，长裤→外套）等规则的合并，依次向顾客继续推销打底衫、长裤、鞋子等。

购买件数关联分析

分析单次购买单件和多件的销售者的差异，用于确定未来促销活动的类型、时间、地点、促销方式等等。

变量选取

#划分单次购买件数

t<-sqldf("select obs as obs1,'多件' from mergeData1 group by obs having count(obs)>=2")

#标记多件

mergeData1<-sqldf("select*from mergeData1 as a left join t as b on a.obs=b.obs1")

#添加类别：多件

head(mergeData1)#查看数据集

names(mergeData1)[c(25)]=c("nums")#将件数分类命名为nums

mergeData1$nums[sapply(mergeData1$nums,is.na)]<-'一件'#除多件外则为一件

根据事务集序号出现次数判断一次购买的单件和多件的购买行为。

#筛选变量

itemListmm<-sqldf("select obs,IS_VIP,year1,name,level,tempBand,nums from mergeData1

group by obs" )

数据变形

#处理数据集

itemListmm$IS_VIP=ifelse(itemListmm$IS_VIP==1,"vip","novip")#注释清楚VIP

itemListmm$name=as.vector(itemListmm$name)#向量化变量值

itemListmm$level=as.vector(itemListmm$level)#向量化变量值

TRans=ddply(itemListmm,"obs",stack)#处理成可以转换的dataframe形式

TRans=TRans[which(TRans$ind!="obs"),]#去除无关商品项

TRans1=rbind(unique(TRans[which(TRans$ind!="name"),]),TRans[which(TRans$ind=="name"),])#优化商品项

TRans1=TRans1[order(TRans1[,1]),]#排序

#保留同类别商品组合

dupIterm=TRans1[duplicated(TRans1),]#取出重复数据

dupIterm$values=paste(dupIterm$values,"1",sep='')#添加标识符

TRans2=rbind(unique(TRans1),unique(dupIterm))#重新合并

TRans2=TRans2[order(TRans2[,1]),]#排序

head(TRans2,50)#观察处理是否正确

TRans3 <- as(split(TRans2[,"values"], TRans2[,"obs"]), "transactions")#转成可以

规则生成及探索

inspect(TRans3[1:5])#查看事务集

options(digits=4)

rulesmm<-apriori(TRans3,parameter = list(supp = 0.05, conf = 0.6,minlen=2,target="rules"),

appearance=list(rhs=c("多件","一件"),default="lhs"))#生成规则

inspect(sort(rulesmm,by="lift"))#查看规则

#筛选规则

quality(rulesmm)< - cbind(quality(rulesmm),

hyperConfidence=interestMeasure(rulesmm,method="hyperConfidence",

transactions=TRans3))

rulesmm_matrix<-is.subset(sort(rulesmm, by="lift"),sort(rulesmm, by="lift"))

rulesmm_matrix[lower.tri(rulesmm_matrix,diag=T)]<-NA#删除对角线上的数据

rulesmm_redundant<-colSums(rulesmm_matrix,na.rm=T)>=1

which(rulesmm_redundant)

rulesmm.pruned< - sort(rulesmm, by="hyperConfidence")[!rulesmm_redundant]

rulesmm.pruned<-subset(rulesmm.pruned,[email protected]$hyperConfidence>=0.95)

options(digits=4)

inspect(sort(rulesmm.pruned,by="lift"))#查看最终规则

使用全局置信度筛选规则，这里的操作方式和前面的商品关联区别不大。

最终规则解释

lhs rhs support confidence lift hyperConfidence

1 {裤子} => {多件} 0.06941 0.6721 1.091 1.0000

2 {一线城市} => {多件} 0.18163 0.6419 1.042 1.0000

3 {上衣,

一线城市} => {多件} 0.08594 0.6396 1.038 1.0000

4 {2013,

暖温带,

一线城市} => {多件} 0.10898 0.6367 1.033 1.0000

5 {vip,

暖温带,

上衣,

一线城市} => {多件} 0.06337 0.6359 1.032 1.0000

6 {2013,

暖温带,

上衣,

一线城市} => {多件} 0.05494 0.6341 1.029 1.0000

7 {vip,

二线中等发达城市} => {多件} 0.21311 0.6328 1.027 1.0000

8 {vip,

二线中等发达城市,

上衣,

亚热带} => {多件} 0.06968 0.6318 1.025 1.0000

9 {2014,

novip} => {多件} 0.06655 0.6288 1.020 0.9992

10 {vip,

二线中等发达城市,

上衣} => {多件} 0.10078 0.6262 1.016 0.9993

11 {2013,

vip,

二线中等发达城市,

上衣} => {多件} 0.06313 0.6261 1.016 0.9922

12 {二线中等发达城市,

亚热带} => {多件} 0.20646 0.6259 1.016 1.0000

13 {2014,

暖温带} => {多件} 0.13166 0.6254 1.015 0.9997

14 {2013,

二线中等发达城市,

亚热带} => {多件} 0.12706 0.6238 1.012 0.9973

15 {2013,

vip,

暖温带} => {多件} 0.13676 0.6228 1.011 0.9942

16 {vip,

暖温带} => {多件} 0.23174 0.6220 1.009 0.9993

17 {2013,

vip} => {多件} 0.25819 0.6211 1.008 0.9985

18 {2014,

vip} => {多件} 0.17629 0.6210 1.008 0.9856

19 {vip,

亚热带} => {多件} 0.20275 0.6200 1.006 0.9718

从上表可以看出，VIP的身份仍然是单件和多件购买的差异性的最大来源，在后续业务中仍然需加强对非VIP客户的转化。但温度带对于购买行为的差异性的解释反而相对较差，所以可以考虑去除温度带变量后再重新探索。

购买次数关联分析

多次购买与单次购买的分析目的在于寻求多次购买和单次购买行为之间的差异，以便寻找将单次购买转化为多次购买的方法。同时考察以何种方式、在何地等条件的限制下获取最大的转化率，提升企业业绩。

变量选取

#筛选变量

gc()#释放内存

options(digits=4)#设置全局变量，调整数字显示位数

head(mergeData1,10)#查看数据

ItermList1=mergeData1[,c("VIP_ID","IS_VIP","Brand","level","tempBand","TXDATE","KC_AMTSOLD","City")]#选取变量

ItermList1=ItermList1[order(ItermList1[,7]),]

ItermList1=ItermList1[order(ItermList1[,1]),]#按VIP_ID和购买日期排序

head(ItermList1,20)

从原始数据中筛选了可能会使用在规则里的变量作为初始变量。并对筛选后的数据进行排序。这里的语句为了方便阅读，使用的是较容易理解但运行效率相对较低的语法。由于数据量在30万行左右，PC还可以接受这样的开销，但对于更大的数据量，需优化语句。

#计算总购买次数

ItermList2=sqldf("selectVIP_ID,TXDATE,count(VIP_ID) buyNumsDay,sum(KC_AMTSOLD) cashDay from ItermList1

group by VIP_ID,TXDATE")#计算每次购买数量

gmcs=sqldf("select VIP_ID,count(VIP_ID) buyNumsAll from ItermList2

group by VIP_ID")#计算总购买次数

gmcs$buyNums=ifelse(gmcs$buyNumsAll>1,"多次","单次")#标记多次和单次购买

#是否将品牌偏好放入

maraPre=sqldf("select VIP_ID,sum(KC_AMTSOLD) maraCash from ItermList1 where Brand='Brand1' group by VIP_ID")#计算Brand1品牌的单客户购买金额

COPre=sqldf("select VIP_ID,sum(KC_AMTSOLD) COCash from ItermList1 where Brand='Brand2' group by VIP_ID")#计算Brand2品牌的单客户购买金额

weekPre=sqldf("select VIP_ID,sum(KC_AMTSOLD) weekCash from ItermList1 where Brand='BRAND3' group by VIP_ID")#计算Brand3品牌的单客户购买金额

BrandPre=merge(COPre,merge(weekPre,maraPre,by="VIP_ID",all=T),by="VIP_ID",all=T)#合并数据

BrandPre$COCash[is.na(BrandPre$COCash)]=0;BrandPre$weekCash[is.na(BrandPre$weekCash)]=0#空数据为0

BrandPre$maraCash[is.na(BrandPre$maraCash)]=0#使空数据为0

BrandPre$BrandPrefer=ifelse(BrandPre$maraCash>BrandPre$weekCash&BrandPre$maraCash>BrandPre$COCash,

"Brand1",ifelse(BrandPre$weekCash>BrandPre$maraCash&BrandPre$weekCash

> BrandPre$COCash,"BRAND3","Brand2"))

#计算单客户品牌最大金额

table(BrandPre$BrandPrefer)#将品牌放入还是有意义的

brand=merge(sqldf("select VIP_ID,max(IS_VIP) VIP,Brand from ItermList1 group by VIP_ID,

IS_VIP,Brand"),BrandPre[,c(1,5)],by="VIP_ID")#客户偏好的品牌是否为VIP

brandSub=subset(brand,brand$Brand==brand$BrandPrefer)#筛选数据

brandSub=sqldf("select VIP_ID,max(VIP) VIP,BrandPrefer from brandSub group by VIP_ID")#客户偏好的品牌是否为VIP

brandSub$VIP=ifelse(brandSub$VIP==1,"VIP","Not VIP")#标记VIP

先计算三个品牌客户的偏爱购买行为，以购买次数、购买金额来界定当个客户最喜爱的品牌，并比对此客户在其最偏爱的品牌是否为VIP，从结果可以看出三个品牌的客户分布相对平均，所以品牌偏好是可以放入规则的探索中的。

#计算顾客所属城市

gscs=sqldf("select VIP_ID,City,max(cs) maxnum from(

select VIP_ID,City,count(VIP_ID) cs from ItermList1 group by VIP_ID,City) group by VIP_ID")

#选取客户购买发生最多的城市

与品牌偏好的计算类似，顾客在某个城市发生的购买次数最多，那么其长住这个城市的可能越大，所以将其归属至此城市。

cityLevel=ItermList1[,c(5,6,9)]#提取城市等级

cityLevel=sqldf("select * from cityLevel group by City")#聚集城市等级

gscs=merge(gscs,cityLevel,by="City")#合并数据

#合并数据

head(gmcs);head(gscs);head(brandSub);head(zdje)#查看数据

csData=merge(gmcs[,c(1,3)],merge(gscs[,c(1:2,4:5)],brandSub,by="VIP_ID"),by="VIP_ID")#合并选取变量

head(csData)#查看最终数据

最后将前面计算的数据合并整理，形成最终的数据集。

数据变形

#转化为事务集

TransData=ddply(csData,"VIP_ID",stack)#转化为可用数据框

TransData=as(split(TransData[,2],TransData[,"VIP_ID"]),"transactions")#转化事务集

inspect(TransData[1:6])#查看事务集

由于客户的ID编号是独立的，即可以作为数据集的主键，就无需再生成事务号。

规则生成及探索

#探索规则

ddrules=apriori(TransData,parameter=list(support=0.05,confidence=0.6,minlen=2),

appearance=list(rhs=as.vector(c("多次","单次")),default="lhs"))#产生后项为购买次数的规则

inspect(sort(ddrules,by=c("lift"))[1:10])#按提升度查看规则

quality(ddrules) = cbind(quality(ddrules),

hyperConfidence=interestMeasure(ddrules,method="hyperConfidence",

transactions=TransData))#加如全局置信度

ddrules_matrix=is.subset(sort(ddrules, by="lift"),sort(ddrules, by="lift"))#生成规则矩阵

ddrules_matrix[lower.tri(ddrules_matrix,diag=T)]=NA#删除对角线上的数据

ddrules_redundant=colSums(ddrules_matrix,na.rm=T)>=1#去掉重复的

which(ddrules_redundant)#查看去除的规则号

ddrules.pruned = sort(ddrules, by="hyperConfidence")[!ddrules_redundant]#筛选并排序

ddrules.pruned=subset(ddrules.pruned,[email protected]$hyperConfidence>=0.95)#按全局置信度大于0.95筛选

inspect(sort(ddrules.pruned,by="support"))#查看最终规则

#画图

plot(ddrules.pruned, method="grouped")

plot(ddrules.pruned, method="graph")

plot(ddrules, shading="order", control=list(main = "Two-key plot"))

itemFrequencyPlot(TransData,support = 0.05,cex.names =0.6)

#可发现，产生的规则不是很好解释，考虑删除部分变量后重新探索

#重新构建新的事务集#

#仅保留部分变量，再次探索规则

head(csData)

csData1=csData[,c(1:3,6:7)]

head(csData1)

TransData1=ddply(csData1,"VIP_ID",stack)#转化为可用数据框

head(TransData1,10)

TransData1=as(split(TransData1[,"values"],TransData1[,"VIP_ID"]),"transactions")#转化事务集

inspect(TransData1[1:6])#查看事务集

#探索规则

ddrules1=apriori(TransData1,parameter=list(support=0.02,confidence=0.6,minlen=2),

appearance=list(rhs=as.vector(c("多次","单次")),default="lhs"))#产生后项为购买次数的规则

inspect(sort(ddrules1,by=c("lift"))[1:10])#按提升度查看规则

quality(ddrules1) = cbind(quality(ddrules1),

hyperConfidence=interestMeasure(ddrules1,method="hyperConfidence",

transactions=TransData1))#加如全局置信度

ddrules1_matrix=is.subset(sort(ddrules1, by="lift"),sort(ddrules1, by="lift"))#生成规则矩阵

ddrules1_matrix[lower.tri(ddrules1_matrix,diag=T)]=NA#删除对角线上的数据

ddrules1_redundant=colSums(ddrules1_matrix,na.rm=T)>=1#去掉重复的

which(ddrules1_redundant)#查看去除的规则号

ddrules1.pruned = sort(ddrules1, by="hyperConfidence")[!ddrules1_redundant]#筛选并排序

ddrules1.pruned=subset(ddrules1.pruned,[email protected]$hyperConfidence>=0.95)#按全局置信度大于0.95筛选

inspect(sort(ddrules1.pruned,by="support"))#查看最终规则

#画图

plot(ddrules1.pruned, method="grouped")

plot(ddrules1.pruned, method="graph")

plot(ddrules1, shading="order", control=list(main = "Two-key plot"))

itemFrequencyPlot(TransData1,support = 0.02,cex.names =0.6)

在初步产生的规则中，由于选取了较多的变量，产生的规则对于业务的指导并不大，并且在业务方面的解释也显得很困难，故对变量做了二次删除，仅保留在业务逻辑上可能会对单次和多次购买产生强相关关系的变量。

在客观度量方面，因不涉及概念分层等技术，仅仅使用全局置信度，删除那些可能因随机而产生的规则。

最终规则解释

例如从规则中可以看出，VIP的多次购买相对来说是个强规则，联合其他规则，成都、西安、成都某品牌的VIP购买多次的可能会更高，也就是说这些地方的本品牌的VIP转化较高，即在这些地方发展VIP会较其他地方效果更好。

当然，从业务层面来说，上图产生的可探索的规则有很多，基于数据安全方面的原因，我们擦掉了关于品牌的信息。但大家可以自行发挥分析能力，从一条或者多条规则中得出建议，给予公司业务更好的帮助。

项目总结

作为团队的第一个合作，大家在此次项目中都收获颇多，我们熟悉了数据分析流程，在细节上有了更为深刻的理解，对于算法的细节、原理、指标都有了更好的认识，这是独自学习时不能体会到的。同时，也进一步加强了自己的团队协作的能力，开阔自己的思维，理解其他的成员的分析思路，加强了沟通的技巧。同时，也改善了平时独立写代码时的不规范的书写方式，规范了命名规则、缩进方式等。

总之，一切都是新的开始，希望大家在下一个项目里获得更大的进步。