Product：產品銷售資訊

Sys.setlocale("LC_ALL","C")

[1] "C"

packages = c(
  "dplyr","ggplot2","googleVis","devtools","magrittr","slam","irlba","plotly",
  "arules","arulesViz","Matrix","recommenderlab")
existing = as.character(installed.packages()[,1])
for(pkg in packages[!(packages %in% existing)]) install.packages(pkg)

rm(list=ls(all=TRUE))
LOAD = FALSE
library(dplyr)
library(ggplot2)
library(googleVis)
library(Matrix)
library(slam)
library(irlba)
library(plotly)
library(arules)
library(arulesViz)
library(recommenderlab)

---

A. RFM分群

load("data/tf0.rdata")
A = A0; X = X0; Z = Z0; rm(A0,X0,Z0); gc()

           used  (Mb) gc trigger  (Mb)  max used (Mb)
Ncells  3202619 171.1    9601876 512.8  12002346  641
Vcells 12994267  99.2   93476238 713.2 228211284 1741

#Z總交易紀錄
#X單筆交易紀錄彙整
#A會員交易紀錄

k = 8; set.seed(777)
A$group = kmeans(scale(A[,2:6]), k)$cluster; table(A$group)

   1    2    3    4    5    6    7    8 
2371 2825 6789 4252 9758  317 4300 1629 

執行意涵

• 對A的2~6欄的資料做標準化並分群
• K=8 共分八群

df = group_by(A, group) %>% summarise( 
  avg_frequency = mean(f),   #平均頻率
  avg_monetary = mean(m),    #平均單筆購買
  total_revenue = sum(rev),  #總收入
  group_size = n(),          #群內個數
  avg_recency = mean(r),     #平均的最近來店天數
  profit = sum(raw)          #總成本
  ) %>% ungroup %>% 
  mutate(  
    pc_revenue = round(100*total_revenue/sum(total_revenue),1), 
    pc_profit = round(100*profit/sum(profit),1),                
    dummy = 2001  
  ) %>% data.frame

執行意涵

• 將資料依照group做資料統整
• 額外增加欄位
  1.pc_revenue:每一群revenue佔總體的%數
  2.pc_profit:每一群profit佔總體的%數
  3.dummy:googleViz的資料格式
  

head(df)

plot( gvisMotionChart(
  df, "group", "dummy",
  options=list(width=800, height=600) 
  ))

執行意涵

• 將資料畫為可操縱的動圖
  

【QUIZ】 如果我們把X，Y軸分別改成log(avg_monetary)和log(avg_recency)，根據圖上的顯示 …

• 你認為這家店目前最需要對那一個族群？做哪一個動作？為什麼?

• 我們所期望的顧客，應該是常常來且平均單筆消費要高的顧客，所以在這張圖中，越往右下會是我們的金雞母型顧客，反之位於左上的顧客是屬於我們的沉睡顧客

• 我們認為該對紅色的族群做出行銷、促銷的動作，由於這個族群位於偏左中的部分，以購買的頻率來講，位於中游，消費金額則有很大的進步空間，屬於我們的潛在顧客，重點是族群的數量龐大，若是以這類族群的特性做出相應的行銷手法，能直面到更多的顧客，以商家的角度來思考的話，這樣的選擇CP值會是最高的

---

B. 顧客產品矩陣

n_distinct(Z$cust)  # 32256

[1] 32256

n_distinct(Z$prod)  # 23789

[1] 23789

操作矩陣運算之前，通常我會載入這兩個套件

library(Matrix)
library(slam)

製作顧客產品矩陣其實很快、也很容易

mx = xtabs(~ cust + prod, Z, sparse=T)

顧客產品矩陣通常是一個很稀疏的矩陣

mean(mx > 0)

[1] 0.000968

執行意涵

• 矩陣密度，可以知道矩陣中有多少欄位是屬於零

有一些產品沒什麼人買

table(colSums(mx) < 10)       # 曾經被買過小於10次的商品 

FALSE  TRUE 
11201 12588 

刪去購買次數小於10的產品，然後刪去沒有購買產品的顧客

mx = mx[, colSums(mx) > 10]   

執行意涵

• 刪去小於10次購買次數的商品
• 留下購買次數大於0的會員
• 資料數：32256>32066 23789>10675
• 矩陣縮減了許多

檢查一下矩陣裡面的值分布

max(mx)                       

[1] 49

table(mx@x) %>% prop.table %>% round(4) %>% head(10)

     1      2      3      4      5      6      7      8      9     10 
0.9235 0.0594 0.0112 0.0033 0.0013 0.0006 0.0003 0.0002 0.0001 0.0001 

#取mx裡的x     #佔全部的幾%    #小數點四位  #前十名

執行意涵

• max(mx):被購買過最多次的商品有幾次
• table(mx@x):取mx中的x做成表格
• prop.table:每個商品佔x其中的多少%
• 找出篩選後的商品裡，購買次數最多的前十名

【QUIZ】 如果mx[i, j] = 3，這表示 ….

• \(Customer_i\)總共買\(Prodict_j\)買了三次
• mx是由z取出，i代表的是cust,j代表的是prod，故mx[i,j]=3表示，顧客i購買了商品j三次

---

C. 依購買頻率分群

C1. 改變(稀疏)矩陣格式

稀疏矩陣有很多種格式，不同的工具會使用不同的格式

library(slam)
tmx = as(mx,"dgTMatrix")
tmx = simple_triplet_matrix(
  1+tmx@i, 1+tmx@j, tmx@x, dimnames=mx@Dimnames)  
dim(tmx)

[1] 32256 10675

執行意涵

• simple_triplet_matrix(i,j,v,dimnames):
  1.i:行
  2.j:列
  3.v:向量值
  4.dimnames:矩陣的屬性(此處為cust、prod)
• 稀疏矩陣多元的格式，因應使用工具而有所不同

C2. 估計各產品的平均重要性 (Average TF-IDF Scores)

我們借用文字分析裡面估計單字在文章之中的重要性的方法(TF-IDF)，計算各產品在所有顧客之間的平均重要性

tfidf = tapply(tmx$v/row_sums(tmx)[tmx$i], tmx$j, mean) *
  log2(nrow(tmx)/col_sums(tmx > 0))
summary(tfidf)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  0.137   0.313   0.388   0.444   0.507   4.472 

執行意涵

• TF:詞頻，文字在文集中出現過的頻率
• IDF:逆向文件頻率，這個詞在所有文集中出現的頻率，若是太多，代表越不重要
• TFIDF:兩個參數權重算出的結果

hist(tfidf)

C3. 篩選產品、重新排列

篩去平均重要性比較低的產品、然後將產品依被購買次數降冪排列

tmx = tmx[, tfidf > mean(tfidf)]    # 將小於平均的去除
tmx = tmx[, order(-col_sums(tmx))]  # 降冪
                                    # 10675→3823
dim(tmx)

[1] 32256  3823

執行意涵

• 將tfidf小於平均的去除並降冪排列

C4. 依(購買頻率最高的)產品對顧客分群

nop= 400  # no. product
k = 200   # no. cluster
set.seed(111); kg = kmeans(tmx[,1:nop], k)$cluster
table(kg) %>% as.vector %>% sort

  [1]     1     1     1     1     1     1     1     1     1     1     1
 [12]     1     1     1     2     2     2     2     3     3     3     4
 [23]     5     5     5     6     6     6     6     6     7     7     7
 [34]     7     7     7     8     8     8     8     9     9     9     9
 [45]     9     9     9    10    10    10    11    12    12    12    13
 [56]    14    14    14    14    15    16    17    19    19    21    22
 [67]    23    24    25    26    27    29    30    32    33    34    34
 [78]    35    35    36    37    38    39    39    40    41    41    42
 [89]    43    43    44    44    45    45    46    46    47    48    48
[100]    48    49    50    51    51    51    52    52    54    55    55
[111]    56    56    56    57    57    57    57    58    60    60    62
[122]    62    62    62    63    64    64    65    65    67    67    68
[133]    69    69    70    72    72    72    72    72    73    73    73
[144]    73    74    74    75    75    76    78    79    79    79    80
[155]    80    81    82    86    88    88    88    89    90    93    93
[166]    93   106   106   107   110   111   112   120   123   126   128
[177]   131   136   137   138   140   141   142   143   147   148   149
[188]   153   165   169   181   182   187   193   212   258   422   494
[199]   554 20061

執行意涵

• 按照購買頻率由高到低排列，選擇四百個產品
• 對顧客做200群的分群

C5. 各群組平均屬性

將分群結果併入顧客資料框(A)

df = inner_join(A, data.frame(
  cust = as.integer(tmx$dimnames$cust), kg))

Joining, by = "cust"

執行意涵

• kg:群編號
• size:群內個數
• 將結果用inner_join依照cust併入資料集A

計算各群組的平均屬性

df = data.frame(
  aggregate(. ~ kg, df[,c(2:7,11)], mean),
  size = as.vector(table(kg))
  )
head(df)

C6. 互動式泡泡圖

df$dummy = 2001                        # dummy column for googleViz
plot( gvisMotionChart(
  subset(df[,c(1,4,5,6,8,2,3,7,9)], 
         size >= 20 & size <= 5000     # 將大於20小於5000的列出
         ), 
  "kg", "dummy", options=list(width=800, height=600) ) )

C7. 各群組的代表性產品 (Signature Product)

Sig = function(gx, P=1000, H=10) {
  print(sprintf("Group %d: No. Customers = %d", gx, sum(kg==gx)))
  bx = tmx[,1:P]
  data.frame(n = col_sums(bx[kg==gx,])) %>%      
    mutate(
      share = round(100*n/col_sums(bx),2),       
      conf = round(100*n/sum(kg==gx),2),         
      base = round(100*col_sums(bx)/nrow(bx),2), 
      lift = round(conf/base,1),       
      name = colnames(bx)
    ) %>% arrange(desc(lift)) %>% head(H)
  }

執行意涵

• p(1000):1~1000的產品
• n:消費個數總和
• share:這產品全部的幾%賣給這群人
• conf:這群人平均購買幾%這類產品
• base:所有人平均購買幾%這類產品
• lift:跟所有人比這類人多了幾%可能會購買這類產品
• 此函數可以找出群內較為顯著性、代表性的產品，最後依照lift由高排至低

Sig(1)

[1] "Group 1: No. Customers = 57"

#第一群
#57個顧客

• G族群一共買了n個P產品
• P產品有share%是賣給G族群
• G族群每人平均購買conf/100個P產品
• 所有顧客之中，每人平均購買base/100個P產品
• 跟所有顧客相比，G族群購買P產品的機率上升了lift-1倍

【QUIZ】 從互動式泡泡圖看來 …

• 平均客單價、平均購買次數、平均營收貢獻、平均獲利貢獻最大的分別是哪一個族群？它們的特徵產品分別是什麼？
• 平均客單價最大：第190群

Sig(190)

[1] "Group 190: No. Customers = 32"

• 平均購買次數最大：第186群

Sig(186)

[1] "Group 186: No. Customers = 51"

• 平均營收貢獻最大：第19群

Sig(19)

[1] "Group 19: No. Customers = 21"

• 平均獲利貢獻最大：第19群
• 獲利=營收-成本 觀察圖上的點後，得出答案為第19群

【QUIZ】 在以上這個段落裡面 …

• 我們分群的區隔變數是什麼？

• 各產品對每個顧客產生的距離矩陣

• 我們在泡泡圖裡面觀察的變數是哪一些？

• f、m、s、r、rev、raw、size

• 它們是相同的嗎？

• 不同

• 這個分析的程序，跟Airlines CRM那一個例子有甚麼不同？
• Airlines是分群完觀察每一群的長條圖，做出相應的分析

• 這個例子是分群完可以再使用泡泡圖，挑選出想觀察的變數，找出目標的群，然後再使用sig()這個函數，觀察到群內的個體

• 我們從這個例子學到什麼？

• 分完群後，可以再使用其他方法，找到群中最有影響力的個體，若是企業，則可以依照群內個體的特性，建立相應的行銷手法

---

D. 使用尺度縮減方法抽取顧客(產品)的特徵向量

D1. 巨大尺度縮減 (SVD, Sigular Value Decomposition)

library(irlba)
if(LOAD) {
  load("data/svd.rdata")
} else {
  smx = mx
  smx@x = pmin(smx@x, 2)            # cap at 2, similar to normalization  
  t0 = Sys.time()
  svd = irlba(smx, 
              nv=400,               # length of feature vector
              maxit=800, work=800)    
  print(Sys.time() - t0)            # 1.8795 mins
  save(svd, file = "data/svd.rdata")
}

Time difference of 1.835 mins

執行意涵

• pmin(2):超過2的都設為2
• irlba():
  1.nv:右邊向量要縮減成的數量
  2.nu:左邊向量要縮減成的數量(預設=nv)
  2.maxit:最大的迭代次數
  4.work:工作區的維度

D2. 依顧客向量對顧客分群

set.seed(111); kg = kmeans(svd$u, 200)$cluster
table(kg) %>% as.vector %>% sort

  [1]    1    1    1    1    1    1    1    1    1    1    1    1    1
 [14]    1    1    1    1    1    1    1    1    1    1    1    1    1
 [27]    1    1    1    1    1    1    1    1    1    1    1    1    1
 [40]    1    1    1    1    1    1    1    1    1    1    1    1    1
 [53]    1    1    2    2    2    2    3    3    3    4    4   15   20
 [66]   25   25   26   26   28   29   32   33   33   33   40   40   43
 [79]   44   50   52   52   53   54   55   56   57   59   63   64   70
 [92]   72   80   84   88   89   95  100  102  110  110  111  118  123
[105]  124  129  130  133  134  134  136  145  147  147  155  159  160
[118]  161  162  162  163  163  164  164  164  166  167  170  171  171
[131]  173  175  176  178  178  179  180  180  184  184  185  187  187
[144]  188  190  192  193  193  194  196  198  198  200  202  202  203
[157]  204  205  209  209  210  210  210  211  211  211  213  216  219
[170]  224  227  229  231  232  234  234  237  240  244  245  246  247
[183]  247  250  251  252  256  259  270  270  279  282  289  297  329
[196]  390  426  554  853 9280

D3. 互動式泡泡圖 (Google Motion Chart)

# clustster summary
df = left_join(A, data.frame(         
  cust = as.integer(smx@Dimnames$cust), kg)) %>% 
  group_by(kg) %>% summarise(
    avg_frequency = mean(f),
    avg_monetary = mean(m),
    avg_revenue_contr = mean(rev),
    group_size = n(),
    avg_recency = mean(r),
    avg_gross_profit = mean(raw)) %>% 
  ungroup %>% 
  mutate(dummy = 2001, kg = sprintf("G%03d",kg)) %>% 
  data.frame

Joining, by = "cust"

# Google Motion Chart
plot( gvisMotionChart(
  subset(df, group_size >= 20 & group_size <= 5000),     
  "kg", "dummy", options=list(width=800, height=600) ) )

D4. 互動式泡泡圖 (ggplot + plotly)

filter(df, group_size >= 20 & group_size <= 5000)$group_size %>% 
  sqrt %>% range    # for bubble size adjustment

[1]  4.472 29.206

library(ggplot2)
library(plotly)
p = df %>% filter(group_size >= 20 & group_size <= 5000) %>% 
  ggplot(aes(x=avg_frequency, y=avg_monetary)) +
  geom_point(aes(size=group_size, col=avg_revenue_contr),alpha=0.7) +
  geom_text(aes(label=kg), alpha=0) +
  scale_size(range=c(1.5,12)) +
  #scale_color_gradient(low="green",high="magenta") +
  scale_colour_gradientn(
    colours = rev(c("red","yellow","green","lightblue","darkblue"))) +
  theme_bw() + guides(size=F) + labs(
    title="顧客集群(依購買產品)",
    color="平均營收貢獻", size="集群人數") +
  xlab("平均購買次數") + 
  ylab("平均購買金額")
plotly_build(p)

D5. 群組的代表性產品 (Signature Product)

Sig(138)

[1] "Group 138: No. Customers = 52"

---

E. 購物籃分析 Baskets Analysis

dim(mx)   # 32066 cust * 10675 prod

[1] 32256 10675

E1. 準備資料 (for Association Rule Analysis)

library(arules)
library(arulesViz)
bx = subset(Z, prod %in% as.numeric(colnames(mx)), 
            select=c("cust","prod"))  # 只選產品及顧客
bx = split(bx$prod, bx$cust)          # 分割
bx = as(bx, "transactions")           # data for arules package

removing duplicated items in transactions

執行意涵

• 從z選出在mx裡的cust、prod
• 然後將其分割

E2. Top20 熱賣產品

itemFrequencyPlot(bx, topN=20, type="absolute", cex=0.8)

#top20

E3. 關聯規則和Apriori演算法

關聯規則(A => B)

• support: A被購買的機率 (A的基礎機率)
• confidence: A被購買時，B被購買的機率
• lift: A被購買時，B被購買的機率增加的倍數 (與B的基礎機率相比)
• 一般來講support、confidence和lift越高的關聯規則越重要
• support、confidence和lift設的越低(高)，找到的關聯規則越多(少)
• 建議一開始把標準設低，先找到多一點規則，之後再用subset篩選出特定的規則來看

rules = apriori(bx, parameter=list(supp=0.005, conf=0.6))

Apriori

Parameter specification:
 confidence minval smax arem  aval originalSupport maxtime support
        0.6    0.1    1 none FALSE            TRUE       5   0.005
 minlen maxlen target   ext
      1     10  rules FALSE

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

Absolute minimum support count: 160 

set item appearances ...[0 item(s)] done [0.00s].
set transactions ...[10675 item(s), 32066 transaction(s)] done [0.16s].
sorting and recoding items ... [884 item(s)] done [0.01s].
creating transaction tree ... done [0.02s].
checking subsets of size 1 2 3 4 done [0.04s].
writing ... [67 rule(s)] done [0.00s].
creating S4 object  ... done [0.12s].

summary(rules)

set of 67 rules

rule length distribution (lhs + rhs):sizes
 2  3  4 
16 43  8 

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   2.00    3.00    3.00    2.88    3.00    4.00 

summary of quality measures:
    support          confidence         lift          count    
 Min.   :0.00505   Min.   :0.602   Min.   : 3.2   Min.   :162  
 1st Qu.:0.00558   1st Qu.:0.635   1st Qu.:16.8   1st Qu.:179  
 Median :0.00639   Median :0.676   Median :21.1   Median :205  
 Mean   :0.00786   Mean   :0.700   Mean   :22.5   Mean   :252  
 3rd Qu.:0.00957   3rd Qu.:0.751   3rd Qu.:28.0   3rd Qu.:307  
 Max.   :0.01909   Max.   :0.871   Max.   :70.6   Max.   :612  

mining info:
 data ntransactions support confidence
   bx         32066   0.005        0.6

E4. 檢視關聯規則

關聯規則 (A => B)：

• support: A被購買的機率 (A的基礎機率)
• confidence: A被購買時，B被購買的機率
• lift: A被購買時，B被購買的機率增加的倍數 (與B的基礎機率相比)

options(digits=4)
inspect(rules)

     lhs                rhs              support confidence   lift count
[1]  {4710030346103} => {4710030346059} 0.005146     0.6762 70.632   165
[2]  {4719090701051} => {4719090790000} 0.005520     0.6367 39.111   177
[3]  {719859796124}  => {719859796117}  0.007297     0.7222 45.859   234
[4]  {4710321861209} => {4710321861186} 0.007017     0.6338 41.392   225
[5]  {4711524000891} => {4711524001041} 0.005832     0.6561 63.564   187
[6]  {4719090790017} => {4719090790000} 0.010510     0.8300 50.989   337
[7]  {4719090790000} => {4719090790017} 0.010510     0.6456 50.989   337
[8]  {4710011401142} => {4710011401128} 0.007765     0.6434 16.679   249
[9]  {4710085120697} => {4710085120680} 0.012537     0.7992 30.691   402
[10] {4710085120710} => {4710085120703} 0.010416     0.6243 29.790   334
[11] {4710011402026} => {4710011402019} 0.010073     0.7210 29.376   323
[12] {4710085172702} => {4710085172696} 0.009543     0.6120 21.354   306
[13] {4710011409056} => {4710011401128} 0.014813     0.7353 19.061   475
[14] {4710011401135} => {4710011401128} 0.019086     0.7897 20.470   612
[15] {4710011405133} => {4710011401128} 0.016840     0.6968 18.062   540
[16] {4710011406123} => {4710011401128} 0.015624     0.6358 16.481   501
[17] {4714981010038,                                                    
      4719090790017} => {4719090790000} 0.005489     0.8263 50.758   176
[18] {4714981010038,                                                    
      4719090790000} => {4719090790017} 0.005489     0.6692 52.854   176
[19] {4710011401135,                                                    
      4710011401142} => {4710011401128} 0.005114     0.7700 19.959   164
[20] {4710011401128,                                                    
      4710011401142} => {4710011401135} 0.005114     0.6586 27.251   164
[21] {4710085120697,                                                    
      4714981010038} => {4710085120680} 0.005395     0.8047 30.901   173
[22] {4710060000099,                                                    
      4711271000014} => {4714981010038} 0.005613     0.6667  3.548   180
[23] {4710085120093,                                                    
      4710085172702} => {4710085172696} 0.005551     0.7206 25.145   178
[24] {4710085120093,                                                    
      4710085172702} => {4710085120628} 0.005052     0.6559 17.778   162
[25] {4710085172696,                                                    
      4710085172702} => {4710085120628} 0.006112     0.6405 17.362   196
[26] {4710085120628,                                                    
      4710085172702} => {4710085172696} 0.006112     0.6712 23.421   196
[27] {4710311703014,                                                    
      4714981010038} => {4711271000014} 0.005863     0.6045  3.702   188
[28] {4710683100015,                                                    
      4714981010038} => {4711271000014} 0.006393     0.6949  4.256   205
[29] {4710088620156,                                                    
      4714981010038} => {4711271000014} 0.005645     0.6177  3.783   181
[30] {4710063031106,                                                    
      4711271000014} => {4714981010038} 0.007984     0.6139  3.267   256
[31] {4710685440362,                                                    
      4714981010038} => {4711271000014} 0.005520     0.6254  3.830   177
[32] {4711022100017,                                                    
      4711271000014} => {4714981010038} 0.005364     0.6277  3.340   172
[33] {4710011401135,                                                    
      4710011409056} => {4710011405133} 0.007266     0.6132 25.370   233
[34] {4710011405133,                                                    
      4710011409056} => {4710011401135} 0.007266     0.6833 28.271   233
[35] {4710011406123,                                                    
      4710011409056} => {4710011401135} 0.006144     0.6611 27.352   197
[36] {4710011401135,                                                    
      4710011409056} => {4710011401128} 0.009917     0.8368 21.693   318
[37] {4710011401128,                                                    
      4710011409056} => {4710011401135} 0.009917     0.6695 27.700   318
[38] {4710011406123,                                                    
      4710011409056} => {4710011405133} 0.005676     0.6107 25.270   182
[39] {4710011405133,                                                    
      4710011409056} => {4710011401128} 0.008389     0.7889 20.449   269
[40] {4710011406123,                                                    
      4710011409056} => {4710011401128} 0.007391     0.7953 20.616   237
[41] {4710011409056,                                                    
      4714981010038} => {4710011401128} 0.005707     0.7409 19.206   183
[42] {4711271000014,                                                    
      4714381003128} => {4714981010038} 0.006362     0.6296  3.350   204
[43] {4710085120093,                                                    
      4710085172696} => {4710085120628} 0.008545     0.6241 16.918   274
[44] {4710011401135,                                                    
      4710011405133} => {4710011401128} 0.010634     0.8158 21.147   341
[45] {4710011401128,                                                    
      4710011405133} => {4710011401135} 0.010634     0.6315 26.128   341
[46] {4710011401135,                                                    
      4710011406123} => {4710011401128} 0.009013     0.8353 21.652   289
[47] {4710011401135,                                                    
      4711271000014} => {4710011401128} 0.005801     0.7782 20.174   186
[48] {4710011401135,                                                    
      4714981010038} => {4710011401128} 0.007048     0.7958 20.628   226
[49] {4710011405133,                                                    
      4710011406123} => {4710011401128} 0.008015     0.7449 19.310   257
[50] {4710011405133,                                                    
      4711271000014} => {4710011401128} 0.005426     0.7468 19.358   174
[51] {4710011405133,                                                    
      4714981010038} => {4710011401128} 0.006674     0.7086 18.369   214
[52] {4710011406123,                                                    
      4714981010038} => {4710011401128} 0.006674     0.6751 17.500   214
[53] {4710421090059,                                                    
      4714981010038} => {4711271000014} 0.009605     0.6299  3.857   308
[54] {4710583996008,                                                    
      4719090900065} => {4714981010038} 0.006019     0.6942  3.694   193
[55] {4710265849066,                                                    
      4719090900065} => {4714981010038} 0.009200     0.6020  3.204   295
[56] {4710265849066,                                                    
      4711271000014} => {4714981010038} 0.011539     0.6390  3.400   370
[57] {4713985863121,                                                    
      4719090900065} => {4714981010038} 0.005894     0.7269  3.868   189
[58] {4711271000014,                                                    
      4713985863121} => {4714981010038} 0.010728     0.6922  3.683   344
[59] {4711271000014,                                                    
      4719090900065} => {4714981010038} 0.014533     0.6099  3.246   466
[60] {4710011401135,                                                    
      4710011405133,                                                    
      4710011409056} => {4710011401128} 0.006331     0.8712 22.585   203
[61] {4710011401128,                                                    
      4710011401135,                                                    
      4710011409056} => {4710011405133} 0.006331     0.6384 26.413   203
[62] {4710011401128,                                                    
      4710011405133,                                                    
      4710011409056} => {4710011401135} 0.006331     0.7546 31.224   203
[63] {4710011401135,                                                    
      4710011406123,                                                    
      4710011409056} => {4710011401128} 0.005333     0.8680 22.501   171
[64] {4710011401128,                                                    
      4710011406123,                                                    
      4710011409056} => {4710011401135} 0.005333     0.7215 29.853   171
[65] {4710011401135,                                                    
      4710011405133,                                                    
      4710011406123} => {4710011401128} 0.005520     0.8634 22.382   177
[66] {4710011401128,                                                    
      4710011401135,                                                    
      4710011406123} => {4710011405133} 0.005520     0.6125 25.341   177
[67] {4710011401128,                                                    
      4710011405133,                                                    
      4710011406123} => {4710011401135} 0.005520     0.6887 28.496   177

# install.packages(
#   "https://cran.r-project.org/bin/windows/contrib/3.5/arulesViz_1.3-1.zip",
#   repos=NULL)
# install.packages("arulesViz_1.3-1.zip", repos=NULL)
# library(plotly)
# plotly_arules(rules,colors=c("red","green"),
#               marker=list(opacity=.6,size=10))
# plotly_arules(rules,method="matrix",
#               shading="lift",
#               colors=c("red", "green"))
# 

E5. 互動圖表顯示

plot(rules,colors=c("red","green"),engine="htmlwidget",
     marker=list(opacity=.6,size=8))

plot(rules,method="matrix",shading="lift",engine="htmlwidget",
     colors=c("red", "green"))

執行意涵

• LHS:左手邊，可視為關聯規則中A=>的A
• RHS:右手邊，可視為B
• 圖中的連續區段顯示，不只一種A對應到B，可能為A1=>B,{A1,A2}=>B

E6. 篩選產品、互動式關聯圖

r1 = subset(rules, subset = rhs %in% c("4719090790000"))
summary(r1)

set of 3 rules

rule length distribution (lhs + rhs):sizes
2 3 
2 1 

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   2.00    2.00    2.00    2.33    2.50    3.00 

summary of quality measures:
    support          confidence         lift          count    
 Min.   :0.00549   Min.   :0.637   Min.   :39.1   Min.   :176  
 1st Qu.:0.00550   1st Qu.:0.732   1st Qu.:44.9   1st Qu.:176  
 Median :0.00552   Median :0.826   Median :50.8   Median :177  
 Mean   :0.00717   Mean   :0.764   Mean   :47.0   Mean   :230  
 3rd Qu.:0.00801   3rd Qu.:0.828   3rd Qu.:50.9   3rd Qu.:257  
 Max.   :0.01051   Max.   :0.830   Max.   :51.0   Max.   :337  

mining info:
 data ntransactions support confidence
   bx         32066   0.005        0.6

plot(r1,method="graph",engine="htmlwidget",itemCol="cyan") 

• 泡泡大小：support: A被購買的機率 (A的基礎機率)
• 泡泡顏色：lift: A被購買時，B被購買的機率增加的倍數 (與B的基礎機率相比)

r2 = subset(rules, subset = rhs %in% c("4710011401135"))
summary(r2)

set of 8 rules

rule length distribution (lhs + rhs):sizes
3 4 
5 3 

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   3.00    3.00    3.00    3.38    4.00    4.00 

summary of quality measures:
    support          confidence         lift          count    
 Min.   :0.00511   Min.   :0.631   Min.   :26.1   Min.   :164  
 1st Qu.:0.00547   1st Qu.:0.660   1st Qu.:27.3   1st Qu.:176  
 Median :0.00624   Median :0.676   Median :28.0   Median :200  
 Mean   :0.00703   Mean   :0.684   Mean   :28.3   Mean   :226  
 3rd Qu.:0.00793   3rd Qu.:0.697   3rd Qu.:28.8   3rd Qu.:254  
 Max.   :0.01063   Max.   :0.755   Max.   :31.2   Max.   :341  

mining info:
 data ntransactions support confidence
   bx         32066   0.005        0.6

plot(r2,method="graph",engine="htmlwidget",itemCol="cyan") 

---

F. 產品推薦 Product Recommendation

F1. 篩選顧客、產品

太少被購買的產品和購買太少產品的顧客都不適合使用Collaborative Filtering這種產品推薦方法，所以我們先對顧客和產品做一次篩選

library(recommenderlab)
rx = mx[, colSums(mx > 0) >= 50]      #篩出大於五十次購買的商品
rx = rx[rowSums(rx > 0) >= 20 & rowSums(rx > 0) <= 300, ] #篩出購買超過二十次小於三百次的顧客
dim(rx)

[1] 8860 3355

F2. 選擇產品評分方式

可以選擇要用

• 購買次數 (realRatingMatrix)→量化
• 是否購買 (binaryRatingMatrix)→二分法

做模型。

rx = as(rx, "realRatingMatrix")  # realRatingMatrix
bx = binarize(rx, minRating=1)   # binaryRatingMatrix
dim(bx)

[1] 8860 3355

F3. 設定模型(準確性)驗證方式

set.seed(4321)
scheme = evaluationScheme(     
  bx, method="split", train = .75,  given=5)

F4. 設定推薦方法(參數)

algorithms = list(            
  AR53 = list(name="AR", param=list(support=0.0005, confidence=0.3)),
  AR43 = list(name="AR", param=list(support=0.0004, confidence=0.3)),
  RANDOM = list(name="RANDOM", param=NULL),
  POPULAR = list(name="POPULAR", param=NULL),
  UBCF = list(name="UBCF", param=NULL),
  IBCF = list(name="IBCF", param=NULL) )

F5. 建模、預測、驗證(準確性)

if(LOAD) {
  load("results.rdata")
} else {
  t0 = Sys.time()
  results = evaluate(            
    scheme, algorithms, type="topNList",
    n=c(5, 10, 15, 20))
  print(Sys.time() - t0)
  save(results, file="results.rdata")
}

AR run fold/sample [model time/prediction time]
     1  [3.82sec/163.4sec] 
AR run fold/sample [model time/prediction time]
     1  [7.82sec/399.2sec] 
RANDOM run fold/sample [model time/prediction time]
     1  [0sec/9.89sec] 
POPULAR run fold/sample [model time/prediction time]
     1  [0sec/8.23sec] 
UBCF run fold/sample [model time/prediction time]
     1  [0sec/58.55sec] 
IBCF run fold/sample [model time/prediction time]
     1  [152.2sec/1.46sec] 
Time difference of 13.8 mins

F6. 模型準確性比較

# load("data/results.rdata")
par(mar=c(4,4,3,2),cex=0.8)
cols = c("red", "magenta", "gray", "orange", "blue", "green")
plot(results, annotate=c(1,3), legend="topleft", pch=19, lwd=2, col=cols)
abline(v=seq(0,0.006,0.001), h=seq(0,0.08,0.01), col='lightgray', lty=2)

F7. 儲存產品推薦模型

save(results, file="data/results.rdata")

---