การพยากรณ์และอัตราส่วนออดส์

การถดถอยใน R เบื้องต้น

Richie Cotton

Data Evangelist at DataCamp

การพยากรณ์ด้วย ggplot

plt_churn_vs_recency_base <- ggplot(
  churn, 
  aes(time_since_last_purchase, has_churned)
) +
  geom_point() +
  geom_smooth(
    method = "glm", 
    se = FALSE, 
    method.args = list(family = binomial)
  )

กราฟกระจายของการเลิกใช้บริการเทียบกับเวลาตั้งแต่การซื้อครั้งล่าสุด พร้อมเส้นแนวโน้มโลจิสติก

การสร้างการพยากรณ์

mdl_recency <- glm(
  has_churned ~ time_since_last_purchase, data = churn, family = "binomial"
)

explanatory_data <- tibble(
  time_since_last_purchase = seq(-1, 6, 0.25)
)

prediction_data <- explanatory_data %>% 
  mutate(
    has_churned = predict(mdl_recency, explanatory_data, type = "response")
  )

การเพิ่มจุดพยากรณ์

plt_churn_vs_recency_base +
  geom_point(
    data = prediction_data, 
    color = "blue"
  )

กราฟกระจายของการเลิกใช้บริการเทียบกับเวลาตั้งแต่การซื้อครั้งล่าสุด พร้อมเส้นแนวโน้มโลจิสติก กราฟแสดงผลลัพธ์จาก predict() ซึ่งอยู่บนเส้นแนวโน้มพอดี

การหาผลลัพธ์ที่น่าจะเป็นไปได้มากที่สุด

prediction_data <- explanatory_data %>% 
  mutate(
    has_churned = predict(mdl_recency, explanatory_data, type = "response"),
    most_likely_outcome = round(has_churned)
  )

การแสดงผลผลลัพธ์ที่น่าจะเป็นไปได้มากที่สุด

plt_churn_vs_recency_base +
  geom_point(
    aes(y = most_likely_outcome),
    data = prediction_data,
    color = "green"
  )

กราฟกระจายของการเลิกใช้บริการเทียบกับเวลาตั้งแต่การซื้อครั้งล่าสุด พร้อมเส้นแนวโน้มโลจิสติก แสดงผลลัพธ์ที่น่าจะเป็นไปได้มากที่สุด เมื่อเวลาตั้งแต่ซื้อครั้งล่าสุดน้อย ผลลัพธ์ที่น่าจะเป็นคือไม่เลิกใช้บริการ เมื่อเวลานานขึ้น ผลลัพธ์ที่น่าจะเป็นคือเลิกใช้บริการ

อัตราส่วนออดส์

อัตราส่วนออดส์ คือความน่าจะเป็นที่เหตุการณ์จะเกิดขึ้น หารด้วยความน่าจะเป็นที่จะไม่เกิดขึ้น

$$ odds\_ratio = \frac{probability}{(1 - probability)} $$

$$ odds\_ratio = \frac{0.25}{(1 - 0.25)} = \frac{1}{3} $$

กราฟเส้นของอัตราส่วนออดส์เทียบกับความน่าจะเป็น เส้นโค้งเพิ่มขึ้นเข้าสู่อนันต์แบบอะซิมโทตเมื่อความน่าจะเป็นเข้าใกล้ 1

การคำนวณอัตราส่วนออดส์

prediction_data <- explanatory_data %>%
  mutate(
    has_churned = predict(mdl_recency, explanatory_data, type = "response"),
    most_likely_response = round(has_churned),
    odds_ratio = has_churned / (1 - has_churned)
  )

การแสดงผลอัตราส่วนออดส์

ggplot(
  prediction_data, 
  aes(time_since_last_purchase, odds_ratio)
) +
  geom_line() +
  geom_hline(yintercept = 1, linetype = "dotted")

กราฟเส้นของอัตราส่วนออดส์เทียบกับเวลาตั้งแต่การซื้อครั้งล่าสุด พร้อมเส้นที่อัตราส่วนออดส์เท่ากับ 1 เมื่อเวลาตั้งแต่ซื้อครั้งล่าสุดน้อย ผลลัพธ์ที่น่าจะเป็นคือไม่เลิกใช้บริการ โอกาสเลิกใช้บริการเพิ่มขึ้นตามเวลา สูงสุดถึง 5 เท่าของโอกาสที่จะไม่เลิกใช้บริการ

การแสดงผลล็อกอัตราส่วนออดส์

ggplot(
  prediction_data, 
  aes(time_since_last_purchase, odds_ratio)
) +
  geom_line() +
  geom_hline(yintercept = 1, linetype = "dotted") +
  scale_y_log10()

กราฟเส้นของอัตราส่วนออดส์เทียบกับเวลาตั้งแต่การซื้อครั้งล่าสุด พร้อมเส้นที่อัตราส่วนออดส์เท่ากับ 1 แกน y ใช้สเกลลอการิทึม ทำให้เส้นอัตราส่วนออดส์กลายเป็นเส้นตรง

การคำนวณล็อกอัตราส่วนออดส์

prediction_data <- explanatory_data %>%
  mutate(
    has_churned = predict(mdl_recency, explanatory_data, type = "response"),
    most_likely_response = round(has_churned),
    odds_ratio = has_churned / (1 - has_churned),
    log_odds_ratio = log(odds_ratio),
    log_odds_ratio2 = predict(mdl_recency, explanatory_data)
  )

การพยากรณ์ทั้งหมดรวมกัน

tm_snc_lst_prch	has_churned	most_lkly_rspns	odds_ratio	log_odds_ratio	log_odds_ratio2
0	0.491	0	0.966	-0.035	-0.035
2	0.623	1	1.654	0.503	0.503
4	0.739	1	2.834	1.042	1.042
6	0.829	1	4.856	1.580	1.580
...	...	...	...	...	...

การเปรียบเทียบสเกล

สเกล	ตีความค่าได้ง่ายหรือไม่	ตีความการเปลี่ยนแปลงได้ง่ายหรือไม่	มีความแม่นยำหรือไม่
ความน่าจะเป็น	✔	✘	✔
ผลลัพธ์ที่น่าจะเป็นมากที่สุด	✔✔	✔	✘
อัตราส่วนออดส์	✔	✘	✔
ล็อกอัตราส่วนออดส์	✘	✔	✔

มาฝึกกันเถอะ!

การถดถอยใน R เบื้องต้น