UNIT12B：類別模型、預測機率與商業決策

預測與決策

---

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)

---

【A】從預測到決策

Fig 12.3 - 從預測到決策

---

【B】預測機率分佈 (DPP)

因為這個資料集很小，我們使用全部的資料來做模擬 (通常我們是使用測試資料集)

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")

---

【C】試算期望報酬

報酬矩陣 Payoff Matrix

• TN: NoAction, GoodCare; 沒事
  
• FN: NoAction, PoorCare; 風險成本很高
• FP: Action, GoodCare; 預防成本
• TP: Action, PoorCare; 預防成本 + 降低後的風險成本

payoff = matrix(c(0,-100,-10,-50),2,2) #定義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) #cutoff:臨界機率(threshold)
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
  }) #sapply=>每個cutoff都呼叫一次後面function

#畫圖
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)

# threshold/cutoff 設在0.16, 可得最低的風險成本
#if set threshold/cutoff =1 => 全部都不take actions => 風險成本最高
#Sim12檔案裡的模擬器,可以模擬不同的payoff matrix

---

【D】策略模擬

使用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 ; expected payoff= -2360

  【B】 什麼都不做時，臨界機率和期望報酬各是多少？

#Ans:threshold=1 ; expected payoff= -3300

  【C】 每位保戶都做時，臨界機率和期望報酬各是多少？

#Ans:threshold=0 ; expected payoff= -2620

  【D】 以上哪一種做法期的望報酬比較高？

#Ans: threshold設在0.16 ; 對預估y=1的機率>0.16的人做

  【E】 在所有的商務情境都是這種狀況嗎？

#Ans: 不一定，風險成本愈小或預防成本愈高「全不做」比「全做」還好;大部分的情境是對一部份的人做會比全做或全不做來的好

藉由調整報酬矩陣：
  【F】 模擬出「全不做」比「全做」還要好的狀況

#1.風險成本降至60時 TN:0 FN:-60 FP:-10 TP:-50
#2.payoff matrix: TN=0 ; FN= -30 ; FP=-20 ; TP=-50 #有做也不能降低風險成本,或介入方法的成本太高,能降低的風險成本又有限

  【G】 並舉出一個會發生這種狀況的商務情境

#為可替代性極高的產品做問卷調查或投放廣告。例如免洗筷這種可替代性極高,顧客忠誠度也很難建立的商品,儘管為它支出大筆廣告費用能帶來的效益恐相當有限。
#假設在一犯罪率極低的地區，裝設防盜系統的預防成本(FP)為50，但發生竊案的風險成本(FN)僅10，TP(預防成本+降低後險成本)為55，則「全不做」比「全做」還要好
#預防黑天鵝事件。發生機率極低，產生的影響又極大的事件,通常預防成本都很高，且就算有做也無法有效降低風險成本。

有五種成本分別為$5, $10, $15, $20, $30的介入方法，它們分別可以將風險成本從$100降低到$70, $60, $50, $40, $25 …
  【H】 它們的最佳期望報酬分別是多少？

#介入方法成本$5=> optimal expected payoff= -2830
#介入方法成本$10=> optimal expected payoff= -2830
#介入方法成本$15=> optimal expected payoff= -2775
#介入方法成本$20=> optimal expected payoff= -2720
#介入方法成本$30=> optimal expected payoff= -2700

  【I】 哪一種介入方法的最佳期望報酬是最大的呢？

#Ans: 成本$30的介入方法最佳期望報酬最大

---