group_by(B,age) %>%
summarise(n=n(), Buy=mean(Buy), Rev=mean(Rev)) %>%
ggplot(aes(Buy,Rev,size=n,label=age)) +
geom_point(alpha=0.5,color='gold') +
geom_text(size=4) +
scale_size(range=c(4,20)) + theme_bw() -> p
ggplotly(p)
定義、畫出效用函數 由於c()
是一個常用的R內建功能,以下我們用x
代表成本 \[\Delta P = f(x|m,b,a) = m \cdot Logis(\frac{10(x - b)}{a})\]
DP = function(x,m0,b0,a0) {m0*plogis((10/a0)*(x-b0))}
par(mar=c(4,4,2,1),cex=0.7)
curve(DP(x,m=0.20,b=30,a=40), 0, 60, lwd=2, ylim=c(0, 0.25),
main="F( x | m=0.2, b=30, a=40 )", ylab="delta P")
abline(h=seq(0,0.2,0.05),v=seq(0,60,5),col='lightgrey',lty=2)
期望報償的算法: \[\hat{R}(x) = \left\{\begin{matrix} \Delta P \cdot M \cdot margin - x & , & P + \Delta P \leq 1\\ (1-P) \cdot M \cdot margin - x & , & else \end{matrix}\right.\]
估計毛利率(margin
)
# load(data/tf0.rdata)
# group_by(Z0, age) %>% summarise(sum(price)/sum(cost) - 1)
margin = 0.17 # assume margin = 0.17
估計預期報償
m=0.2; b=25; a=40; x=30
dp = pmin(1-B$Buy, DP(x,m,b,a))
eR = dp*B$Rev*margin - x
hist(eR,main="預期報償分佈",xlab="預期報償",ylab="顧客數")
🌻 有多少顧客的預期報償大於零?
🌻 如果我們針對所有顧客做促銷,預期報償將是?
🌻 如果我們針對預期報償大於零顧客做促銷,預期報償將是?
## [1] 75883.81
m=0.2; b=25; a=40; X = seq(10,45,1)
df = sapply(X, function(x) {
dp = pmin(DP(x,m,b,a),1-B$Buy)
eR = dp*B$Rev*margin - x
c(x=x, eReturn=sum(eR), N=sum(eR > 0), eReturn2=sum(eR[eR > 0]))
}) %>% t %>% data.frame %>%
gather('key','value',-x)
df %>% ggplot(aes(x=x, y=value, col=key)) +
geom_hline(yintercept=0,linetype='dashed') +
geom_line(size=1.5,alpha=0.5) +
facet_wrap(~key,ncol=1,scales='free_y') + theme_bw()
mm=c(0.20, 0.25, 0.15, 0.25)
bb=c( 25, 30, 15, 30)
aa=c( 40, 40, 30, 60)
X = seq(0,60,2)
do.call(rbind, lapply(1:length(mm), function(i) data.frame(
Inst=paste0('Inst',i), Cost=X,
Gain=DP(X,mm[i],bb[i],aa[i])
))) %>% data.frame %>%
ggplot(aes(x=Cost, y=Gain, col=Inst)) +
geom_line(size=1.5,alpha=0.5) + theme_bw() +
ggtitle("Prob. Function: f(x|m,b,a)")
X = seq(10, 60, 1)
df = do.call(rbind, lapply(1:length(mm), function(i) {
sapply(X, function(x) {
dp = pmin(1-B$Buy, DP(x,mm[i],bb[i],aa[i]))
eR = dp*B$Rev*margin - x
c(i=i, x=x, eR.ALL=sum(eR), N=sum(eR>0), eR.SEL=sum(eR[eR > 0]) )
}) %>% t %>% data.frame
}))
df %>%
mutate_at(vars(eR.ALL, eR.SEL), function(y) round(y/1000)) %>%
gather('key','value',-i,-x) %>%
mutate(Instrument = paste0('I',i)) %>%
ggplot(aes(x=x, y=value, col=Instrument)) +
geom_hline(yintercept=0, linetype='dashed', col='blue') +
geom_line(size=1.5,alpha=0.5) +
xlab('工具選項(成本)') + ylab('預期報償(K)') +
ggtitle('行銷工具優化','假設行銷工具的效果是其成本的函數') +
facet_wrap(~key,ncol=1,scales='free_y') + theme_bw() -> p
plotly::ggplotly(p)
每一個工具的最佳參數
## # A tibble: 4 x 5
## # Groups: i [4]
## i x eR.ALL N eR.SEL
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 31 -200481. 7511 83441.
## 2 2 37 -179567. 8822 132374.
## 3 3 20 -36157. 11235 102930.
## 4 4 10 -246916. 0 0
🗿 討論問題:
如果上述4組工具參數分別是某折價券對4個不同年齡族群的效果:
■ I1 : a24, a29
■ I2 : a34, a39
■ I3 : a44, a49
■ I4 : a54, a59, a64, a69
如果你可以在這4個年齡族群之中選擇行銷對象,你應該如何:
■ 選擇行銷對象(N
)?
■ 設定折價券的面額(x
)?
■ 估計預期報償(eR.SEL
)?