Mission 2 — ROC, AUC & choix de seuil

source("../../utils/requirements.R")
library(titanic); library(dplyr); library(broom); library(ggplot2); library(pROC); library(janitor)
data("titanic_train")
df <- titanic_train %>%
  clean_names() %>%
  mutate(
    survived = factor(survived, levels=c(0,1), labels=c("No","Yes")),
    sex = factor(sex),
    pclass = factor(pclass),
    embarked = factor(embarked)
  ) %>%
  select(survived, pclass, sex, age, sib_sp, parch, fare, embarked) %>%
  tidyr::drop_na()
set.seed(42)
idx <- sample(seq_len(nrow(df)), size = floor(.8*nrow(df)))
train <- df[idx,]; test <- df[-idx,]
mod <- glm(survived ~ sex + pclass + age + fare, data=train, family=binomial())

Objectifs

• Comprendre et tracer la courbe ROC
• Mesurer l’AUC et l’interpréter
• Choisir un seuil adapté au coût d’erreur (et pas seulement 0.5)
• Évaluer sensibilité/spécificité selon le seuil
• (Option) regarder la calibration simple

---

1) ROC & AUC

prob_test <- predict(mod, newdata=test, type="response")
roc_obj <- pROC::roc(response=test$survived, predictor=prob_test, levels=c("No","Yes"))
plot(roc_obj, print.auc=TRUE, main="ROC sur l'échantillon test")

auc_val <- pROC::auc(roc_obj); auc_val

Area under the curve: 0.8084

Note

Réflexion
- Que signifie une AUC = 0.85 concrètement ? (probabilité qu’un survivant ait un score supérieur à un non-survivant tirés au hasard)

---

2) Sensibilité / Spécificité selon le seuil

ths <- seq(0.1, 0.9, by=0.1)
perf <- lapply(ths, function(t){
  pred <- factor(ifelse(prob_test >= t, "Yes", "No"), levels=c("No","Yes"))
  tab <- table(Truth=test$survived, Pred=pred)
  sens <- tab["Yes","Yes"]/sum(tab[,"Yes"])
  spec <- tab["No","No"]/sum(tab[,"No"])
  acc  <- sum(diag(tab))/sum(tab)
  tibble::tibble(threshold=t, sensitivity=sens, specificity=spec, accuracy=acc)
}) %>% dplyr::bind_rows()
ggplot(perf, aes(threshold, sensitivity)) + geom_line() + geom_point() + labs(title="Sensibilité selon le seuil")

ggplot(perf, aes(threshold, specificity)) + geom_line() + geom_point() + labs(title="Spécificité selon le seuil")

Tip

Question d’application
- Si rater un survivant est très coûteux, vers quel seuil vous tournez-vous (plus bas/plus haut) ? Quelles conséquences sur la spécificité ?

---

3) Choix de seuil par coûts différenciés

### 3) Choix de seuil par **coûts différenciés**
# Exemple de coûts (à adapter au contexte)
cost_fp <- 1   # coût d'un faux positif
cost_fn <- 5   # coût d'un faux négatif (plus grave)

ths <- seq(0.01, 0.99, by = 0.01)

grid <- do.call(rbind, lapply(ths, function(t) {
  pred <- factor(ifelse(prob_test >= t, "Yes", "No"), levels = c("No","Yes"))
  # Comptes robustes (même si une combinaison est absente)
  FP <- sum(test$survived == "No"  & pred == "Yes")
  FN <- sum(test$survived == "Yes" & pred == "No")
  data.frame(
    threshold = t,
    FP = FP,
    FN = FN,
    expected_cost = cost_fp * FP + cost_fn * FN
  )
}))

best_idx <- which.min(grid$expected_cost)
best_threshold <- grid$threshold[best_idx]
best_threshold

[1] 0.04

# Performance au meilleur seuil selon ce coût
pred_best <- factor(ifelse(prob_test >= best_threshold, "Yes","No"), levels=c("No","Yes"))
tab_best <- table(Truth=test$survived, Pred=pred_best)
knitr::kable(as.data.frame.matrix(tab_best), caption = sprintf("Matrice de confusion au seuil optimal = %.2f (coûts FP=%d, FN=%d)", best_threshold, cost_fp, cost_fn))

Matrice de confusion au seuil optimal = 0.04 (coûts FP=1, FN=5)

	No	Yes
No	4	85
Yes	0	54

Warning

Attention
- L’AUC n’impose pas un seuil ; elle juge la discrimination pour tous les seuils.
- Le seuil optimal dépend du contexte : coûts d’erreurs, prévalence, contraintes opérationnelles.

---

4) (optionnel) - Calibration (aperçu simple)

cuts <- quantile(prob_test, probs=seq(0,1,by=.1))
grp <- cut(prob_test, breaks=unique(cuts), include.lowest=TRUE)
calib <- test %>% mutate(prob=prob_test, grp=grp) %>% group_by(grp) %>%
  summarise(obs_rate=mean(survived=="Yes"), pred_mean=mean(prob), .groups="drop")
knitr::kable(calib, caption="Calibration par déciles : moyenne prédite vs proportion observée")

Calibration par déciles : moyenne prédite vs proportion observée

grp	obs_rate	pred_mean
[0.0137,0.0603]	0.1333333	0.0426319
(0.0603,0.0746]	0.3571429	0.0674806
(0.0746,0.0958]	0.1428571	0.0833150
(0.0958,0.113]	0.1428571	0.1036356
(0.113,0.219]	0.1333333	0.1685682
(0.219,0.381]	0.0714286	0.2740320
(0.381,0.595]	0.3571429	0.5072802
(0.595,0.776]	0.4285714	0.6794945
(0.776,0.875]	1.0000000	0.8320176
(0.875,0.956]	1.0000000	0.9265891

ggplot(calib, aes(pred_mean, obs_rate)) + geom_point() + geom_abline(slope=1, intercept=0, linetype=2) +
  labs(x="Probabilité moyenne prédite", y="Taux observé (Yes)", title="Courbe de calibration (déciles)")

Note

Réflexion
- Si les points sont au-dessus de la diagonale, vos probabilités sont-elles sous- ou sur-estimées ?

---

Questions (différentes de M1)

1. Donnez une interprétation de l’AUC en termes de paires (survivant vs non-survivant).
   
2. Expliquez pourquoi changer le seuil peut augmenter la sensibilité tout en diminuant la spécificité.
   
3. Avec un coût FN > FP, justifiez un seuil < 0.5 même si l’accuracy baisse.
   
4. Que révèle la calibration de vos probabilités ?

---

Points de discussion (retour groupe)

• Pourquoi l’AUC ne suffit pas à choisir un seuil ?
  
• Comment fixer les coûts en pratique (métier, impact) ?
  
• Quelles limites de la ROC quand les classes sont déséquilibrées ? (courbe PR utile)