1. 程式人生 > >關聯規則的R語言實現

關聯規則的R語言實現

############################ 關聯分析 案例實踐 ############################  背景假定: 在電影商店中,一個客戶在一次購物中(也可不同時間段多次購買)購買了很多不同種類,品牌的電影盤。我們要從中找到有用的資訊,提升商店的銷售。 問題提出: 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, parameter= list(support=0.6, conf=0.8,target="rules")) # 使用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)

ClassSexAgeSurvivedFreq

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.betterby="lift")

inspect(rules.sorted)

> inspect(rules.sorted)

   lhs            rhs                supportconfidence    lift

1  {Class=2nd,                                                   

Age=Child}  => {Survived=Yes0.0109041341.00000003.095640

2  {Class=2nd,                                                   

    Sex=Female,                                                  

Age=Child}  => {Survived=Yes0.0059064061.00000003.095640

3  {Class=1st,                                                   

Sex=Female} => {Survived=Yes0.0640617900.97241383.010243

4  {Class=1st,                                                   

    Sex=Female,                                                  

Age=Adult}  => {Survived=Yes0.0636074510.97222223.009650

5  {Class=2nd,                                                   

Sex=Female} => {Survived=Yes0.0422535210.87735852.715986

6  {Class=Crew,                                                  

Sex=Female} => {Survived=Yes0.0090867790.86956522.691861

7  {Class=Crew,                                                  

    Sex=Female,                                                  

Age=Adult}  => {Survived=Yes0.0090867790.86956522.691861

8  {Class=2nd,                                                   

    Sex=Female,                                                  

Age=Adult}  => {Survived=Yes0.0363471150.86021512.662916

9  {Class=2nd,                                                   

    Sex=Male,                                                    

Age=Adult}  => {Survived=No}  0.0699681960.91666671.354083

10 {Class=2nd,                                                   

Sex=Male}   => {Survived=No}  0.0699681960.86033521.270871

11 {Class=3rd,                                                   

    Sex=Male,                                                    

Age=Adult}  => {Survived=No}  0.1758291690.83766231.237379

12 {Class=3rd,                                                   

Sex=Male}   => {Survived=No}  0.1917310310.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.sortedrules.sorted

# 使得下三角包含主對角線設定為NA

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

# 計算列TRUE的數量

redundant <- colSums(subset.matrixna.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=Yes0.0109041341.0000000     3.095640

2 {Class=1st,                                                   

Sex=Female} => {Survived=Yes0.0640617900.9724138     3.010243

3 {Class=2nd,                                                   

Sex=Female} => {Survived=Yes0.0422535210.8773585     2.715986

4 {Class=Crew,                                                  

Sex=Female} => {Survived=Yes0.0090867790.8695652     2.691861

5 {Class=2nd,                                                   

   Sex=Male,                                                    

Age=Adult}  => {Survived=No}  0.0699681960.9166667     1.354083

6 {Class=2nd,                                                   

Sex=Male}   => {Survived=No}  0.0699681960.8603352     1.270871

7 {Class=3rd,                                                   

   Sex=Male,                                                    

Age=Adult}  => {Survived=No}  0.1758291690.8376623     1.237379

8 {Class=3rd,                                                   

Sex=Male}   => {Survived=No}  0.1917310310.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(rulesby "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}=>{