您的位置:首页 > 其它

关联规则R语言实现

2013-04-22 20:30 253 查看
文章参考资料:

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
}
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: