CVM：顧客價值管理

前言：從交易記錄到顧客價值

善用商業數據分析的工具和技巧，光靠一份最簡單的交易紀錄(只有顧客ID、交易日期和交易金額三個欄位)，我們就可以做一系列很深入、很有價值的顧客價值分析和行銷策略規劃，包括：

• 交易記錄分析：
  • 敘述統計
  • 趨勢、交叉分析
  • 資料視覺化
• 顧客群組與標籤：
  • 集群分析
  • 群組屬性分析
  • 組間流動機率
  • 顧客(個人)流動機率

圖一、顧客價值管理的層次

從這一些分析我們可以看到公司主要的營收和獲利的重要來源，我們也可以看到這一些產生獲利的群組是不是有成長或者衰退的趨勢；據此我們可以設定行銷的重點，決定行銷的策略，和規劃行銷的工具。除了上述的敘述統計、集群分析、和資料視覺化之外，我們還可以利用這些簡單的交易紀錄：

• 建立預測性模型，預測每一位顧客的：
  • 保留機率
  • 預期營收
  • 組間變換機率
  • 下次可能購買時間

利用這一些預測我們就可以進行全面客製化的：

• 顧客價值管理：
  • 顧客終生價值
  • 顧客吸收策略
  • 顧客發展策略
  • 顧客保留策略
• 針對性行銷：
  • 設計行銷方案
  • 選擇行銷方案
  • 選擇行銷對象

圖二、顧客價值管理流程

---

Setup

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

[1] "C"

packages = c(
  "dplyr","ggplot2","googleVis","devtools","magrittr","caTools","ROCR","caTools")
existing = as.character(installed.packages()[,1])
for(pkg in packages[!(packages %in% existing)]) install.packages(pkg)
if(!is.element("chorddiag", existing))
  devtools::install_github("mattflor/chorddiag")

Library

rm(list=ls(all=T))
options(digits=4, scipen=12)
library(dplyr)
library(ggplot2)
library(caTools)
library(ROCR)
library(googleVis)
library(chorddiag)

---

1 1. 資料整理

1.1 交易資料 (X)

X = read.table(
  'purchases.txt', header=FALSE, sep='\t', stringsAsFactors=F)
names(X) = c('cid','amount','date')
X$date = as.Date(X$date)
summary(X)                  

      cid             amount          date           
 Min.   :    10   Min.   :   5   Min.   :2005-01-02  
 1st Qu.: 57720   1st Qu.:  25   1st Qu.:2009-01-17  
 Median :102440   Median :  30   Median :2011-11-23  
 Mean   :108935   Mean   :  62   Mean   :2011-07-14  
 3rd Qu.:160525   3rd Qu.:  60   3rd Qu.:2013-12-29  
 Max.   :264200   Max.   :4500   Max.   :2015-12-31  

# 交易次數 51243

par(cex=0.8)
hist(X$date, "years", las=2, freq=T, xlab="", main="No. Transaction by Year")

# 從圖中可看出交易逐年成長，但有放緩的趨勢

n_distinct(X$cid)           

[1] 18417

# 顧客數 18417

1.2 顧客資料 (A)

A = X %>% 
  mutate(days = as.integer(as.Date("2016-01-01") - date)) %>% 
  group_by(cid) %>% summarise(
    recent = min(days),    
    freq = n(),             
    money = mean(amount),   
    senior = max(days),     
    since = min(date)       
  ) %>% data.frame
# recent : 最近購買距今天數(整筆資料最後一天加一) 
# freq : 購買次數
# money : 平均購買金額
# senior : 第一次購買距今天數
# since : 第一次購買日期

1.4 顧客資料摘要

summary(A)

      cid             recent          freq           money          senior    
 Min.   :    10   Min.   :   1   Min.   : 1.00   Min.   :   5   Min.   :   1  
 1st Qu.: 81990   1st Qu.: 244   1st Qu.: 1.00   1st Qu.:  22   1st Qu.: 988  
 Median :136430   Median :1070   Median : 2.00   Median :  30   Median :2087  
 Mean   :137574   Mean   :1253   Mean   : 2.78   Mean   :  58   Mean   :1984  
 3rd Qu.:195100   3rd Qu.:2130   3rd Qu.: 3.00   3rd Qu.:  50   3rd Qu.:2992  
 Max.   :264200   Max.   :4014   Max.   :45.00   Max.   :4500   Max.   :4016  
     since           
 Min.   :2005-01-02  
 1st Qu.:2007-10-23  
 Median :2010-04-15  
 Mean   :2010-07-26  
 3rd Qu.:2013-04-18  
 Max.   :2015-12-31  

1.5 變數的分布狀況

p0 = par(cex=0.8, mfrow=c(2,2), mar=c(3,3,4,2))
hist(A$recent,20,main="recency",ylab="",xlab="")
hist(pmin(A$freq, 10),0:10,main="frequency",ylab="",xlab="")  

hist(A$senior,20,main="seniority",ylab="",xlab="")
hist(log(A$money,10),,main="log(money)",ylab="",xlab="")

# pmin() 設一個上限
# recency : 最近購買距今天數最左側看似許多顧客才剛來，但卻有一條長尾，表示更多的多顧客很久未光顧了
# frequency : 購買次數在十年的時間內亦表現不佳
# money : 平均購買金額小額居多
# seniority : 第一次購買距今天數可看出依然有許多新顧客持續加入

---

2. 層級式集群分析

2.1 RFM顧客分群

set.seed(111)
A$grp = kmeans(scale(A[,2:4]),10)$cluster  
table(A$grp)  

   1    2    3    4    5    6    7    8    9   10 
1073 2266 1296 2237 3207 1942 1781 2392 2096  127 

# 分成十群，先看族群大小

2.2 顧客群組屬性

group_by(A, grp) %>% summarise(
  recent=mean(recent), 
  freq=mean(freq), 
  money=mean(money), 
  size=n() ) %>% 
  mutate( revenue = size*money/1000 )  %>% 
  filter(size > 1) %>% 
  ggplot(aes(x=freq, y=money)) +
  geom_point(aes(size=revenue, col=recent),alpha=0.5) +
  scale_size(range=c(4,30)) +
  scale_color_gradient(low="green",high="red") +
  scale_x_log10() + scale_y_log10(limits=c(30,3000)) + 
  geom_text(aes(label = size ),size=3) +          
  theme_bw() + guides(size=F) +                   
  labs(title="Customer Segements",                
       subtitle="(bubble_size:revenue_contribution; text:group_size)",
       color="Recency") +
  xlab("Frequency (log)") + ylab("Average Transaction Amount (log)")

# 泡泡大小是營收貢獻
# 不光要知道靜態屬性，要知道泡泡怎麼變化，很重要
# 若用每年年底做一次，泡泡會動，但統計規則可能每年都不一樣(Kmean)

---

3. 規則分群

3.1 顧客分群規則

STS = c("N1","N2","R1","R2","S1","S2","S3")
Status = function(rx,fx,mx,sx,K) {factor(
  ifelse(sx < 2*K,
         ifelse(fx*mx > 50, "N2", "N1"),
         ifelse(rx < 2*K,
                ifelse(sx/fx < 0.75*K,"R2","R1"),
                ifelse(rx < 3*K,"S1",
                       ifelse(rx < 4*K,"S2","S3")))), STS)}

圖三、顧客分群規則

3.2 平均購買週期

K = as.integer(sum(A$senior[A$freq>1]) / sum(A$freq[A$freq>1])); K

[1] 521

回購顧客的平均購買週期 K = 521 days

3.3 滑動資料窗格

Y = list()              # 建立一個空的LIST
for(y in 2010:2015) {   # 每年年底將顧客資料彙整成一個資料框
  D = as.Date(paste0(c(y, y-1),"-12-31")) # 當期、前期的期末日期 
  Y[[paste0("Y",y)]] = X %>%        # 從交易資料做起
    filter(date <= D[1]) %>%        # 將資料切齊到期末日期
    mutate(days = 1 + as.integer(D[1] - date)) %>%   # 交易距期末天數
    group_by(cid) %>% summarise(    # 依顧客彙總 ...
      recent = min(days),           #   最後一次購買距期末天數   
      freq = n(),                   #   購買次數 (至期末為止)   
      money = mean(amount),         #   平均購買金額 (至期末為止)
      senior = max(days),           #   第一次購買距期末天數
      status = Status(recent,freq,money,senior,K),  # 期末狀態
      since = min(date),                      # 第一次購買日期
      y_freq = sum(date > D[2]),              # 當期購買次數
      y_revenue = sum(amount[date > D[2]])    # 當期購買金額
    ) %>% data.frame }

head(Y$Y2015)  

# list每個元件都可以有名字

3.4 每年年底的累計顧客人數

sapply(Y, nrow)  

Y2010 Y2011 Y2012 Y2013 Y2014 Y2015 
10407 11674 13562 15468 16905 18417 

# 資料框的資料筆數，對Y裡的每個元素做nrow

3.5 族群大小變化趨勢

cols = c("gold","orange","blue","green","pink","magenta","darkred")
sapply(Y, function(df) table(df$status)) %>% barplot(col=cols)
legend("topleft",rev(STS),fill=rev(cols))  

#活躍顧客，看粉色以下

3.6 族群屬性動態分析

CustSegments = do.call(rbind, lapply(Y, function(d) {
  group_by(d, status) %>% summarise(
    average_frequency = mean(freq),
    average_amount = mean(money),
    total_revenue = sum(y_revenue),
    total_no_orders = sum(y_freq),
    average_recency = mean(recent),
    average_seniority = mean(senior),
    group_size = n()
  )})) %>% ungroup %>% 
  mutate(year=rep(2010:2015, each=7)) %>% data.frame
head(CustSegments)

# R2族群最大、頻率最高，雖然創造的利潤不是最高但平均購買金額最高

plot( gvisMotionChart(
  CustSegments, "status", "year",
  options=list(width=900, height=600) ) )
# N1 相當停滯，族群有些微減少
# N2 頻率未增加反下降，平均購買金額顯著提升，族群大小持平
# R1 頻率和平均購買金額皆有提升，族群成長較明顯
# R2 頻率成長幅度最大，平均購買金額小幅提升，族群些微成長

圖四、顧客分群規則

3.7 族群屬性動態分析

df = merge(Y$Y2014[,c(1,6)], Y$Y2015[,c(1,6)],
           by="cid", all.x=T)
tx = table(df$status.x, df$status.y) %>% 
  as.data.frame.matrix() %>% as.matrix()
tx    

     N1   N2   R1   R2  S1   S2   S3
N1 1705  381  144   45 831    0    0
N2    0 1131  267  430 263    0    0
R1    0    0 1240   43 819    0    0
R2    0    0  199 1742  75    0    0
S1    0    0  115    3 819 1026    0
S2    0    0   78    1   0  692 1339
S3    0    0   97    0   0    0 3420

# 流量矩陣

tx %>% prop.table(1) %>% round(3)   # 流量矩陣(%)

      N1    N2    R1    R2    S1    S2    S3
N1 0.549 0.123 0.046 0.014 0.268 0.000 0.000
N2 0.000 0.541 0.128 0.206 0.126 0.000 0.000
R1 0.000 0.000 0.590 0.020 0.390 0.000 0.000
R2 0.000 0.000 0.099 0.864 0.037 0.000 0.000
S1 0.000 0.000 0.059 0.002 0.417 0.523 0.000
S2 0.000 0.000 0.037 0.000 0.000 0.328 0.635
S3 0.000 0.000 0.028 0.000 0.000 0.000 0.972

3.8 互動式流量分析

chorddiag(tx, groupColors=cols)

---

4. 建立模型

在這個案例裡面，我們的資料是收到Y2015年底，所以我們可以假設現在的時間是Y2015年底，我們想要用現有的資料建立模型，來預測每一位顧客：

• 在Y2016年是否會來購買 (保留率：Retain)
• 她來購買的話，會買多少錢 (購買金額：Revenue)

但是，我們並沒有Y2016的資料，為了要建立模型，我們需要先把時間回推一期，也就是說：

• 用Y2014年底以前的資料整理出預測變數(X)
• 用Y2015年的資料整理出目標變數(Y)

假如Y2016的情況(跟Y2015比)沒有太大的變化的話，接下來我們就可以

• 使用該模型，以Y2015年底的資料，預測Y2016的狀況

4.1 準備資料

我們用Y2014年底的資料做自變數，Y2015年的資料做應變數

CX = left_join(Y$Y2014, Y$Y2015[,c(1,8,9)], by="cid") 
head(CX)

# 1是cid這個欄位做建置，要把次序對起來
# left_join假設後面沒有，不會直接刪掉，而是保留然後填NA

names(CX)[8:11] = c("freq0","revenue0","Retain", "Revenue")
CX$Retain = CX$Retain > 0  #CX$Retain > 0有無保留住
head(CX)

table(CX$Retain) %>% prop.table()  

 FALSE   TRUE 
0.7701 0.2299 

# 平均保留機率 = 22.54%

4.2 建立類別模型

mRet = glm(Retain ~ ., CX[,c(2:3,6,8:10)], family=binomial())
summary(mRet)

Call:
glm(formula = Retain ~ ., family = binomial(), data = CX[, c(2:3, 
    6, 8:10)])

Deviance Residuals: 
   Min      1Q  Median      3Q     Max  
-3.689  -0.473  -0.298  -0.142   3.386  

Coefficients:
             Estimate Std. Error z value        Pr(>|z|)    
(Intercept) -1.074007   0.089431  -12.01         < 2e-16 ***
recent      -0.002067   0.000131  -15.73         < 2e-16 ***
freq         0.095217   0.013882    6.86 0.0000000000069 ***
statusN2     0.669429   0.070234    9.53         < 2e-16 ***
statusR1     0.488321   0.084389    5.79 0.0000000071864 ***
statusR2     1.290002   0.110841   11.64         < 2e-16 ***
statusS1     0.670604   0.146532    4.58 0.0000047279944 ***
statusS2     1.353554   0.208210    6.50 0.0000000000798 ***
statusS3     2.573689   0.275786    9.33         < 2e-16 ***
freq0        0.566557   0.065532    8.65         < 2e-16 ***
revenue0    -0.000132   0.000135   -0.98            0.33    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 18228  on 16904  degrees of freedom
Residual deviance: 11766  on 16894  degrees of freedom
AIC: 11788

Number of Fisher Scoring iterations: 6

4.3 估計類別模型的準確性

pred = predict(mRet,type="response")
table(pred>0.5,CX$Retain) 

       
        FALSE  TRUE
  FALSE 12045  1530
  TRUE    974  2356

# 混淆矩陣 (Confusion Matrix)  

table(pred>0.5,CX$Retain) %>% 
  {sum(diag(.))/sum(.)}            # 正確率(ACC): 85.19% 

[1] 0.8519

colAUC(pred,CX$Retain)             # 辯識率(AUC): 87.92%

                 [,1]
FALSE vs. TRUE 0.8792

prediction(pred, CX$Retain) %>%    # ROC CURVE 
  performance("tpr", "fpr") %>% 
  plot(print.cutoffs.at=seq(0,1,0.1))

4.4 建立數量模型

dx = subset(CX, Revenue > 0)  
mRev = lm(log(Revenue) ~ recent + freq + log(1+money) + senior +
          status + freq0 + log(1+revenue0), dx)   
summary(mRev)  

Call:
lm(formula = log(Revenue) ~ recent + freq + log(1 + money) + 
    senior + status + freq0 + log(1 + revenue0), data = dx)

Residuals:
   Min     1Q Median     3Q    Max 
-3.245 -0.209 -0.067  0.205  3.435 

Coefficients:
                    Estimate Std. Error t value         Pr(>|t|)    
(Intercept)        0.0587930  0.0458344    1.28           0.1997    
recent             0.0003541  0.0000507    6.98 0.00000000000337 ***
freq               0.0526850  0.0046504   11.33          < 2e-16 ***
log(1 + money)     0.9320818  0.0135203   68.94          < 2e-16 ***
senior            -0.0001369  0.0000182   -7.52 0.00000000000007 ***
statusN2           0.0127716  0.0262656    0.49           0.6268    
statusR1           0.1927532  0.0407579    4.73 0.00000233405019 ***
statusR2           0.0297685  0.0352479    0.84           0.3984    
statusS1           0.0082406  0.0630355    0.13           0.8960    
statusS2          -0.2406398  0.0865731   -2.78           0.0055 ** 
statusS3          -0.3667341  0.1181061   -3.11           0.0019 ** 
freq0              0.0103133  0.0172551    0.60           0.5501    
log(1 + revenue0)  0.0632756  0.0094003    6.73 0.00000000001930 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.463 on 3873 degrees of freedom
Multiple R-squared:  0.713, Adjusted R-squared:  0.712 
F-statistic:  802 on 12 and 3873 DF,  p-value: <2e-16

# 只對有來購買的人做模型，沒來買的就不管
# 判定係數：R2 = 0.713

plot(log(dx$Revenue), predict(mRev), col='pink', cex=0.65)
abline(0,1,col='red') 

---

5. 估計顧客終生價值

5.1 Y2016的預測值

使用模型對Y2015年底的資料做預測，對資料中的每一位顧客，預測她們在Y2016的保留率和購買金額。

CX = Y$Y2015
names(CX)[8:9] = c("freq0","revenue0")
# 預測Y2016保留率
CX$ProbRetain = predict(mRet,CX,type='response')
# 預測Y2016購買金額
CX$PredRevenue = exp(predict(mRev,CX))

par(mfrow=c(1,2), mar=c(4,3,3,2), cex=0.8)
hist(CX$ProbRetain,main="ProbRetain", ylab="")
hist(log(CX$PredRevenue,10),main="log(PredRevenue)", ylab="")

# 保留率超過0.5的占比不高
# 購買金額依舊偏低

5.2 估計顧客終生價值(CLV)

顧客終生價值(Customer LifetimeValue)指的是每個購買者在未來可能為企業帶來的收益總和。研究表明，如同某種產品一樣，顧客對於企業利潤的貢獻也可以分為導入期、快速增長期、成熟期和衰退期。

每個客戶的價值都由三部分構成：

• 歷史價值(到目前為止已經實現了的顧客價值)
• 當前價值(如果顧客當前行為模式不發生改變的話，將來會給公司帶來的顧客價值)
• 潛在價值(如果公司通過有效的交叉銷售可以調動顧客購買積極性，或促使顧客向別人推薦產品和服務等，從而可能增加的顧客價值)

顧客\(i\)的終生價值

\[ V_i = \sum_{t=0}^N g \times m_i \frac{r_i^t}{(1+d)^t} = g \times m_i \sum_{t=0}^N (\frac{r_i}{1+d})^t \]

\(m_i\)、\(r_i\)：顧客\(i\)的預期(每期)營收貢獻、保留機率 \(g\)、\(d\)：公司的(稅前)營業利潤利率、資金成本

g = 0.5   # (稅前)獲利率
N = 5     # 期數 = 5
d = 0.1   # 利率 = 10%
CX$CLV = g * CX$PredRevenue * rowSums(sapply(
  0:N, function(i) (CX$ProbRetain/(1+d))^i ) )
summary(CX$CLV)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
      3      16      24      51      45    5094 

par(mar=c(2,2,3,1), cex=0.8)
hist(log(CX$CLV,10), xlab="", ylab="")

5.3 比較各族群的價值

# 各族群的平均營收貢獻、保留機率、終生價值
sapply(CX[,10:12], tapply, CX$status, mean)

   ProbRetain PredRevenue    CLV
N1    0.20269       31.98  20.17
N2    0.44075      131.23 110.89
R1    0.34150       69.85  54.60
R2    0.74925       91.27 136.31
S1    0.05724       56.10  29.66
S2    0.03475       49.48  25.58
S3    0.02326       49.36  25.17

# 可看出R2最佳，一如上述的分析
# 但是N2能創造的revenue最大，亦是重點族群

par(mar=c(3,3,4,2), cex=0.8)
boxplot(log(CLV)~status, CX, main="CLV by Groups")

---

6. 設定行銷策略、規劃行銷工具

---

7. 選擇行銷對象

給定某一行銷工具的成本和預期效益，選擇可以施行這項工具的對象。

7.1 對R2族群進行保留

R2族群的預測保留率和購買金額

par(mfrow=c(1,2), mar=c(4,3,3,2), cex=0.8)
hist(CX$ProbRetain[CX$status=="R2"],main="ProbRetain",xlab="")
hist(log(CX$PredRevenue[CX$status=="R2"],10),main="PredRevenue",xlab="")

# 細看R2的預測保留率和購買金額

7.2 估計預期報酬

假設行銷工具的成本和預期效益為

cost = 10        # 成本
effect = 0.75    # 效益：下一期的購買機率

估計這項行銷工具對每一位R2顧客的預期報酬

Target = subset(CX, status=="R2")
Target$ExpReturn = (effect - Target$ProbRetain) * Target$PredRevenue - cost
summary(Target$ExpReturn)  

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 -515.8   -15.4   -11.5   -10.3    -8.1   646.9 

# ExpReturn是對所有人做的，還是可以挑出很多正的，所以不能用平均值

這一項工具對R2顧客的預期報酬是負的

7.3 選擇行銷對象

但是，我們還是可以挑出許多預期報酬很大的行銷對象

Target %>% arrange(desc(ExpReturn)) %>% select(cid, ExpReturn) %>% head(15)

sum(Target$ExpReturn > 0)                 # 可實施對象：258

[1] 258

在R2之中，有258人的預期報酬大於零，如果對這258人使用這項工具，我們的期望報酬是：

sum(Target$ExpReturn[Target$ExpReturn > 0])   # 預期報酬：6464

[1] 6464

#不再只是對族群，而是每個人

QUIZ:

我們可以算出對所有的族群實施這項工具的期望報酬 …

Target = CX
Target$ExpReturn = (effect - Target$ProbRetain) * Target$PredRevenue - cost
filter(Target, Target$ExpReturn > 0) %>%
  group_by(status) %>% summarise(
    No.Target = n(),
    AvgROI = mean(ExpReturn),
    TotalROI = sum(ExpReturn) ) %>% data.frame

這個結果是合理的嗎？ 你想要怎麼修正這項分析的程序呢？

• 也許合理，因為我們並不知道確切的分群標準，只能從分群後的結果進行判讀。
• 給你最多生意的顧客（也就是終身價值最高的顧客），往往不是為你行銷的最佳人員。想知道一位顧客的完整價值，必須估算這個人引進可獲利新顧客的能力。但是，大多數公司對「顧客引介力」（referral power）的估計，頂多是衡量某個人有無引介別人的意願而已，這點須注意。

---

8. 結論

如果你只有顧客ID、交易日期、交易金額三個欄位的話，你可以做的分析包括：

• 全體顧客和每一個顧客分群的：
  • 族群大小與成長趨勢
  • 族群屬性分析：如平均CLV、平均營收貢獻、成長率、毛利率(需要有成本資料)等等
  • 組間流量和平均流動機率
• 每一個顧客的：
  • 保留率、預期購買金額、終身價值
  • 目前所在群組，以及下一期會轉到個群組的機率
  • 如果有行銷工具的使用紀錄的話，我們也可以估計每一樣行銷工具、對每一位顧客的成功機率

一般而言，這一些分析的結果，足夠讓我們制定顧客發展和顧客保留策略；至於顧客吸收策略，我們通常還需要從CRM撈出顧客個人屬性資料才能做到。

---