# Installing some useful packages
library(tidyverse)
library(data.table)
library(kableExtra)
library(magrittr)
library(reshape2)   # Flexibly Reshape Data
# Association rule
library(arules)      # Association rule
library(arulesViz)   # arules visualization

此次所使用的資料是作者在2016年參加中華應用統計學會 (Chinese Applied Statistic Association, CASA)舉辦的資料分析競賽,當時共有141隊,並從中選出20隊去現場簡報給評審聽,感謝當時隊友們的相互幫忙,最終讓我們 (P-value隊)獲得了銀質獎的殊榮。

這份筆記的目的是藉由真實資料 (real data)來展示在R中要如何做關聯規則 (Association rule),並簡要的介紹association rule和解釋最後的報表代表什麼意思,故此份筆記不會包含當時分析的全部代碼

1 Introduction

Association rule 最主要的目的在於找出什麼樣的東西應該放在一起。

藉由顧客的消費行為來了解是什麼樣的顧客以及這些顧客為什麼買這些產品,找出商品間的相關規則 (association rule),讓企業藉由這些rules獲得利益與建立競爭優勢。

舉例來說,零售店可藉由此分析改變置物架上的商品排列或是設計吸引客戶的商業套餐、金融業可以設計不同的投保組合以擴大利潤……等。

Association rule 運作過程包含:

  • 選擇正確的項目:必須要在數以千計項目中選出真正有用的項目。

  • 藉由商品間出現的頻率來挖掘Association rule。

  • 克服實際上的限制:所選擇的項目愈多,計算所耗費的資源與時間愈久(呈指數遞增)。

2 Dataset

資料來源:2016年CASA 大數據行銷爭霸戰─超級市場銷售資料
資料格式:分別有交易紀錄檔會員資料檔小分類編碼檔產品資料檔

其中在交易紀錄檔內,有先刪除一些異常資料,分別是
1. 交易紀錄檔的數量為負數:數量為負表消費者的退貨紀錄
2. 交易紀錄檔的金額為零:金額為零表此次交易中的贈品或塑膠袋
上述兩種情況都不會是找出最佳購買組合的考量,故予以刪除。

# Download transaction dataset 
setwd("/Users/linweixiang/R/CASA/Data")
transaction <- read.csv("transaction.final.csv", header = T, 
                        fileEncoding = "big5") # dim() = 102660 * 10
transaction %>% head %>% 
  kable(., format = "html", caption = "交易記錄檔") %>% 
  kable_styling(bootstrap_options = "striped", full_width = F) %>%
  footnote("dim() = 102660 * 10")
交易記錄檔
店號 會員卡號 發票號碼 交易日期 小分類代號 貨號 數量 售價 金額 總金額
1023 1 253 980529 530101 10039508 1 199 199 199
1023 1 254 981025 110204 2993 1 49 49 1488
1023 1 254 981025 110404 7483 1 30 30 1488
1023 1 254 981025 120105 6270 1 67 67 1488
1023 1 254 981025 210101 10001070 1 55 55 1488
1023 1 254 981025 210101 10001071 1 25 25 1488
Note:
dim() = 102660 * 10
# Download member dataset 
setwd("/Users/linweixiang/R/CASA/Data")
member <- read.csv("member.csv", header = T, 
                   fileEncoding = "big5") # dim() = 4377 * 11
member %>% head() %>% 
  kable(., format = "html", caption = "會員資料檔") %>% 
  kable_styling(bootstrap_options = "striped", full_width = F) %>%
  footnote("dim() = 4377 * 11")
會員資料檔
會員卡號 生日.西元.月. 性別 家庭人口數 職業 學歷 婚姻狀態 子女人數 家庭月收入 age
1 Mar-63 7人以上 軍公教 碩士 未婚 0 6~8.9萬元 46
2 Sep-63 3~4人 軍公教 大學 已婚 3 6~8.9萬元 46
3 Jan-90 7人以上 學生 國中以下 未婚 0 4萬以下 19
4 Jul-62 3~4人 其它 專科 已婚 2 4~5.9萬元 47
5 Sep-55 1~2人 其它 國中以下 其他 0 其它 54
6 Feb-71 3~4人 大學 已婚 1 6~8.9萬元 38
Note:
dim() = 4377 * 11
# Download product_data
setwd("/Users/linweixiang/R/CASA/Data")
category <- read.table("小分類編碼表.csv", header = T, 
                       sep = ",") # dim() = 431 * 2
category %>% head() %>% 
  kable(., format = "html", caption = "小分類編碼表") %>% 
  kable_styling(bootstrap_options = "striped", full_width = F) %>%
  footnote("dim() = 431 * 2")
小分類編碼表
小分類代號 小分類名稱
110101 海水魚類
110102 淡水魚類
110103 切身類
110104 刺身類
110201 蝦類
110202 貝類
Note:
dim() = 431 * 2
# Download product_data
setwd("/Users/linweixiang/R/CASA/Data")
product <- read.csv("產品資料檔.csv", header = T, 
                       sep = ",") # dim() = 11171 * 3
product %>% head() %>% 
  kable(., format = "html", caption = "產品資料檔") %>% 
  kable_styling(bootstrap_options = "striped", full_width = F) %>%
  footnote("dim() = 11171 * 3")
產品資料檔
貨號 貨名 小分類代號
666 台灣野生紅魚 110101
709 台灣野生小白北 110101
714 馬爾地夫空運野生藍班 110101
2998 台灣海烏魚(殼) 110101
3091 台灣海域野生赤宗-大 110101
3092 台灣海域野生赤宗-小 110101
Note:
dim() = 11171 * 3

3 Association rule

要使用關聯規則前,有一些前置作業要處理
1. 先將交易記錄檔內的小分類代碼轉換成有意義的文字
2. 將交易紀錄檔轉換成arules適用的檔案

# Association rule
# input data → Transform to "transactions"
# Step 1. 轉換小分類代碼
transaction$小分類代號 <-  category[
  match(x = transaction$小分類代號, 
        table = category[,1]), 2] %>% as.factor() 
# Step 2. 將資料轉換成arules適合的檔案
trans_all <- reshape2::dcast(data = transaction, 
                             formula = 發票號碼 ~ 小分類代號, 
                             value.var = c("數量"), 
                             fun.aggregate = sum) %>% 
  as.data.table() # dim() = 12950 * 401 
colnames(trans_all) %<>% str_trim(., side = "both")
trans_no.rice <- trans_all[, c("發票號碼", "一般白米"):= NULL] # Delete the voice number and rice
trans_no.rice[1:5, 85:91] %>% 
  kable(., format = "html", row.names = c(seq(1:5))) %>% 
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  footnote("dim() = 12950 * 399")
果菜類 果汁飲料 果子臨時碼 哈蜜瓜類 海帶類 海水魚類 海苔類
1 1 1 0 1 0 1 0
2 0 0 0 0 0 0 0
3 0 0 0 0 0 0 0
4 0 0 0 0 0 0 0
5 0 0 0 0 0 0 0
Note:
dim() = 12950 * 399

先將交易紀錄檔的資料,轉換成上述的矩陣 (格式),再藉由下述code,即可將交易紀錄檔轉換成arules適用的檔案

# transactions file and have 12950 transactions, 399 items
trans_no.rice <- ifelse(test = trans_no.rice == 0, 
                    yes = FALSE, no = TRUE) %>% 
  as(object = ., Class = "transactions")
trans_no.rice
## transactions in sparse format with
##  12950 transactions (rows) and
##  399 items (columns)

出現上述資訊,表資料已成功轉換成arules適合的檔案
上述資訊表,有12950筆交易紀錄且399項不同的商品被買

3.1 EDA

# Item Frequency Plot
par(family = 'STKaiti')  # Let MAC can show chinese words
itemFrequencyPlot(trans_no.rice, 
                  topN = 10,
                  type = "absolute",
                  col = c(rep("red", 3), 
                          rep("cornflowerblue", 7)),
                  border = c(rep("red", 3), 
                             rep("cornflowerblue", 7)),
                  xlab = "", ylab = "Frequency", 
                  main = "全商品-不含白米")

item_table <- crossTable(trans_no.rice, sort = TRUE)
item_table[1:5,1:5]  %>% 
  kable(., format = "html", caption = "Cross table") %>% 
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  footnote("dim() = 399 * 399")
Cross table
家庭用品 果菜類 優質鮮奶 雞蛋類 一般葉菜類
家庭用品 2750 633 375 441 438
果菜類 633 1814 339 405 599
優質鮮奶 375 339 1772 341 229
雞蛋類 441 405 341 1618 298
一般葉菜類 438 599 229 298 1353
Note:
dim() = 399 * 399

上述表格意思為,在12950筆交易紀錄中,家庭用品出現2750次且{果菜類和家庭用品}則一起出現633次

3.2 Apriori algorithm

Fitst, we use below notation to describe the association rule of items
\[ \begin{align} &\{A\} =>\{B\} \\ where,\ & A,B: items \\ &\{A\}:left\ hand\ side\ (lhs) \\ &\{B\}:right\ hand\ side\ (rhs) \\ \end{align} \] then, we will introduce arules vocabulary of useful measures, which would help us in identifying rules:

  • count: 表特定組合在此次交易紀錄檔中出現的次數,即 \[ \begin{align} count = \#\left\{ \{A\} =>\{B\}\right\} \end{align} \]

  • support: 支持度,指一次交易中包含商品A與商品B的機率,即 \[ \begin{align} support = \frac{\#\left\{ \{A\} =>\{B\}\right\}}{the\ number\ of \ transactions} \end{align} \]

  • confidence: 信賴度,\(\{A\} =>\{B\}\) 表包含商品A的交易中,也包含商品B的機率,即 \[ \begin{align} confidence\ of\ \{A\} =>\{B\} = P(B|A) \end{align} \]

  • lift:增益,指購買商品A的情況下對購買商品B的影響力,即 \[ \begin{align} lift = \frac{P(A \cap B)}{P(A)*P(B)} \end{align} \]

Now, we know the measurement of association rule, then we can set the some criteria to find the satisfied rules.

# Association rule visualization
options(digits = 3)
rule_m1 <- apriori(trans_no.rice,
                   parameter = list(support = 0.01,
                                    maxlen = 3, # Maximum items
                                    confidence = 0.5))
rule_m1
## set of 33 rules

設定最小支持度 (support)為 1%(小於1%的組合被購買機率過低,不予討論),最小信賴度 (confidence)為50%(小於50%的confidence顯示購買商品A後,買商品B 的機率小於一半,不予討論),得 33種rules.

得到association rules後,亦可將count, support, confidence and lift的相關資訊整理如下表

# Summary of aprioir 
summary_m1 <- summary(rule_m1)@quality %>% as.data.table() %>%
  .[, V1:= NULL] %>% 
  separate(col = N, 
           into = c("quality", "value"), sep = ":") %>% 
  spread(., key = quality, value = value) 
colnames(summary_m1) %<>% str_trim(., side = "both")

summary_m1[, c("1st Qu.", "3rd Qu.", "Mean"):=NULL ] %>% 
  setcolorder(., 
              neworder = c("V2", "Min.", "Median", "Max.")) %>%
  as.data.frame() %>% 
  kable(., format = "html", caption = "Summary of rules",
        col.names = c("", "Min", "Median", "Max")) %>% 
  kable_styling(bootstrap_options = "striped", full_width = F)
Summary of rules
Min Median Max
lift 3.60 4.48 5.33
count 133 179 542
support 0.0103 0.0138 0.0419
confidence 0.504 0.610 0.739

取出confidence前10 名的rules,將其排序,得到關聯規則結果如下:

sub.rule_1 <- rule_m1 %>% 
  sort(., by = "confidence")  

sub.rule_1.df <- as(object = sub.rule_1, 
                    Class = "data.frame") %>% 
  head(10) %>% 
  separate(data = ., col = rules, 
           into = c("lhs", "rhs"), sep = "=>") %>%
  `rownames<-`(., NULL)
# String process 
sub.rule_1.df$lhs %<>%
  str_trim(string = ., side = "both") %>% 
  str_replace_all(string = ., pattern = "[{}]", replacement = "") %>% 
  str_replace_all(string = ., pattern = "[,]", replacement = ", ")
sub.rule_1.df$rhs %<>%
  str_trim(string = ., side = "both") %>% 
  str_replace_all(string = ., pattern = "[{}]", replacement = "") 

# View 
sub.rule_1.df %>% 
  kable(., format = "html", caption = "association rules") %>% 
  kable_styling(bootstrap_options = "striped", full_width = F)
association rules
lhs rhs support confidence lift count
菇菌類, 花菜類 果菜類 0.014 0.739 5.27 181
蔥薑蒜(辣椒), 花菜類 果菜類 0.012 0.728 5.20 155
花菜類, 有機葉菜類 果菜類 0.011 0.719 5.13 143
花菜類, 一般葉菜類 果菜類 0.015 0.706 5.04 190
蔥薑蒜(辣椒), 菇菌類 果菜類 0.014 0.700 5.00 184
蔥薑蒜(辣椒), 一般莖根類 果菜類 0.018 0.693 4.95 235
菇菌類, 一般莖根類 果菜類 0.019 0.693 4.95 244
菇菌類, 有機葉菜類 果菜類 0.013 0.688 4.91 170
一般莖根類, 一般葉菜類 果菜類 0.020 0.685 4.89 265
花菜類, 一般莖根類 果菜類 0.018 0.684 4.89 232

以第一列 (row)為例,

  • support:消費者購買菇菌類、花菜類與果菜類的組合占全部交易的1.4%。

  • confidence:消費者購買了菇菌類、花菜類,那麼他有73.9%的信心水準會購買果菜類。

  • lift:消費者購買菇菌類、花菜類,則購買果菜類的機率是購買其他商品機率的5.27倍。

  • count:消費者購買菇菌類、花菜類和果菜類的組合,出現181次

在某些特殊情況下,還會需要用到另外一個criteria,我們稍微敘述一下

chiSquared:當lift靠近1但count很大或lift離1很遠但count很小時,我們需要使用統計中的chi-square test,去檢測{A}和{B}在統計上是否有關 (避免假相關, Spurious correlation)

# Add chi-square test
quality(sub.rule_1)$p_value <- interestMeasure(x = sub.rule_1, 
                                               measure = 'chi', 
                                               significance = T,  # p-value 
                                               transactions = trans_no.rice)

sub.rule_1 %>% as(object = ., Class = "data.frame") %>% 
  head(10) %>% 
  `rownames<-`(., NULL) %>% 
  kable(., format = "html", caption = "association rules") %>% 
  kable_styling(bootstrap_options = "striped", full_width = F)
association rules
rules support confidence lift count p_value
{菇菌類,花菜類} => {果菜類} 0.014 0.739 5.27 181 0
{蔥薑蒜(辣椒),花菜類} => {果菜類} 0.012 0.728 5.20 155 0
{花菜類,有機葉菜類} => {果菜類} 0.011 0.719 5.13 143 0
{花菜類,一般葉菜類} => {果菜類} 0.015 0.706 5.04 190 0
{蔥薑蒜(辣椒),菇菌類} => {果菜類} 0.014 0.700 5.00 184 0
{蔥薑蒜(辣椒),一般莖根類} => {果菜類} 0.018 0.693 4.95 235 0
{菇菌類,一般莖根類} => {果菜類} 0.019 0.693 4.95 244 0
{菇菌類,有機葉菜類} => {果菜類} 0.013 0.688 4.91 170 0
{一般莖根類,一般葉菜類} => {果菜類} 0.020 0.685 4.89 265 0
{花菜類,一般莖根類} => {果菜類} 0.018 0.684 4.89 232 0

可發現我們額外增加了一行 (column),表示chisquare test的p-value, 由上表看出這10種組合的p-value都小於0.05,故我們有充分證據說確實有人會同時買菇菌類、花菜類與果菜類。

若仔細觀察,可發現有些規則會重複,故我們需要將一些重複的規則刪除

# Delete some duplicative rules (redundant rules)
subset.matrix <- is.subset(x = sub.rule_1, y = sub.rule_1) %>%
  as.matrix() 
# 把這個矩陣的下三角去除,只留上三角的資訊
subset.matrix[lower.tri(subset.matrix, diag = T)] <- NA

# 計算每個column中TRUE的個數,若有一個以上的TRUE,表此column是多餘的
redundant <- colSums(subset.matrix, na.rm = T) >= 1

# Remove redundant rules
sub.rule_1 <- sub.rule_1[!redundant]
sub.rule_1
## set of 32 rules

由上述資訊可知道,原始有33個rules,經由上述程式計算後,我們刪除了一個重複的rules,剩下32個rules

3.3 Visualization

par(family = 'STKaiti')
rule_m1 %>% plot()  # Scatter plot for 33 rules

# Visualization of Network 
par(family = 'STKaiti')
sub.rule_1 %>% head(10) %>% 
  plot(., method = "graph", main = "Network-exclud rice")

上述網絡圖以菇菌類、花菜類和果菜類為例來解釋

  • 圈圈顏色越深代表買菇菌類、花菜類的情況下,購買果菜 類的機率會越高。

  • 圈圈大小越大表示購買菇菌類、花菜類、果菜類,此種購 買組合佔全部交易比例越多。