Predikce a poměry šancí

Úvod do regrese v R

Richie Cotton

Data Evangelist at DataCamp

Predikce pomocí 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)
  )

Bodový graf odchodu zákazníků vs. čas od posledního nákupu s logistickou křivkou.

Tvorba predikcí

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

Přidání bodových predikcí

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

Bodový graf odchodu zákazníků vs. čas od posledního nákupu s logistickou křivkou. Graf je doplněn o výsledky funkce predict(), které přesně kopírují křivku.

Získání nejpravděpodobnějšího výsledku

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

Vizualizace nejpravděpodobnějšího výsledku

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

Bodový graf odchodu zákazníků vs. čas od posledního nákupu s logistickou křivkou. Graf je doplněn o nejpravděpodobnější výsledky. Při krátkém čase od posledního nákupu je nejpravděpodobnějším výsledkem neodchod. Při dlouhém čase je nejpravděpodobnějším výsledkem odchod.

Poměry šancí

Poměr šancí je pravděpodobnost, že něco nastane, dělená pravděpodobností, že nenastane.

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

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

Spojnicový graf poměru šancí vs. pravděpodobnost. Křivka roste asymptoticky k nekonečnu, jak se pravděpodobnost blíží jedné.

Výpočet poměru šancí

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

Vizualizace poměru šancí

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

Spojnicový graf poměru šancí vs. čas od posledního nákupu s vodorovnou čarou při poměru šancí rovném jedné. Při krátkém čase od posledního nákupu je nejpravděpodobnějším výsledkem neodchod. Šance na odchod rostou s délkou doby od posledního nákupu, až na pětinásobek šance neodchodu.

Vizualizace logaritmického poměru šancí

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

Spojnicový graf poměru šancí vs. čas od posledního nákupu s vodorovnou čarou při poměru šancí rovném jedné. Osa y používá logaritmické měřítko, díky čemuž je křivka poměru šancí lineární.

Výpočet logaritmického poměru šancí

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

Všechny predikce pohromadě

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
...	...	...	...	...	...

Porovnání měřítek

Měřítko	Jsou hodnoty snadno interpretovatelné?	Jsou změny snadno interpretovatelné?	Je přesné?
Pravděpodobnost	✔	✘	✔
Nejpravděpodobnější výsledek	✔✔	✔	✘
Poměr šancí	✔	✘	✔
Logaritmický poměr šancí	✘	✔	✔

Pojďme si procvičit!

Úvod do regrese v R