rm(list=ls(all=T))
options(digits=4, scipen=12)
pacman::p_load(ggplot2, manipulate, dplyr, latex2exp)
load("data/CX.rdata")

直接依假設估計淨期望報償

因為沒有成本資料，我們先假設營業獲利率為0.3

MRG = 0.5

以R2為行銷對象

A = subset(CX, status=="R2")
P0=A$ProbRetain
R0=A$PredRevenue
假設一：固定成本、固定回購機率(\(k_1\))
cost = 5
k1 = 0.75 # fix effect on the probability of retaintion
  • 回購機率增額： \(\Delta P_{ret} = k_1 - P_{retain}\)
  • 淨期望報酬： \(\pi = m \cdot R_{exp} \cdot \Delta P_{ret} - c\)
par(mar=c(4,3,3,2), cex=0.8)
PI = R0*MRG*(k1 - P0) - cost
hist(PI, xlim=c(-50, 50), breaks=seq(-500,500,5),main="淨期望報償分布(R2)")

修正：行銷工具不應該會有負的回購機率效果
  • \(\Delta P_{ret} = max[0, k_1 - P_{retain}]\)
par(mar=c(4,3,3,2), cex=0.8)
PI = R0*MRG*pmax(0, k1 - P0) - cost
hist(PI, xlim=c(-50, 50), breaks=seq(-500,500,5),main="淨期望報償分布(R2)")

假設二：固定成本、增加回購機率(\(k_2\))

\[\Delta P_{ret} = \left\{\begin{matrix} k_2 & P_{retain}<=1-k_2 \\ 1-P_{retain} & else \end{matrix}\right.\]

k2 = 0.15  # max. incremental effect of instrument
cost = 5
par(mar=c(4,3,3,2), cex=0.8)
PI = MRG * R0 * ifelse(P0<=(1-k2), k2, 1-P0) - cost
hist(PI, xlim=c(-50, 50), breaks=seq(-500,500,5),main="淨期望報償分布(R2)")

計算工具在各族群的效益
CX = CX %>% mutate(
  PI = MRG*PredRevenue*ifelse(ProbRetain<=(1-k2), k2, 1-ProbRetain) - cost
  ) 
CX %>% group_by(status) %>% 
  summarise(
    Group.Sz = n(),
    No.Target = sum(PI>0),
    AvgROI = mean(PI[PI>0]),
    TotalROI = sum(PI[PI>0])) %>% 
  arrange(No.Target) %>% 
  data.frame
##   status Group.Sz No.Target AvgROI TotalROI
## 1     N1     2772         0    NaN        0
## 2     S2     1718       189  9.130     1726
## 3     S1     2807       508  6.095     3096
## 4     S3     4759       522  9.239     4823
## 5     R1     2140       532  7.242     3853
## 6     R2     2264       770  7.935     6110
## 7     N2     1957       998 11.011    10989
工具在各族群的淨期望報償分布
par(mfrow=c(4,2), mar=c(4,3,3,2), cex=0.8)
for(s in c("N1","N2","R1","R2","S1","S2","S3")) {
  hist(CX$PI[CX$status==s], xlim=c(-5, 100), breaks=seq(-1000,1000,10), 
       ylim=c(0, 800), main=s, xlab="exp.profit")
  abline(v=0, col='green', lty=2)}

模擬成本與效果的關係

帶有參數的函數
m=0.20; a=20; b=15
par(cex=0.8,mar=c(4,4,5,1))
curve(m*plogis((10/a)*(x-b)), 0, 30, lwd=2, ylim=c(0, 0.25),
      main=TeX('$m \\times Logis(\\frac{10(x - b)}{a})$'), ylab="f(x)")
abline(h=seq(0,0.2,0.05),v=seq(0,30,5),col='lightgrey',lty=2)

\[k_0=f(x)=m \cdot Logis(\frac{10(x - b)}{a})\]

使用manipulate套件做模擬

manipulate()不能在Rmd直接執行，需要另外開一個R窗格，把以下程式碼Copy過去跑

manipulate({
  curve(m*plogis((10/a)*(x-b)), 0, 30, lwd=2, ylim=c(0, 0.25),
        main = TeX('$m \\cdot Logis(10(x - b)/a)$'), ylab="f(x)")
  abline(h=seq(0,0.2,0.05),v=seq(0,30,5),col='lightgrey',lty=2)
},
m = slider(0.05, 0.25,  0.20, step=0.01),
a = slider(  10,   30,    20, step=1),
b = slider(   4,   20,    15, step=1)
)
使用模擬方法找到最佳策略(參數)
m=0.20; a=20; b=15
do.call(rbind, lapply(seq(5,40,0.5), function(c){
  p = m*plogis((10/a)*(c-b))
  CX %>% mutate(
    PI = ifelse(ProbRetain<=(1-p), p, 1-ProbRetain) * PredRevenue - c
  ) %>%
    group_by(status) %>% summarise(
      Cost = c,
      Group.Sz = n(),
      No.Target = sum(PI>0),
      AvgROI = mean(PI[PI>0]),
      TotalROI = sum(PI[PI>0])
    ) } ) ) %>% 
  ggplot(aes(x=Cost, y=TotalROI, col=status)) +
  geom_line(size=1.2) +
  ggtitle("Cost Effeciency per Segment ")


manipulate()不能在Rmd直接執行，需要另外開一個R窗格，把以下程式碼Copy過去跑

manipulate({
  do.call(rbind, lapply(seq(5,40,0.5), function(c){
    p = m*plogis((10/a)*(c-b))
    CX %>% mutate(
      PI = ifelse(ProbRetain<=(1-p), p, 1-ProbRetain) * PredRevenue - c
    ) %>%
      group_by(status) %>% summarise(
        Cost = c,
        Group.Sz = n(),
        No.Target = sum(PI>0),
        AvgROI = mean(PI[PI>0]),
        TotalROI = sum(PI[PI>0])
      ) } ) ) %>% 
    ggplot(aes(x=Cost, y=TotalROI, col=status)) +
    geom_line(size=1.2) +
    ggtitle("Cost Effeciency per Segment ")
},
m = slider(0.05, 0.25,  0.20, step=0.01),
a = slider(  10,   30,    20, step=1),
b = slider(   4,   20,    15, step=1)
)