关联规则R语言实现

来源：互联网发布：影视美术设计考研知乎编辑：程序博客网时间：2024/06/10 14:29

文章参考资料：

xccd:肖凯大牛的博文

《Rdatamining》

《R IN A NUTSHELL》

注:如有疑惑的问题,参阅下文的预备知识！

关联分析的挖掘任务可分解为两个步骤：一是发现频繁项集，二是从频繁项集中产生规则。

############################ 关联分析案例实践 ############################

背景假定:

在电影商店中,一个客户在一次购物中(也可不同时间段多次购买)购买了很多不同种类,品牌的电影盘。我们要从中找到有用的信息,提升商店的销售。

问题提出:

1、那么针对个体客户来说,他们购买的偏好是什么? 即购买的A商品,可能会购买那种潜在商品(影片)

2、在客户中,有没有明显的用户群细分方式?

使用数据:

rattle包中，csv目录下的 dvdtrans.csv 文件

数据描述:

该原始数据仅仅包含了两个字段(ID, Item) 用户ID，商品名称。

##### code start #####

# 加载包

library(arules)

# 加载数据

dvdtrans <- read.csv(system.file("csv", "dvdtrans.csv", package="rattle") ) # 函数system.file()见预备知识

# 将数据转换为arules关联规则方法apriori 可以处理的数据形式.交易数据

data <- as(split(dvdtrans$Item, dvdtrans$ID), "transactions")

# 查看一下数据

attributes(data)

# 使用apriori函数生成关联规则

rules <- apriori(data, paramter= list(support=0.6, conf=0.8))

# 使用inspect函数提取规则

inspect(rules)

##### code end #####

上面的示例只是给一个感觉。继续…

#################### nutshell

##################################################################

使用数据:Titanic

# look for data

str(Titanic)

# transform table into data frame

df <- as.data.frame(Titanic)

head(df)

> head(df)

Class Sex AgeSurvivedFreq

1 1st MaleChild No 0

2 2nd MaleChild No 0

3 3rd MaleChild No 35

4 Crew MaleChild No 0

titanic.raw <- NULL

# 如果频率字段大于0,将该行记录按列追加到变量中,Freq=0,当然就不追加

for(iin1:4) {

titanic.raw <- cbind(titanic.raw, rep(as.character(df[,i]),df$Freq))

}

# 前35行都是一样的

]]]]> titanic.raw[1:36,]

[,1] [,2] [,3] [,4]

[1,]"3rd""Male" "Child""No"

[2,]"3rd""Male" "Child""No"

[3,]"3rd""Male" "Child""No"

[4,]"3rd""Male" "Child""No"

...

[35,]"3rd""Male" "Child""No"

[36,]"3rd""Female""Child""No"

# transform to data frame

titanic.raw <- as.data.frame(titanic.raw)

> head(titanic.raw)

V1 V2 V3V4

1 3rd MaleChildNo

2 3rd MaleChildNo

3 3rd MaleChildNo

4 3rd MaleChildNo

5 3rd MaleChildNo

6 3rd MaleChildNo

# 生成数据框后添加属性名称

names(titanic.raw) <- names(df)[1:4];dim(titanic.raw);

summary(titanic.raw)

# 转换后:每一行代表了一个人,可以用于关联规则。转换前是什么类型的数据? (按照class、sex、年龄汇总的生存人数的数据)

With the function, the default settings are:1) supp=0.1, which is the minimum support of rules;2) conf=0.8, which is the minimum confidence of rules; and 3) maxlen=10, which is the maximum length of rules.

library(arules)

rules <- apriori(titanic.raw) # apriori可以直接传递非transactions类型的对象,内部自动转换

rules # 根据最小的 (supp=0.1,conf=0.8),返回的规则的最多个数 10个

summary(rules);

inspect(rules);

quality(rules) <- quality(rules)

inspect(rules)

翻译:

关联规则挖掘一个常见的现象是，很多产生的规则并不是有趣的。考虑到我们只关心规则的右件(rhs)表示是否生存，

所以我们参数 appearance 中设置 rhs=c("Survived=No", "Survived=Yes") 并确定只有这两种情况出现在规则右件中(rhs).

其它的项集可以出现在规则左件(lhs)，使用default="lhs"设置。

上面的结果也可以看到,第一个规则的lhs 是个空集，为了排除这样的规则，可以使用minlen=2。

而且，算法处理的过程被压缩(简化)是通过verbose=F设置的。

关联规则挖掘结束后，规则将会以lift提升度按照从大到小的排序方式进行排序

rules.better <- apriori(titanic.raw,

parameter=list(minlen= 2,supp =0.005,conf =0.8),

appearance= list(rhs=c("Survived=No","Survived=Yes"), default="lhs"),

control= list(verbose=F)

)

# base on lift sorted

rules.sorted <- sort(rules.better, by="lift")

inspect(rules.sorted)

> inspect(rules.sorted)

lhs rhs supportconfidence lift

1 {Class=2nd,

Age=Child} => {Survived=Yes} 0.010904134 1.00000003.095640

2 {Class=2nd,

Sex=Female,

Age=Child} => {Survived=Yes} 0.005906406 1.00000003.095640

3 {Class=1st,

Sex=Female} => {Survived=Yes} 0.064061790 0.97241383.010243

4 {Class=1st,

Sex=Female,

Age=Adult} => {Survived=Yes} 0.063607451 0.97222223.009650

5 {Class=2nd,

Sex=Female} => {Survived=Yes} 0.042253521 0.87735852.715986

6 {Class=Crew,

Sex=Female} => {Survived=Yes} 0.009086779 0.86956522.691861

7 {Class=Crew,

Sex=Female,

Age=Adult} => {Survived=Yes} 0.009086779 0.86956522.691861

8 {Class=2nd,

Sex=Female,

Age=Adult} => {Survived=Yes} 0.036347115 0.86021512.662916

9 {Class=2nd,

Sex=Male,

Age=Adult} => {Survived=No} 0.069968196 0.91666671.354083

10 {Class=2nd,

Sex=Male} => {Survived=No} 0.069968196 0.86033521.270871

11 {Class=3rd,

Sex=Male,

Age=Adult} => {Survived=No} 0.175829169 0.83766231.237379

12 {Class=3rd,

Sex=Male} => {Survived=No} 0.191731031 0.82745101.222295

翻译:

当其它设置不发生变化的情况下，越小的支持度会产生更多的规则。这种产生的规则中项集之间的关联看起来更像是随机的。

在上例中，最小支持度为0.005，那么每一个规则至少有支持度*交易数(记录数) 个案例是满足支持度为0.005的。（2201 * 0.005 = 12）

支持度，置信度，提升度是选择兴趣规则的三个方法。还有一切其它的衡量方法，包括卡方，gini等。有多余20中这样的计算方法在interestMeasure()方法中

### 规则的剪枝

从上面的例子中，我们能够发现一些规则与其它规则相比没有提供额外的信息。(提供的信息少)。

比如第二个规则给出的信息，在第一个规则中已经都阐述明白了。因为规则1告诉我们所有的 2nd-class的孩子都幸存了。

(即 Class=2nd，Age=Child 所有的都幸存了,置信度和lift都是一致的，再增加一个sex的判断是冗余的)

我们以这个例子来阐述何种情况定义为redundant（冗余）

总体来说，规则2 是规则1 的衍生规则，如果规则2 和规则1 有相同的提升度或者比规则1 更低的提升度，那么规则2 就被认为是冗余的。

总结：规则2 比规则1 lhs多了sex的条件，同时lift ，两者相同，所以规则2冗余

lhs rhs support confidence lift

1 {Class=2nd,

Age=Child} =>{Survived=Yes}0.010904134 1.0000000 3.095640

2 {Class=2nd,

Sex=Female,

Age=Child} =>{Survived=Yes}0.005906406 1.0000000 3.095640

代码：

函数解释:

is.subset(r1, r2): 检查r1是否为r2的子集

lower.tri():返回一个逻辑以TRUE为下三角的matrix；diag=T表示包含主对角线

# redundant

subset.matrix <- is.subset(rules.sorted, rules.sorted) #

# 使得下三角包含主对角线设置为NA

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

# 计算列TRUE的数量

redundant <- colSums(subset.matrix, na.rm=T) >= 1; #

which(redundant) # 冗余规则的下标

# 删除冗余规则

rules.pruned <- rules.sorted[!redundant]

inspect(rules.pruned)

> inspect(rules.pruned)

lhs rhs support confidence lift

1 {Class=2nd,

Age=Child} => {Survived=Yes} 0.010904134 1.0000000 3.095640

2 {Class=1st,

Sex=Female} => {Survived=Yes} 0.064061790 0.9724138 3.010243

3 {Class=2nd,

Sex=Female} => {Survived=Yes} 0.042253521 0.8773585 2.715986

4 {Class=Crew,

Sex=Female} => {Survived=Yes} 0.009086779 0.8695652 2.691861

5 {Class=2nd,

Sex=Male,

Age=Adult} => {Survived=No} 0.069968196 0.9166667 1.354083

6 {Class=2nd,

Sex=Male} => {Survived=No} 0.069968196 0.8603352 1.270871

7 {Class=3rd,

Sex=Male,

Age=Adult} => {Survived=No} 0.175829169 0.8376623 1.237379

8 {Class=3rd,

Sex=Male} => {Survived=No} 0.191731031 0.8274510 1.222295

规则的解释：(解释规则)

很容易就能找到高提升度的数据，但是理解识别出来的规则并不是一件容易的事情。

关联规则在寻找商业意义上被误解读是很常见的。

比如，第一个规则，{Class=2nd,Age=Child} => {Survived=Yes}

规则的置信度为1，提升度为3，并且没有规则揭示age=Child时，class=c("1nd","3nd").

因此，这样可能就会被分析师解释为：类别为2的孩子比其它类别的孩子(1,3)有更高的生存几率。

这种解释是完全的错误的！！！！

这个规则仅表示所有类别为2的孩子幸存下来了，但是没有提供任何信息来进行比较不同的类别的孩子的生存率

为了研究以上的问题，我们可以通过找到规则右件为存活的，即rhs为 Survived=Yes,

规则左件lhs 仅仅包括 Class=1st,2nd,3rd, Age=Child,Adult;不包括其它项集(如default="none")

我们对支持度和置信度使用较之前拟合模型这两个参数较低的阈值，去找出所有孩子不同类别的规则。

为了方便，先将原来计算的规则写出来，好做比较

# former rules set

rules.better <- apriori(titanic.raw,

parameter=list(minlen= 2,supp =0.005,conf =0.8),

appearance= list(rhs=c("Survived=No","Survived=Yes"), default="lhs"),

control= list(verbose=F)

)

# compare rules set

rules <- apriori(titanic.raw,

parameter=list(minlen=3,supp=0.002,conf=0.2),

appearance= list(rhs=c("Survived=Yes"),

lhs=c("Class=1st","Class=2nd", "Class=3rd",

"Age=Child","Age=Adult"),

default="none"),

control= list(verbose = F)

);

rules.sorted <- sort(rules, by = "confidence")

inspect(rules.sorted)

lhs rhs support confidence lift

1{Class=2nd,

Age=Child}=>{Survived=Yes}0.010904134 1.0000000 3.0956399

2{Class=1st,

Age=Child}=>{Survived=Yes}0.002726034 1.0000000 3.0956399

3{Class=1st,

Age=Adult}=>{Survived=Yes}0.089504771 0.6175549 1.9117275

4{Class=2nd,

Age=Adult}=>{Survived=Yes}0.042707860 0.3601533 1.1149048

5{Class=3rd,

Age=Child}=>{Survived=Yes}0.012267151 0.3417722 1.0580035

6{Class=3rd,

Age=Adult}=>{Survived=Yes}0.068605179 0.2408293 0.7455209

根据结果，前两个规则中，1类和2类的孩子有相同的幸存率并且都幸存了下来(置信度为1)。

那么1类的孩子的规则没有出现在之前的规则列表中，是因为支持度阈值低于设定的阈值(0.005),1类此时supp为0.002.

规则5与规则4相比，3类的孩子存活率只有很低的34%，(此处只是比较的conf，无法按照class和age比较)，

而和规则3(1类的成年人)比较，存活率(置信度)就更低了

关联规则的可视化

library(arulesViz)

plot(rules)

plot(rules, method="grouped")

plot(rules, method="graph")

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

plot(rules, method="paracoord", control=list(reorder=T))

继续阅读:

两个包:

arulesSequences:序列模型的关联规则

arulesNBMiner:negative binomial(NB)频繁项集

# arules

预备知识:

################ system.file() start ################

# 找指定包的路径

a <- find.package("rattle") # "/Library/Frameworks/R.framework/Versions/2.15/Resources/library/rattle"

# 设定文件所在的路径

file <- file.path(a, "csv", c("weather.csv","dvdtrans.csv"))

# file <- file.path(a, "csv")

# 判断指定目录下文件是否存在

logical.file <- file.exists(file)

# 只要存在文件

if(any(logical.file)) {

file[logical.file] # file[TRUE]

}

# 综上,用其它的包练习一下

packagePath <- find.package("caret");packagePath # find package path

file <- file.path(packagePath,"html","R.css");file # 设定文件路径及文件名

logic.file <- file.exists(file)# 返回逻辑值,判定是否存在指定的文件

if(any(logic.file)){

file[logic.file]

}

################ system.file() end ################

################ split() start ################

# split:split divides the data in the vector x into the groups defined by f

# 每个ID有购买了不同的商品,split功能就是对商品Item进行分组切分, 组即为ID，结果返回list

split(dvdtrans$Item, dvdtrans$ID) # 自行查看结果

################ split() end ################

################ as() start ################

as:强制将某个数据类型转换为指定的类型(此例将list转换为transactions)

# 操作时,一定要先加载arules包,否则无法转换

# Error in as(split(dvdtrans$Item, dvdtrans$ID), "transactions") :

# no method or default for coercing “list” to “transactions”

> data <- as(split(dvdtrans$Item, dvdtrans$ID),"transactions")

# 看看生成的data是什么形式?10个ID, 即为10行交易数据,即由原来的纵表转换为横表，item商品共10种,生成10个属性字段

> data

transactionsinsparseformatwith

10 transactions (rows) and

10 items (columns)

# 用 apriori命令生成频繁项集，设其支持度为0.5，置信度为0.8

rules <- apriori(data, parameter=list(supp=0.5, conf=0.8))

# use inspect to extract rules

> inspect(rules)

lhs rhs supportconfidence lift

1 {Patriot} => {Gladiator} 0.6 1.00000001.428571

2 {Gladiator} => {Patriot} 0.6 0.85714291.428571

3 {SixthSense} => {Gladiator} 0.5 0.83333331.190476

# 加载包

library(arules)

# 找到rattle包所在路径,路径下csv目录,找到file名称为dvdtrans.csv.

dvdtrans <- read.csv(system.file("csv", "dvdtrans.csv", package="rattle"))

函数

1、system.file

功能:

system.file(package="rattle")

system.file定义:

function(...,package="base",lib.loc=NULL,mustWork=FALSE)

{

# nargs():用于在函数体内调用,返回函数调用时参数的个数。直接数","的个数加1；

# file.path():获取和设置文件路径

# .Library:返回R软件库默认安装路径(此路径下包含了所有installed的包)

# 如果system.file没加参数,返回R安装的默认路径

if(nargs()==0L)

return(file.path(.Library,"base"))

# 如果参数package不只一个包要找,提示

if(length(package)!=1L)

stop("'package' must be of length 1")

packagePath<-find.package(package,lib.loc,quiet=TRUE)

ans<-if(length(packagePath)){

FILES<-file.path(packagePath,...)

present<-file.exists(FILES)

if(any(present))

FILES[present]

else""

}

else""

if(mustWork&&identical(ans,""))

stop("no file found")

ans

}