关联规则R语言实现

原文地址：http://blog.csdn.net/wolfbloodbj/article/details/8836441

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

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

背景假定:

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

问题提出:

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  { Sixth Sense} => {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

}