pacman::p_load(caTools, ggplot2, dplyr)
D = read.csv("data/quality.csv") # Read in dataset
set.seed(88)
split = sample.split(D$PoorCare, SplitRatio = 0.75) # split vector
TR = subset(D, split == TRUE)
TS = subset(D, split == FALSE)
glm1 = glm(PoorCare ~ OfficeVisits + Narcotics, TR, family=binomial)
summary(glm1)Fig 12.3 - 從預測到決策
因為這個資料集很小,我們使用全部的資料來做模擬 (通常我們是使用測試資料集)
pred = predict(glm1, D, type="response")
y = D$PoorCare
data.frame(pred, y) %>%
ggplot(aes(x=pred, fill=factor(y))) +
geom_histogram(bins=20, col='white', position="stack", alpha=0.5) +
ggtitle("Distribution of Predicted Probability (DPP,FULL)") +
xlab("predicted probability")報酬矩陣 Payoff Matrix
payoff = matrix(c(0,-100,-10,-50),2,2)
rownames(payoff) = c("FALSE","TRUE")
colnames(payoff) = c("NoAct","Act")
payoff NoAct Act
FALSE 0 -10
TRUE -100 -50
期望報酬 Expected Payoff
cutoff = seq(0, 1, 0.01)
result = sapply(cutoff, function(p) {
cm = table(factor(y==1, c(F,T)), factor(pred>p, c(F,T)))
sum(cm * payoff) # sum of confusion * payoff matrix
})
i = which.max(result)
par(cex=0.7, mar=c(4,4,3,1))
plot(cutoff, result, type='l', col='cyan', lwd=2, main=sprintf(
"Optomal Expected Result: $%d @ %.2f",result[i],cutoff[i]))
abline(v=seq(0,1,0.1),h=seq(-6000,0,100),col='lightgray',lty=3)
points(cutoff[i], result[i], pch=20, col='red', cex=2)使用manipulate套件做策略模擬
library(manipulate)
manipulate({
payoff = matrix(c(TN,FN,FP,TP),2,2)
cutoff = seq(0, 1, 0.01)
result = sapply(cutoff, function(p) {
cm = table(factor(y==1, c(F,T)), factor(pred>p, c(F,T)))
sum(cm * payoff) # sum of confusion * payoff matrix
})
i = which.max(result)
par(cex=0.7)
plot(cutoff, result, type='l', col='cyan', lwd=2, main=sprintf(
"Optomal Expected Result: $%d @ %.2f",result[i],cutoff[i]))
abline(v=seq(0,1,0.1),h=seq(-10000,0,100),col='lightgray',lty=3)
points(cutoff[i], result[i], pch=20, col='red', cex=2)
},
TN = slider(-100,0, 0,step=5),
FN = slider(-100,0,-100,step=5),
FP = slider(-100,0, -10,step=5),
TP = slider(-100,0, -50,step=5)
)
🗿 練習:
執行Sim12.R,先依預設的報酬矩陣回答下列問題:
【A】 最佳臨界機率是? 它所對應的期望報酬是多少? ANS: Threshold : 0.16, 期望報酬:-2360
【B】 什麼都不做時,臨界機率和期望報酬各是多少? ANS: Threshold : 1, 期望報酬:-3300
【C】 每位保戶都做時,臨界機率和期望報酬各是多少? ANS: Threshold : 0, 期望報酬:-2630
【D】 以上哪一種做法期的望報酬比較高? ANS: 於Threshold = 0.16時,有些做有些不做的情況下,期望報酬最高:-2360
【E】 在所有的商務情境都是這種狀況嗎? ANS: 不是。假設若沒take action的風險成本非常高,像TN:-15 FN:-100 FP:-15 TP:-15這種情況下,則應該全部Take action。
藉由調整報酬矩陣:
【F】 模擬出「全不做」比「全做」還要好的狀況 ANS: TN:0 FN:-60 FP:-10 TP:-50
【G】 並舉出一個會發生這種狀況的商務情境 ANS:
Case 1: 以保險公司為例。Actual: 是否出車禍,Predict Action:客戶投保後,是否提供免費道路安全講座。
商務情境詳述 :
聽講座後雖然可以降低車禍的機率和傷害,但是仍需要一些介入成本(場地費和演講費),導致最後保險公司辦講座過後的報酬,不如完全不辦的報酬。
Case 2: 以在台灣目前的情況,決定是否需要做新冠肺炎的全民普篩為例。Actual: 是否需要做普篩,Predict Action: 是否真的做普篩。
商務情境詳述 :
眾多證據顯示台灣境內(排除境外移入人士)無社區感染,並且防疫措施配套皆有到位,若進行全民普篩,會造成社會恐慌、浪費龐大醫療和社會資源;因此不做全民普篩,比做全民普篩好。
Case 3: 以富士Fuji在20世紀後期決定是否進軍美國市場,並以其對手柯達Kodak的應對為例。Actual: 富士Fuji是否進軍美國市場,Predict Action: 柯達Kodak是否在美國對付室進行降下競爭的制裁。
商務情境詳述 :
在20世紀後期,Fuji在亞洲和歐洲市場站穩後,決定進攻美國市場,但身為坐落於美國的強勁競爭對手Kodak,Fuji有許多要面對的困難;除了基本會遇到的跨國”水土不服”,Kodak因為在美國當時有70%左右的市佔率,因此相較Fuji,Kodak甚至沒有地域障礙,並還有極高資本和籌碼可以攻擊Fuji,當時Kodak直接採取削價競爭,讓Fuji完全沒有在美國市場發展的空間。因此對Fuji來說不進軍美國市場,比進軍要好,進軍除了需要付出不少成本投資,最後可能還會血本無歸。
Case 4: 以2008、2009年韓國女團Wonder Girls(簡稱WG)當年選擇全面進軍美國娛樂市場,並且對手少女時代(簡稱少時)的應對為例子。Actual: WG是否進軍美國,Predict Action: 少時對WG是否進軍美國所作的應對行為。
商務情境詳述 :
WG於2008年正值在韓國起步並且前景看好,但因為所屬經紀公司決定將WG送去美國發展,結果大敗;因為當時美國對KPOP接受度仍不高,也因為在韓國未站穩腳步,便離開韓國市場前往太平洋另一端,不只沒成功培植美國市場,更失去賺錢主力韓國、亞洲娛樂圈,韓國第一女團寶座直接被對手少時幾乎完全吃下。因此對WG來說當初不進軍美國市場,比進軍要好。
Case 5: 以裕隆NISSAN是否要投入研發並誕生出納智捷LUXGEN為例。Actual: 市場對納智捷LUXGEN的反應,Predict Action: 裕隆NISSAN是否研發發展納智捷。
商務情境詳述 :
裕隆NISSAN在發展納智捷LUXGEN時,因為一連串錯誤策略和決策,而導致LUXGEN非但沒有成為國民汽車品牌,反倒成為母公司NISSAN的累贅。A: LUXGEN的產、銷時程脫節,沒有把握新車蜜月效應而搶占市占率。B: LUXGEN不斷的投資,甚至讓R&D費用超越公司本身資本額;自由現金流量長年為負。C: LUXGEN品牌建立初期戰線過長,品牌知名度低,卻在國外走高價豪華車策略,執行力跟不上創意。因此一連串錯誤顯示, NISSAN當初若是沒發展LUXGEN,對母公司NISSAN本身的損失不會如此慘重。
$5, $10, $15, $20, $30的介入方法,它們分別可以將風險成本從$100降低到$70, $60, $50, $40, $25 …