1.1 장바구니 확장

마트에서 구매하는 상품을 장바구니나 카트에 담게 되면 이를 장바구니 분석(Market Basket Analysis)를 수행하지만, 장바구니를 확장할 수 있다. 예를 들어,

• 넥플릭스와 같은 온라인 영화 대여 서비스에서 사용자가 본 영화
• 대학교 학생들이 교양과목으로 수강한 과목
• 국회의원이 발의한 법안

1.2 MBA 활용

고객이 장바구니에 담은 데이터를 잘 활용하면 다음과 같은 질문에 대한 답을 구할 수 있다.

• A 상품을 구매한 사람이 B 상품도 구매했다.
• 진열장에 A 상품과 B 상품을 함께 놓아두고, A상품과 B상품을 묶음 판매한다.
• 영화와 드라마를 추천한다.

1.3 주요 개념과 구성요소

{김밥} → {생수} 라는 연관 규칙을 찾았다고 하면 이에 따려오는 중요 개념은 다음과 같다.

• {김밥}: 선행사건(antecedent)
• {생수}: 결과(consequent)
• 측도: 지지도, 신뢰도, 향상도

연관분석결과 산출물에 인용되는 주요 용어에 대해 이해하고 넘어가야 된다.

• 제품에 대한 인기도
  • 지지도(Support) : 확률 \(Support(A) = P(A)\), 하나 이상의 빈발 제품 집합 식별에 활용됨, 물품 두개로 확장하게 되면 \(S(X \rightarrow Y) = \frac{n(X \cap Y )}{N}\)로 표현되며 전체 물품(\(N\)) 중에서 \(X, Y\)가 모두 출현하는 횟수로 둘을 나누면 산출된다.
• 연관규칙이 얼마나 많이 참인가?
  • 신뢰도(Confidence) : 조건부 확률 \(Confidence(A \rightarrow B) = \frac{P(A,B)}{P(A)}\), 제품 집합 간의 연관성 강도를 측정하는데 활용됨. 즉, \(C(X \rightarrow Y) = \frac{n(X \cap Y )}{n(X)}\)로 \(X\)가 포함된 거래중에서 \(X, Y\)가 모두 모함된 장바구니를 의미한다.
• 연관관계가 얼마나 강한가?
  • 향상도(Lift) : \(lift(A \rightarrow B) = \frac{P(A,B)}{P(A) \dot P(B)}\) 도출된 연관규칙의 효용성을 측정하는데 활용됨. 향상도는 \(lift = \frac{\text{신뢰도}}{\text{지지도}}\)로 계산되고 1이면 서로 독립으로 관련이 없는 것으로 판정하고 1보다 크거나 작으면 관련이 있는 것으로 파악한다. 즉, 향상도가 1보다 크면 A를 사면 B도 더 살 것이고, 1보다 작으면 A를 사면 B는 덜 살 것을 나타낸다.

생성 가능한 모든 규칙을 생성하고, 지지도, 신뢰도, 향상도를 판단기준으로 놓고 가장 최선의 규칙을 선택하면 되지만, 현실적으로 제품개수가 증가하게 되면 컴퓨터 연산시간이 이를 감당하지 못한다. 대안으로 가장 빈발하는 제품집합만을 기준으로 삼아 연관규칙을 생성해 나간다.

“Support of an item set never exceeds the support of its subsets, which is known as anti-monotoneproperty of support.” 즉, 지지도 특성 중에 제품 집합 지지도는 절대로 하위집합 지지도를 넘어서지 못하는 특징이 있다. 이를 활용하여 빈발집합을 우선 고려하고, 지지도와 최소지지도를 모수로 적당한 값 예를 들어, 기준 지지도 30%, 기준 신뢰도 70%로 설정하여 연관규칙 도출에 필요한 연산시간을 급격히 줄인다. 지지도(support)는 좋은 규칙(빈도가 많은, 구성비가 높은)을 찾거나, 불필요한 연산을 줄일 때(pruning, 가지치기)의 기준으로 사용하고, 신뢰도(confidence)가 높을 수록 유용한 규칙일 가능성 높다고 본다. 통계전문가나 기계학습 전문가의 경우 신뢰도(confidence)와 향상도(lift)가 높은 연관규칙을 선호하는 경향이 있는 반면, 매출과 이익을 책임져야 하는 현업의 실무 담당자의 경우는 지지도(Support)가 높아서 전체 거래 건수 중에서 해당 연관규칙이 포함된 거래건수가 많아야 높은 매출 증가를 기대할 수 있기 때문에 지지도를 중요한 지표로 여긴다.

Apriori 알고리즘이 대표적인 연관규칙 도출 알고리즘이고, apriori() 함수 기본디폴트 설정값은 다음과 같다.

2.1 글로 서술

장바구니 A에 “김밥”, “사과”, “참치캔”을 구매해서 들고 있고, 장바구니 B에 “라면”, “배”, “김밥”을 구매해서 들고 있는데 두 장바구니에 공통된 상품은 무엇이고 두 장바구니 통틀어 담긴 모든 상품은 무엇인지 알아보자.

2.2 수학 표현

수학적으로 표현하면 다음과 같다.

먼저, 장바구니 A, 장바구니 B에 담긴 상품은 집합기호를 사용해서 다음과 같이 표현한다.

• \(장바구니_A = \{ 김밥, 사과, 참치캔 \}\)
• \(장바구니_B = \{ 라면, 배, 김밥 \}\)

그 다음 두 장바구니에 공통으로 담긴 상품을 파악하고, 두 장바구니 모두에 담긴 상품 전체를 살펴보자. 이를 위해서 합집합(\(\cup\)), 교집합(\(\cap\)) 개념을 도입하여 수식을 전개한다.

• \[장바구니_A \cap 장바구니_B = \{ 깁밥\}\]
• \[장바구니_A \cup 장바구니_B = \{ 김밥, 사과, 참치캔, 라면, 배 \}\]

2.3 R 코드 표현

장바구니를 벡터로 가정하고 벡터의 원소를 편의점에서 구매한 상품이라고 간주하자. 이를 dplyr 팩키지 intersect(), union() 함수를 사용해서 집합연산 작업을 수행할 수 있다.

library(tidyverse)

cart_A <- c("김밥", "사과", "참치캔")
cart_B <- c("라면", "배", "김밥")

dplyr::intersect(cart_A, cart_B)

[1] "김밥"

dplyr::union(cart_A, cart_B)

[1] "김밥"   "사과"   "참치캔" "라면"   "배"    

2.4 장바구니 크기

다음으로 상품이 \(N\)개 있는 경우, \(n\)개를 고른 장바구니가 얼마나 존재하는지 수학적으로 파악해 보자. \(N\)개에서 \(n\)개를 뽑는 조합의 수를 계산하는 것과 같다.

\[{ N\choose n} = \frac{N!}{(N-n)!n!}\]

그런데 \(n\)를 0에서부터 N개를 뽑는 모든 경우의 수를 따져야 하기 때문에 다음과 같이 가능한 모든 장바구니를 표현할 수 있다. Newton’s Binomial Theorem에 따라 다음과 같이 정리할 수 있다.

\[ \sum_{n=0}^{N} { N\choose n} = 2^n\]

예를 들어, 전체 판매 상품이 4개인 경우, 2개 상품을 골라 장바구니 넣는 경우의 수를 따져보자.

\[{4\choose 2} = \frac{4!}{(4-2)!2!} = \frac{4 \times 3 \times 2 \times 1}{2 \times 2} = 6\]

R 코드로 작성하면 다음과 같다. choose() 함수를 사용해서 조합의 수를 구할 수 있다.

total_items <- 4
items_in_basket <- 2
choose(total_items, items_in_basket)

[1] 6

전체 상품 4개에서 2개를 뽑는 경우를 살펴봤는데, 이번에는 모든 경우의 수를 따져보자. 장바구니에 상품이 없는 경우와 4개 상품이 다양한 조합으로 담긴 경우와 모든 상품이 장바구니에 담긴 사례는 다음과 같이 choose() 함수와 for 루프를 조합시켜 모든 경우의 수에 대한 합을 계산한다. 이를 수식을 통해 확인해보자.

\[2^4 = 16\]

total_items <- 4
combi_basket <- c()

for(i in 0:total_items) {
  combi_basket[i+1] <- choose(total_items, i)
}

(basket_cases <- tibble(basket_size = 0:total_items, combi_basket))

# A tibble: 5 x 2
  basket_size combi_basket
        <int>        <dbl>
1           0            1
2           1            4
3           2            6
4           3            4
5           4            1

basket_cases %>% 
  summarise(basket_size = sum(combi_basket))

# A tibble: 1 x 1
  basket_size
        <dbl>
1          16

장바구니에 담기는 상품 조합을 전체 상품수에 맞춰 생기는 경우의 수를 시각화해보자.

total_items = 100
choose_items = function(x) choose(total_items, x)

tibble(x = 0) %>% 
  ggplot(aes(x=x)) +
    stat_function(fun = choose_items)+
    xlim(0, total_items) +
    labs(x="장바구니 크기", ylab="장바구니 빈도수")

3.1 DF → 장바구니 데이터 - wide ³

일반적인 CSV 파일을 장바구니 데이터 분석을 위해서 자료구조를 먼저 맞춰야만 된다. 장바구니 데이터는 고객별로 혹은 고객이 중복구매를 하지 않는다면 날짜별로 구매한 생필품이 장바구니(카트)에 담기 텍스트 형태로 원자료가 구성된다.

cart_txt  <- read_lines("data/groceries.csv")

cart_txt %>% 
    tbl_df() %>%
    rename(items=value) %>% 
    sample_n(10) %>% 
    DT::datatable()

장바구니 데이터는 마트에서 카드에 담긴 물품을 생각하면 쉽다. 각 고객마다 마트에서 장바구니 카드를 밀게 되거나, 인터넷에서 주문을 할 때 가상의 장바구니에 담게 된다. 담겨진 물건은 물품마다 고유 제품번호가 부여되어 있고, 해당 제품에 대한 라벨이 함께 붙어 있다. 고유 제품번호는 컴퓨터 전산처리를 위해 부여된 것이고, 해당 제품에 대한 라벨은 사람이 제품을 이해하기 위해 부여된 것이다.

cart_df <- cart_txt %>% tbl_df %>% 
    rename(items=value) %>% 
    mutate(transaction_id = paste0("trans_", row_number())) %>% 
    select(transaction_id, items)

cart_df %>% 
    sample_n(100) %>% 
    DT::datatable()

arules 팩키지에 소속된 read.transactions 함수를 사용해서 장바구니 데이터를 연관분석을 위한 자료형으로 불러 읽어온다. 즉, 데이터가 이미 basket에 담긴 형태로 된 경우 구분자를 지정하여 바로 불러 읽어온다.

##======================================================================================
## 01. 장바구니 분석 데이터 가져오기
##======================================================================================

cart  <- read.transactions("data/groceries.csv", format = "basket", sep=",")
head(cart)

transactions in sparse format with
 6 transactions (rows) and
 169 items (columns)

library(datasets)
data(Groceries)

# 데이터가 동일한지 확인

# G <- inspect(Groceries)
# C <- inspect(cart)
# identical(G, C)

library(datasets) 팩키지에 Groceries 데이터가 기본으로 포함되어 있어, 이를 바로 활용해도 좋다.

3.2 DF → 장바구니 데이터 - long

혹은 데이터가 이와는 달리 다음과 같은 형태로 긴(long) 텍스트 데이터 형태로 구성되는 경우도 있다. How to prep transaction data into basket for arules에 나와있는 데이터가 좋은 형태가 된다.

데이터가 아래와 같이 긴(long)형태로 되어 있는 경우,

거래ID(transaction ID)는 “order”, 아이템명은 “part_desc”로 지정한다. 이를 image() 함수로 시각화하고 이를 다시 inspect() 함수로 제대로 되었는지 확인한다. 두가지 작업 흐름이 있지만 데이터프레임을 .csv 파일로 떨어뜨리고 이를 read.transactions() 함수로 불러오는 경우를 살펴본다. 하지만, 한글로 된 경우 가능하면 split() 함수를 사용하는 것이 직접 한글문자가 들어있는 .csv 파일을 불러 읽어들이는 것보다 문자가 깨지는 문제를 겪게되지 않을 가능성이 크다.

order_df <- tribble(
    ~"order", ~"part", ~"part_desc",
    1, "A", "PartA", 
    1, "B", "PartB", 
    1, "G", "PartG",
    2, "R", "PartR", 
    3, "A", "PartA",
    3, "B", "PartB",
    4, "E", "PartE", 
    5, "Y", "PartY",
    6, "A", "PartA", 
    6, "B", "PartB", 
    6, "F", "PartF",
    6, "V", "PartV" 
)

order_df %>% write_csv("data/order_df.csv", col_names = TRUE)

order_tr <- read.transactions("data/order_df.csv", 
                              format = "single", 
                              sep = ",",
                              cols = c("order","part_desc"),
                              header = TRUE)

image(order_tr)

inspect(order_tr)

    items                     transactionID
[1] {PartA,PartB,PartG}       1            
[2] {PartR}                   2            
[3] {PartA,PartB}             3            
[4] {PartE}                   4            
[5] {PartY}                   5            
[6] {PartA,PartB,PartF,PartV} 6            

order_split <- split(order_df$part_desc, order_df$order)

order_split_tr <- as(order_split, "transactions")

image(order_split_tr)

inspect(order_split_tr)

    items                     transactionID
[1] {PartA,PartB,PartG}       1            
[2] {PartR}                   2            
[3] {PartA,PartB}             3            
[4] {PartE}                   4            
[5] {PartY}                   5            
[6] {PartA,PartB,PartF,PartV} 6            

3.3 장바구니 데이터 분석 환경설정

가장 먼저 장바구니 데이터 분석을 위한 환경을 설정한다. 연관규칙 추출을 위한 arules, 추출된 연관규칙 시각화를 위한 arulesViz 팩키지가 기본적으로 필요하다. 여기에 wordcloud 팩키지를 사용해서 사용된 장바구니에 가장 많이 든 물품이 무엇인지 텍스트 마이닝에 많이 사용되는 시각화도구도 활용한다.

##======================================================================================
## 00. 장바구니 분석 환경 설정
##======================================================================================
# arules, arulesViz, wordcloud 팩키지 설치
# install.packages("arules")
# install.packages("arulesViz")
# install.packages("wordcloud")

library(arules)
library(arulesViz)
library(wordcloud)
library(tidyverse)

4.1 aprior 제품 빈도 분석

먼저, 매출에 신경을 많이 신경을 쓰는 실무자 입장에서 apriori 알고리즘을 통해서 빈도가 높은 제품을 분석해보자.

cart_supp <- apriori(cart_trx,
                     parameter = list(supp=0.1,
                                     target="frequent itemsets"),
                     control = list(verbose=FALSE))

cart_supp %>% 
  sort(by="support") %>% 
  head(5) %>% 
  arules::inspect(.)

    items              support   count
[1] {whole milk}       0.2555160 2513 
[2] {other vegetables} 0.1934926 1903 
[3] {rolls/buns}       0.1839349 1809 
[4] {soda}             0.1743772 1715 
[5] {yogurt}           0.1395018 1372 

4.2 aprior 제품 빈도 시각화

itemFrequencyPlot() 함수를 사용해서 상위 10개 인기 제품을 absolute, relative 기준으로 뽑아내고 색상등을 넣어준다.

par(mfrow=c(1,2))

itemFrequencyPlot(cart_trx, topN=10, 
                  type="absolute", 
                  horiz=FALSE, 
                  # col=rainbow(10),
                  ylab="")

itemFrequencyPlot(cart_trx, topN=10, 
                  type="relative", 
                  horiz=TRUE, 
                  col=rainbow(10),
                  ylab="",
                  xlab="상대 제품 빈도",
                  main="상위 10개 제품",
                  cex.names=1.1)

5.1 유의미한 연관규칙 탐색

연관규칙이 너무 많이 도출되기 때문에 이중에서 가장 유의미한 규칙을 뽑아낼 필요가 있다. 이런 경우 신뢰도(Confidence) 혹은 향상도(Lift) 를 기준으로 내림차순 정렬하면 유의미한 연관규칙을 빠르게 탐색할 수 있다.

특히 연관규칙집합의 길이가 긴 경우 maxlen=3 인자를 조정하여 설정한다.

#---------------------------------------------------------------------------------
# 01. 정렬
#---------------------------------------------------------------------------------
# 최대 길이 3인 집합으로 한정
rules <- apriori(cart_trx, parameter = list(supp = 0.001, conf = 0.8, minlen=2, maxlen=5))

Apriori

Parameter specification:
 confidence minval smax arem  aval originalSupport maxtime support minlen
        0.8    0.1    1 none FALSE            TRUE       5   0.001      2
 maxlen target   ext
      5  rules FALSE

Algorithmic control:
 filter tree heap memopt load sort verbose
    0.1 TRUE TRUE  FALSE TRUE    2    TRUE

Absolute minimum support count: 9 

set item appearances ...[0 item(s)] done [0.00s].
set transactions ...[169 item(s), 9835 transaction(s)] done [0.00s].
sorting and recoding items ... [157 item(s)] done [0.00s].
creating transaction tree ... done [0.00s].
checking subsets of size 1 2 3 4 5 done [0.01s].
writing ... [398 rule(s)] done [0.00s].
creating S4 object  ... done [0.00s].

rules <- sort(rules, by="confidence", decreasing=TRUE)
inspect(rules[1:10])

     lhs                     rhs                support confidence lift count
[1]  {rice,                                                                  
      sugar}              => {whole milk}        0.0012          1  3.9    12
[2]  {canned fish,                                                           
      hygiene articles}   => {whole milk}        0.0011          1  3.9    11
[3]  {butter,                                                                
      rice,                                                                  
      root vegetables}    => {whole milk}        0.0010          1  3.9    10
[4]  {flour,                                                                 
      root vegetables,                                                       
      whipped/sour cream} => {whole milk}        0.0017          1  3.9    17
[5]  {butter,                                                                
      domestic eggs,                                                         
      soft cheese}        => {whole milk}        0.0010          1  3.9    10
[6]  {citrus fruit,                                                          
      root vegetables,                                                       
      soft cheese}        => {other vegetables}  0.0010          1  5.2    10
[7]  {butter,                                                                
      hygiene articles,                                                      
      pip fruit}          => {whole milk}        0.0010          1  3.9    10
[8]  {hygiene articles,                                                      
      root vegetables,                                                       
      whipped/sour cream} => {whole milk}        0.0010          1  3.9    10
[9]  {hygiene articles,                                                      
      pip fruit,                                                             
      root vegetables}    => {whole milk}        0.0010          1  3.9    10
[10] {cream cheese ,                                                         
      domestic eggs,                                                         
      sugar}              => {whole milk}        0.0011          1  3.9    11

5.2 연관규칙 탐색: subset ⁴

subset() 함수에 subset = 질의문을 조합하여 원하는 연관규칙을 뽑아낼 수 있다. 특히,

• %in% : (select itemsets matching any given item) 즉, 적어도 하나의 제품이라도 존재하면 연관규칙을 뽑아서 가져온다.
• %pin% : (partial matching) 즉, 부분 일치만 하더라도 가져온다.
• %ain% : (select only itemsets matching all given item) 즉, 완전한 일치를 할 때만 연관규칙을 가져온다.

rules %>% 
  subset(., subset = items %in% c("butter", "rice") & confidence >.95 & lift> 1.5) %>% 
  head(5) %>% 
  inspect(.)

    lhs                   rhs          support confidence lift count
[1] {rice,                                                          
     sugar}            => {whole milk}  0.0012          1  3.9    12
[2] {butter,                                                        
     rice,                                                          
     root vegetables}  => {whole milk}  0.0010          1  3.9    10
[3] {butter,                                                        
     domestic eggs,                                                 
     soft cheese}      => {whole milk}  0.0010          1  3.9    10
[4] {butter,                                                        
     hygiene articles,                                              
     pip fruit}        => {whole milk}  0.0010          1  3.9    10
[5] {butter,                                                        
     other vegetables,                                              
     root vegetables,                                               
     white bread}      => {whole milk}  0.0010          1  3.9    10

5.3 연관규칙 정적 시각화

연관규칙을 탐색하는데 정적 그래프로 method="grouped"를 사용하고, 색상의 강도를 shading = "confidence"을 사용해서 시각화한다. 물론 measure=값은 다른 측도로 변경이 가능하다.

plot(rules,
     method = "grouped",
     measure = "lift",
     shading = "confidence")

연관규칙을 탐색하는데 병렬 정적 그래프로 method="paracoord"를 사용하고, 색상의 강도를 shading = "confidence"을 사용해서 시각화한다.

plot(rules,
     method = "paracoord",
     measure = "lift",
     shading = "confidence")

6.1 연관규칙 도우미: DT

arulesViz 팩키지 inspectDT() 함수를 이용하면 DT의 강력한 인터랙티브 테이블 기능을 사용해서 유용한 연관규칙을 찾아내는데 도움을 준다.

arulesViz::inspectDT(rules)

6.2 연관규칙 도우미: plotly

plotly 팩키지는 지지도, 신뢰도, 향상도를 산점도로 인터랙티브 방식으로 시각화할 수 있게 도움을 준다. engine = "plotly"로 지정하게 되면 인터랙티브 방식을 활성화시키게 된다.

plot(rules, measure = c("confidence", "lift"),
     shading = "support",
     method = "scatterplot",
     engine = "plotly")

6.3 연관규칙 도우미: network

plot()에서 method="graph"로, engine = "htmlwidget"으로 지정하게 되면 네트워크 시각화가 가능하다. 너무 복잡한 네트워크 시각화는 큰 도움이 되지 않기 때문에 유의미한 규칙으로 축소한 후에 네트워크 시각화 작업을 수행한다.

나중에 필요한 경우 saveWidget() 함수를 사용해서 로컬파일에 저장한 후 재사용한다.

network_rules_html <- rules %>% 
  sort(by="confidence") %>% 
  head(10) %>% 
  plot(., method = "graph",
       engine = "htmlwidget")

network_rules_html

# library(htmlwidgets)
# saveWidget(network_rules_html, file = "data/rules_network.html")

# saveAsGraph(rules, file = "data/rules.graphml")

6.4 연관규칙 도우미: shiny

스위스 군대 칼(swiss army knife)와 같은 역할을 하는 것이 ruleExplorer() 함수로 호출되는 shiny 기능이다. 단, 너무 규칙이 많으면 문제가 되니 표본을 추출하여 규칙을 만들어 ruleExplorer() 샤이니 기능을 사용한다.

## 데이터프레임 --> transaction 자료구조 변환
cart_smpl_raw <- cart_df %>% 
  sample_frac(0.01) %>% 
  mutate(items = str_split(items, ",")) %>% 
  select(tid=transaction_id, items) %>% 
  unnest(items) 

cart_smpl_split <- split(cart_smpl_raw$items, cart_smpl_raw$tid)
cart_smpl_trx <- as(cart_smpl_split, "transactions")

## apriori 연관규칙 도출
smpl_rules <- apriori(cart_smpl_trx, parameter = list(supp = 0.001, conf = 0.8, minlen=2, maxlen=5))

Apriori

Parameter specification:
 confidence minval smax arem  aval originalSupport maxtime support minlen
        0.8    0.1    1 none FALSE            TRUE       5   0.001      2
 maxlen target   ext
      5  rules FALSE

Algorithmic control:
 filter tree heap memopt load sort verbose
    0.1 TRUE TRUE  FALSE TRUE    2    TRUE

Absolute minimum support count: 0 

set item appearances ...[0 item(s)] done [0.00s].
set transactions ...[98 item(s), 98 transaction(s)] done [0.00s].
sorting and recoding items ... [98 item(s)] done [0.00s].
creating transaction tree ... done [0.00s].
checking subsets of size 1 2 3 4 5 done [0.01s].
writing ... [443871 rule(s)] done [0.06s].
creating S4 object  ... done [0.12s].

## shiny
# ruleExplorer(smpl_rules)

연관규칙 shiny 탐색기

7.1 측도 모수 선정

지지도를 특정값으로 고정시킨 후에 신뢰도를 변화시켜 연관규칙수를 적절히 찾은 후에 이를 바탕으로 후속작업을 이어나간다. 이런 경우 연산량이 많기 때문에 cart_smpl_trx와 같은 임의표본추출된 작은 데이터셋을 사용한다.

## 신뢰도 설정
conf_level <- seq(from=0.1, to=0.9, by =0.1)

## 연관규칙 길이 
length_arules <- NULL

## Apriori 알고리즘 실행
for (i in 1:length(conf_level)) {
  
  tmp_arule <- apriori(cart_smpl_trx,
                       parameter=list(supp=0.02,
                                      conf=conf_level[i],
                                      target="rules"),
                       control = list(verbose=FALSE))
  length_arules[i] <- length(tmp_arule)
}

## 시각화
tibble(conf_level, length_arules) %>% 
  ggplot(aes(x=conf_level, y=length_arules)) +
    geom_point() +
    geom_line() +
    scale_x_continuous(labels = scales::percent) +
    labs(x="신뢰도(confidence)", y="연관규칙 수",
         title="신뢰도 변화에 따른 적절한 연관규칙수 탐색",
         subtitle="지지도 0.02로 고정한 후 신뢰도를 변화") +
    theme_bw()

7.2 중복 연관집합 제거

흔히, 연관규칙이 반복된다. 특정 제품이 거의 모든 연관규칙에 포함된 경우 해당 제품을 데이터에서 제거하고 연관규칙을 찾아내는 것도 방법이고, 대안으로 생성된 중복규칙을 제거하는 것도 바람직하다.

종복 연관규칙은 더 높은 신뢰도(confidence)를 갖는 좀더 일반화된 규칙이 존재하는 경우 연관규칙이 중복되었다고 한다. super-rule은 RHS에 동일한 제품이 존재하지만, LHS에서 하나 혹은 그 이상 제품을 제거할 수 있는 경우가 여기에 해당된다. 예를 들어,

• Super-rule: {A,B} –> {C}
  • {A,B} –> {C}
  • {A,B,D} –> {C}

따라서 중복이 없는 연관규칙은 다음과 같이 정의된다.

• 다른 모든 연관규칙은 해당 규칙에 Super-Rule이다.
• 다른 모든 연관규칙이 더 낮은 신뢰도를 갖는다.

#---------------------------------------------------------------------------------
# 02. 중복 집합 제거
#---------------------------------------------------------------------------------
# 중복규칙 제거 -----
rules
rules_pruned <- rules[!is.redundant(rules)]
rules_pruned

7.3 목표 제품 집중 분석

지금까지 연관규칙을 생성하는 방법을 학습했고, 생성된 규칙이 통상적으로 많기 때문에 이를 제거하거나 축약하는 방식을 살펴봤다. 이제 특정 제품에 집중해서 연관규칙을 활용하는 방법을 살펴보자.

• 특정 제품(whole milk)을 장바구니에 넣기 전에, 고객이 구매할 가능성이 많은 제품은 무엇인가?
• 특정 제품(whole milk)을 장바구니에 넣어 구매했다면, 고객이 추가로 구매할 가능성이 높은 제품은 무엇인가?

위와 같은 질문이 특정 제품을 기준으로 제기되는 상황이 전개된는데, 이를 R 코드로 구현하는 것은 어렵지 않다. 즉, lhs, rhs 인자를 제어하면서 풀 수 있다.

rules_before <- apriori(data=Groceries, parameter=list(supp=0.001,conf = 0.08), 
                        appearance = list(default="lhs",rhs="whole milk"),
                        control = list(verbose=FALSE))

rules_before <-sort(rules_before , decreasing=TRUE,by="confidence")

inspect(rules_before [1:5])

    lhs                     rhs          support confidence lift count
[1] {rice,                                                            
     sugar}              => {whole milk}  0.0012          1  3.9    12
[2] {canned fish,                                                     
     hygiene articles}   => {whole milk}  0.0011          1  3.9    11
[3] {root vegetables,                                                 
     butter,                                                          
     rice}               => {whole milk}  0.0010          1  3.9    10
[4] {root vegetables,                                                 
     whipped/sour cream,                                              
     flour}              => {whole milk}  0.0017          1  3.9    17
[5] {butter,                                                          
     soft cheese,                                                     
     domestic eggs}      => {whole milk}  0.0010          1  3.9    10

supp, conf 인자를 조정하여 연관규칙이 적절히 도출되도록 제어하고 반대의 경우도 살펴본다. 즉, 왼편에 “whole milk”를 장바구니에 넣은 경우 다른 어떤 것을 또 장바구니에 넣는지 살펴보자.

rules_after <-apriori(data=Groceries, parameter=list(supp=0.001,conf = 0.15,minlen=2), 
                      appearance = list(default="rhs", lhs="whole milk"),
                      control = list(verbose=F))

rules_after <-sort(rules_after , decreasing=TRUE,by="confidence")

inspect(rules_after [1:5])

    lhs             rhs                support confidence lift count
[1] {whole milk} => {other vegetables} 0.075   0.29       1.5  736  
[2] {whole milk} => {rolls/buns}       0.057   0.22       1.2  557  
[3] {whole milk} => {yogurt}           0.056   0.22       1.6  551  
[4] {whole milk} => {root vegetables}  0.049   0.19       1.8  481  
[5] {whole milk} => {tropical fruit}   0.042   0.17       1.6  416  

8.1 단어구름

연관규칙을 시각화하는데 네트워크 도표와 더불어 가장 빈발하는 제품을 wordcloud를 통해 살펴보는 것도 시각화의 한 좋은 사례다. worldcloud() 함수에 들어갈 자료형을 먼저 맞추고 나서 시각화한다. 단어와 단어 빈도수로 key-value 형태의 자료형이라 이를 tibble()에 넣어 시각화를 한다. letterCloud()를 통해 시각화도 가능한데 현재 버그가 있어 구현이 되는 경우도 있고 구현이 되지 않는 경우도 있다. ⁵

#--------------------------------------------------------------------------------------
# 01. 단어 구름
#--------------------------------------------------------------------------------------
library(wordcloud)
library(wordcloud2)
col.pal <- brewer.pal(9, "Blues")

wordcloud_df <- tibble(
  product_name = itemLabels(cart),
  product_cnt  = itemFrequency(cart, type="absolute")
)

wordcloud(words = wordcloud_df$product_name, 
          freq  = wordcloud_df$product_cnt, 
          min.freq = 1, scale = c(3, 0.2), col = col.pal , random.order = FALSE)

# letterCloud(words = wordcloud_df, word="W")

8.2 연관규칙 시각화

#--------------------------------------------------------------------------------------
# 02. 연관규칙 시각화
#--------------------------------------------------------------------------------------
library(arulesViz)
# 연관분석 유용한 규칙 -----
plotly_arules(rules,  measure = c("support", "confidence"), shading = "lift")

# 데이터프레임 변환 -----
rules_df <- tibble(
  lhs = labels( lhs(rules) ), 
  rhs = labels( rhs(rules) ))

rules_df <- bind_cols(rules_df, quality(rules)) %>% 
  arrange(desc(lift))

rules_df %>% 
  DT::datatable() %>% 
    DT::formatRound(c("support", "confidence", "lift"), digits=2) %>% 
    DT::formatRound(c("count"), digits=0)

library(visNetwork)
library(igraph)

# rules_30 <- head(sort(rules, by="lift"), 30)
rules_30 <- sort(rules, by="lift") %>% 
  head(30)

rules_30_ig <- plot(rules_30, method="graph", control=list(type="items") )

Available control parameters (with default values):
main     =  Graph for 30 rules
nodeColors   =  c("#66CC6680", "#9999CC80")
nodeCol  =  c("#EE0000FF", "#EE0303FF", "#EE0606FF", "#EE0909FF", "#EE0C0CFF", "#EE0F0FFF", "#EE1212FF", "#EE1515FF", "#EE1818FF", "#EE1B1BFF", "#EE1E1EFF", "#EE2222FF", "#EE2525FF", "#EE2828FF", "#EE2B2BFF", "#EE2E2EFF", "#EE3131FF", "#EE3434FF", "#EE3737FF", "#EE3A3AFF", "#EE3D3DFF", "#EE4040FF", "#EE4444FF", "#EE4747FF", "#EE4A4AFF", "#EE4D4DFF", "#EE5050FF", "#EE5353FF", "#EE5656FF", "#EE5959FF", "#EE5C5CFF", "#EE5F5FFF", "#EE6262FF", "#EE6666FF", "#EE6969FF", "#EE6C6CFF", "#EE6F6FFF", "#EE7272FF", "#EE7575FF",  "#EE7878FF", "#EE7B7BFF", "#EE7E7EFF", "#EE8181FF", "#EE8484FF", "#EE8888FF", "#EE8B8BFF", "#EE8E8EFF", "#EE9191FF", "#EE9494FF", "#EE9797FF", "#EE9999FF", "#EE9B9BFF", "#EE9D9DFF", "#EE9F9FFF", "#EEA0A0FF", "#EEA2A2FF", "#EEA4A4FF", "#EEA5A5FF", "#EEA7A7FF", "#EEA9A9FF", "#EEABABFF", "#EEACACFF", "#EEAEAEFF", "#EEB0B0FF", "#EEB1B1FF", "#EEB3B3FF", "#EEB5B5FF", "#EEB7B7FF", "#EEB8B8FF", "#EEBABAFF", "#EEBCBCFF", "#EEBDBDFF", "#EEBFBFFF", "#EEC1C1FF", "#EEC3C3FF", "#EEC4C4FF", "#EEC6C6FF", "#EEC8C8FF",  "#EEC9C9FF", "#EECBCBFF", "#EECDCDFF", "#EECFCFFF", "#EED0D0FF", "#EED2D2FF", "#EED4D4FF", "#EED5D5FF", "#EED7D7FF", "#EED9D9FF", "#EEDBDBFF", "#EEDCDCFF", "#EEDEDEFF", "#EEE0E0FF", "#EEE1E1FF", "#EEE3E3FF", "#EEE5E5FF", "#EEE7E7FF", "#EEE8E8FF", "#EEEAEAFF", "#EEECECFF", "#EEEEEEFF")
edgeCol  =  c("#474747FF", "#494949FF", "#4B4B4BFF", "#4D4D4DFF", "#4F4F4FFF", "#515151FF", "#535353FF", "#555555FF", "#575757FF", "#595959FF", "#5B5B5BFF", "#5E5E5EFF", "#606060FF", "#626262FF", "#646464FF", "#666666FF", "#686868FF", "#6A6A6AFF", "#6C6C6CFF", "#6E6E6EFF", "#707070FF", "#727272FF", "#747474FF", "#767676FF", "#787878FF", "#7A7A7AFF", "#7C7C7CFF", "#7E7E7EFF", "#808080FF", "#828282FF", "#848484FF", "#868686FF", "#888888FF", "#8A8A8AFF", "#8C8C8CFF", "#8D8D8DFF", "#8F8F8FFF", "#919191FF", "#939393FF",  "#959595FF", "#979797FF", "#999999FF", "#9A9A9AFF", "#9C9C9CFF", "#9E9E9EFF", "#A0A0A0FF", "#A2A2A2FF", "#A3A3A3FF", "#A5A5A5FF", "#A7A7A7FF", "#A9A9A9FF", "#AAAAAAFF", "#ACACACFF", "#AEAEAEFF", "#AFAFAFFF", "#B1B1B1FF", "#B3B3B3FF", "#B4B4B4FF", "#B6B6B6FF", "#B7B7B7FF", "#B9B9B9FF", "#BBBBBBFF", "#BCBCBCFF", "#BEBEBEFF", "#BFBFBFFF", "#C1C1C1FF", "#C2C2C2FF", "#C3C3C4FF", "#C5C5C5FF", "#C6C6C6FF", "#C8C8C8FF", "#C9C9C9FF", "#CACACAFF", "#CCCCCCFF", "#CDCDCDFF", "#CECECEFF", "#CFCFCFFF", "#D1D1D1FF",  "#D2D2D2FF", "#D3D3D3FF", "#D4D4D4FF", "#D5D5D5FF", "#D6D6D6FF", "#D7D7D7FF", "#D8D8D8FF", "#D9D9D9FF", "#DADADAFF", "#DBDBDBFF", "#DCDCDCFF", "#DDDDDDFF", "#DEDEDEFF", "#DEDEDEFF", "#DFDFDFFF", "#E0E0E0FF", "#E0E0E0FF", "#E1E1E1FF", "#E1E1E1FF", "#E2E2E2FF", "#E2E2E2FF", "#E2E2E2FF")
alpha    =  0.5
cex  =  1
itemLabels   =  TRUE
labelCol     =  #000000B3
measureLabels    =  FALSE
precision    =  3
layout   =  NULL
layoutParams     =  list()
arrowSize    =  0.5
engine   =  igraph
plot     =  TRUE
plot_options     =  list()
max  =  100
verbose  =  FALSE

# rules_30_ig_df <- toVisNetworkData(rules_30_ig, idToLabel = FALSE)
rules_30_ig_df <- get.data.frame(rules_30_ig, what = "both" )

visNetwork(
  nodes = data.frame(
    id = rules_30_ig_df$vertices$name,
    value = rules_30_ig_df$vertices$lift, # lift, confidence, support
    title = ifelse(rules_30_ig_df$vertices$label == "",rules_30_ig_df$vertices$name, rules_30_ig_df$vertices$label),
    rules_30_ig_df$vertices),
  edges = rules_30_ig_df$edges) %>% 
    visNodes(size = 10) %>%
    visLegend() %>%
    visEdges(smooth = FALSE) %>%
    visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE) %>%
    visInteraction(navigationButtons = TRUE) %>%
    visEdges(arrows = 'from') %>%
    visPhysics(
      solver = "barnesHut",
      maxVelocity = 35,
      forceAtlas2Based = list(gravitationalConstant = -6000))

# rules_30_ig <- plot(rules_30, method="graph", control=list(type="items") )
ig <- plot(rules_30, method="graph", control=list(type="itemsets") )

Available control parameters (with default values):
main     =  Graph for 30 rules
nodeColors   =  c("#66CC6680", "#9999CC80")
nodeCol  =  c("#EE0000FF", "#EE0303FF", "#EE0606FF", "#EE0909FF", "#EE0C0CFF", "#EE0F0FFF", "#EE1212FF", "#EE1515FF", "#EE1818FF", "#EE1B1BFF", "#EE1E1EFF", "#EE2222FF", "#EE2525FF", "#EE2828FF", "#EE2B2BFF", "#EE2E2EFF", "#EE3131FF", "#EE3434FF", "#EE3737FF", "#EE3A3AFF", "#EE3D3DFF", "#EE4040FF", "#EE4444FF", "#EE4747FF", "#EE4A4AFF", "#EE4D4DFF", "#EE5050FF", "#EE5353FF", "#EE5656FF", "#EE5959FF", "#EE5C5CFF", "#EE5F5FFF", "#EE6262FF", "#EE6666FF", "#EE6969FF", "#EE6C6CFF", "#EE6F6FFF", "#EE7272FF", "#EE7575FF",  "#EE7878FF", "#EE7B7BFF", "#EE7E7EFF", "#EE8181FF", "#EE8484FF", "#EE8888FF", "#EE8B8BFF", "#EE8E8EFF", "#EE9191FF", "#EE9494FF", "#EE9797FF", "#EE9999FF", "#EE9B9BFF", "#EE9D9DFF", "#EE9F9FFF", "#EEA0A0FF", "#EEA2A2FF", "#EEA4A4FF", "#EEA5A5FF", "#EEA7A7FF", "#EEA9A9FF", "#EEABABFF", "#EEACACFF", "#EEAEAEFF", "#EEB0B0FF", "#EEB1B1FF", "#EEB3B3FF", "#EEB5B5FF", "#EEB7B7FF", "#EEB8B8FF", "#EEBABAFF", "#EEBCBCFF", "#EEBDBDFF", "#EEBFBFFF", "#EEC1C1FF", "#EEC3C3FF", "#EEC4C4FF", "#EEC6C6FF", "#EEC8C8FF",  "#EEC9C9FF", "#EECBCBFF", "#EECDCDFF", "#EECFCFFF", "#EED0D0FF", "#EED2D2FF", "#EED4D4FF", "#EED5D5FF", "#EED7D7FF", "#EED9D9FF", "#EEDBDBFF", "#EEDCDCFF", "#EEDEDEFF", "#EEE0E0FF", "#EEE1E1FF", "#EEE3E3FF", "#EEE5E5FF", "#EEE7E7FF", "#EEE8E8FF", "#EEEAEAFF", "#EEECECFF", "#EEEEEEFF")
edgeCol  =  c("#474747FF", "#494949FF", "#4B4B4BFF", "#4D4D4DFF", "#4F4F4FFF", "#515151FF", "#535353FF", "#555555FF", "#575757FF", "#595959FF", "#5B5B5BFF", "#5E5E5EFF", "#606060FF", "#626262FF", "#646464FF", "#666666FF", "#686868FF", "#6A6A6AFF", "#6C6C6CFF", "#6E6E6EFF", "#707070FF", "#727272FF", "#747474FF", "#767676FF", "#787878FF", "#7A7A7AFF", "#7C7C7CFF", "#7E7E7EFF", "#808080FF", "#828282FF", "#848484FF", "#868686FF", "#888888FF", "#8A8A8AFF", "#8C8C8CFF", "#8D8D8DFF", "#8F8F8FFF", "#919191FF", "#939393FF",  "#959595FF", "#979797FF", "#999999FF", "#9A9A9AFF", "#9C9C9CFF", "#9E9E9EFF", "#A0A0A0FF", "#A2A2A2FF", "#A3A3A3FF", "#A5A5A5FF", "#A7A7A7FF", "#A9A9A9FF", "#AAAAAAFF", "#ACACACFF", "#AEAEAEFF", "#AFAFAFFF", "#B1B1B1FF", "#B3B3B3FF", "#B4B4B4FF", "#B6B6B6FF", "#B7B7B7FF", "#B9B9B9FF", "#BBBBBBFF", "#BCBCBCFF", "#BEBEBEFF", "#BFBFBFFF", "#C1C1C1FF", "#C2C2C2FF", "#C3C3C4FF", "#C5C5C5FF", "#C6C6C6FF", "#C8C8C8FF", "#C9C9C9FF", "#CACACAFF", "#CCCCCCFF", "#CDCDCDFF", "#CECECEFF", "#CFCFCFFF", "#D1D1D1FF",  "#D2D2D2FF", "#D3D3D3FF", "#D4D4D4FF", "#D5D5D5FF", "#D6D6D6FF", "#D7D7D7FF", "#D8D8D8FF", "#D9D9D9FF", "#DADADAFF", "#DBDBDBFF", "#DCDCDCFF", "#DDDDDDFF", "#DEDEDEFF", "#DEDEDEFF", "#DFDFDFFF", "#E0E0E0FF", "#E0E0E0FF", "#E1E1E1FF", "#E1E1E1FF", "#E2E2E2FF", "#E2E2E2FF", "#E2E2E2FF")
alpha    =  0.5
cex  =  1
itemLabels   =  TRUE
labelCol     =  #000000B3
measureLabels    =  FALSE
precision    =  3
layout   =  NULL
layoutParams     =  list()
arrowSize    =  0.5
engine   =  igraph
plot     =  TRUE
plot_options     =  list()
max  =  100
verbose  =  FALSE

ig_df <- get.data.frame(ig, what = "both" )

visNetwork(
  nodes = data.frame(
    id = ig_df$vertices$name,
    value = ig_df$vertices$lift, # lift, confidence, support
    title = ifelse(ig_df$vertices$label == "",ig_df$vertices$name, ig_df$vertices$label),
    ig_df$vertices),
  edges = ig_df$edges) %>% 
    visNodes(size = 10) %>%
    visLegend() %>%
    visEdges(smooth = FALSE) %>%
    visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE) %>%
    visInteraction(navigationButtons = TRUE) %>%
    visEdges(arrows = 'from') %>%
    visPhysics(
      solver = "barnesHut",
      maxVelocity = 35,
      forceAtlas2Based = list(gravitationalConstant = -6000))