Cette partie répond à la même Question 1 que la G-computation : estimer les courbes de survie contrefactuelles \(S^{a_0=1}(t)\) et \(S^{a_0=0}(t)\) ajustées sur les facteurs de confusion \(X\) et \(L_0\).
L’IPTW adopte une stratégie opposée à la G-computation : au lieu de modéliser le résultat \(Y\), il modélise l’exposition \(A_0\) conditionnellement aux covariables, puis pondère les individus pour créer une pseudo-population équilibrée. Une fois les poids calculés, l’analyse de survie est directement réalisée par Kaplan-Meier pondéré, ce qui traite correctement la censure — aucune simplification du critère de jugement n’est nécessaire.
Lien avec la Partie 1 : la G-computation avait traité \(D\) comme une variable binaire (décédé avant 3 ans, oui/non) pour simplifier. Avec l’IPTW, l’implémentation est tout aussi simple avec le critère censuré. Des notes repliables proposent le code et les résultats équivalents en version binaire, pour comparer directement les deux méthodes à la fin.
La variable df est disponible dans les chunks interactifs, avec A0 et L0 déjà propagées.
Le score de propension est \(e_i = P(A_0 = 1 \mid X = x_i,\ L_0 = l_i)\), estimé par régression logistique sur les données de la première visite seulement.
Estimez le modèle de propension mod.ps et stockez les probabilités prédites dans df$ps.
## Modèle de propension (données baseline uniquement)
mod.ps <- glm(A0 ~ X + L0,
data = df[df$T.start == 0, ],
family = "binomial")
## Score de propension prédit pour tous les individus (toutes lignes)
df$ps <- predict(mod.ps, newdata = df, type = "response")
## Distribution du PS par groupe
summary(df$ps[df$A0 == 1])
summary(df$ps[df$A0 == 0])Visualisez la distribution du score de propension selon \(A_0\) pour vérifier le chevauchement (positivité) :
## Histogrammes superposés
par(mfrow = c(1, 2))
hist(df$ps[df$A0 == 1], breaks = 20, col = "#AC182E80",
main = "A0 = 1", xlab = "Score de propension", xlim = c(0, 1))
hist(df$ps[df$A0 == 0], breaks = 20, col = "#1D276980",
main = "A0 = 0", xlab = "Score de propension", xlim = c(0, 1))
par(mfrow = c(1, 1))On calcule les poids non stabilisés \(w_i = A_0/e_i + (1-A_0)/(1-e_i)\) et les poids stabilisés \(w^s_i = P(A_0)/e_i\) si \(A_0=1\), \(P(A_0=0)/(1-e_i)\) si \(A_0=0\).
Calculez df$iptw (non stabilisé) et df$iptw.s (stabilisé). Comparez leur distribution.
## Poids non stabilisés
df$iptw <- (df$A0 == 1) / df$ps + (df$A0 == 0) / (1 - df$ps)
## Probabilité marginale d'être exposé (numérateur des poids stabilisés)
p.A1 <- mean(df$A0[df$T.start == 0])
p.A0 <- 1 - p.A1
## Poids stabilisés
df$iptw.s <- ifelse(df$A0 == 1,
p.A1 / df$ps,
p.A0 / (1 - df$ps))
## Comparaison
cat("Poids non stabilisés - moyenne:", round(mean(df$iptw), 3),
" / max:", round(max(df$iptw), 2), "\n")
cat("Poids stabilisés - moyenne:", round(mean(df$iptw.s), 3),
" / max:", round(max(df$iptw.s), 2), "\n")Règle pratique : les poids stabilisés ont une moyenne proche de 1 et une variance plus faible. Ils sont généralement préférés en pratique. Si certains poids sont très élevés (> 10–20), c’est un signe de violation de la positivité ou d’un modèle de propension mal spécifié.
Avant toute analyse, il faut s’assurer que la pondération a rétabli l’équilibre entre les groupes \(A_0=1\) et \(A_0=0\) sur les covariables \(X\) et \(L_0\).
Utilisez cobalt::bal.tab() et cobalt::love.plot() pour comparer les différences standardisées avant et après pondération.
library(cobalt)
## Tableau des différences standardisées (avant et après pondération)
bal <- bal.tab(A0 ~ X + L0,
data = df[df$T.start == 0, ],
weights = df$iptw.s[df$T.start == 0],
method = "weighting",
binary = "std",
un = TRUE)
bal
## Love plot avant/après
love.plot(bal,
thresholds = c(m = 0.1),
colors = c("#AC182E", "#1D2769"),
shapes = c("circle", "triangle"),
title = "Équilibre avant/après IPTW")Les différences standardisées après pondération sont-elles inférieures à 0,1 (seuil conventionnel) ?
Si les SMD après pondération sont < 0,1 pour toutes les covariables, l’équilibre est satisfaisant. Un SMD résiduel > 0,1 suggère une mauvaise spécification du modèle de propension (variables manquantes, transformations nécessaires, interactions, etc.).
Rappel : n’utilisez pas de p-values pour évaluer l’équilibre — elles dépendent de la taille d’échantillon et ne mesurent pas la comparabilité des groupes.
Estimez les courbes de Kaplan-Meier pondérées par iptw.s, tracez-les et obtenez la différence de survie à 3 ans.
km.iptw <- survfit(Surv(T.start, T.stop, D) ~ A0,
data = df,
weights = iptw.s)
plot(km.iptw,
col = c("#1D2769", "#AC182E"), lwd = 2, conf.int = FALSE,
xlab = "Temps (années)", ylab = "Probabilité de survie",
main = "Kaplan-Meier pondéré (IPTW stabilisé)")
legend("bottomleft",
legend = c("A0 = 0 (non-exposés)", "A0 = 1 (exposés)"),
col = c("#1D2769", "#AC182E"), lwd = 2, bty = "n")
## Différence de survie à 3 ans
s3 <- summary(km.iptw, times = 3)$surv
cat("Survie à 3 ans - A0=0 :", round(s3[1], 3), "\n")
cat("Survie à 3 ans - A0=1 :", round(s3[2], 3), "\n")
cat("Différence :", round(diff(s3), 3), "\n")La différence de survie à 3 ans après IPTW est 0.167.
Comme dans la Partie 1, on peut ignorer l’information temporelle et traiter \(D\) comme un indicateur binaire de décès à 3 ans. L’IPTW avec critère binaire revient à calculer la moyenne pondérée de \(D\) dans chaque groupe sur une base à une ligne par individu :
\[\widehat{E}(D^{a_0}) = \frac{\displaystyle\sum_{i\,:\,A_{0i}=a_0} w_i^s \cdot D_i}{\displaystyle\sum_{i\,:\,A_{0i}=a_0} w_i^s}\]
## Une ligne par individu — D final et poids IPTW stabilisés
df_base_bin <- df |>
group_by(id) |>
summarise(A0 = first(A), D = last(D), iptw.s = first(iptw.s)) |>
ungroup()
m1_bin <- weighted.mean(df_base_bin$D[df_base_bin$A0 == 1],
df_base_bin$iptw.s[df_base_bin$A0 == 1])
m0_bin <- weighted.mean(df_base_bin$D[df_base_bin$A0 == 0],
df_base_bin$iptw.s[df_base_bin$A0 == 0])
cat("E(D^1) =", round(m1_bin, 3), "\n")
cat("E(D^0) =", round(m0_bin, 3), "\n")
cat("ATE binaire (IPTW) =", round(m1_bin - m0_bin, 3))L’ATE binaire par IPTW est \(\approx\) -0.15 — à comparer avec l’ATE G-computation de la Partie 1 dans la section suivante.
Les deux méthodes spécifient des modèles distincts pour répondre à la même question causale :
| G-computation (Partie 1) | IPTW (cette partie) | |
|---|---|---|
| Modèle estimé | Résultat : \(E(D \mid A_0, X, L_0)\) | Exposition : \(P(A_0=1 \mid X, L_0)\) |
| Critère utilisé | Binaire (simplification) | Survie censurée (complet) |
| Mesure d’effet | Différence de risque de décès | Différence de survie à 3 ans |
| Estimée | -0.135 | 0.167 |
Lien entre les deux mesures : puisque \(P(T \leq 3) = 1 - S(3)\), la différence de risque de décès vaut \(-\) la différence de survie à 3 ans. Les deux estimations doivent donc être de signe opposé et de valeur absolue proche.
Vérifiez cela : à partir de df_base_bin (une ligne par individu, avec D final et iptw.s), calculez l’ATE par IPTW avec critère binaire, et vérifiez sa cohérence avec la différence de survie du KM pondéré.
km.iptw doit avoir été calculé à l’Étape 4 pour que ce chunk fonctionne.
df_base_bin <- df |>
group_by(id) |>
summarise(A0 = first(A), D = last(D), iptw.s = first(iptw.s)) |>
ungroup()
m1_bin <- weighted.mean(df_base_bin$D[df_base_bin$A0 == 1],
df_base_bin$iptw.s[df_base_bin$A0 == 1])
m0_bin <- weighted.mean(df_base_bin$D[df_base_bin$A0 == 0],
df_base_bin$iptw.s[df_base_bin$A0 == 0])
ate_iptw_bin <- m1_bin - m0_bin
cat("=== IPTW (critère binaire) ===\n")
cat("E(D^1) =", round(m1_bin, 3), "\n")
cat("E(D^0) =", round(m0_bin, 3), "\n")
cat("ATE binaire =", round(ate_iptw_bin, 3), "\n\n")
s3 <- summary(km.iptw, times = 3)$surv
cat("=== IPTW (KM pondéré, critère censuré) ===\n")
cat("S^(a0=1)(3) =", round(s3[2], 3), "\n")
cat("S^(a0=0)(3) =", round(s3[1], 3), "\n")
cat("Diff survie =", round(diff(s3), 3), "\n\n")
cat("=== Vérification du lien ATE ≈ -diff(survie) ===\n")
cat("ATE + diff(survie) =", round(ate_iptw_bin + diff(s3), 3),
" (doit être proche de 0)\n")Les estimations de référence calculées automatiquement :
Convergence : si G-computation et IPTW binaire donnent des ATE proches, les deux modèles (résultat et exposition) sont probablement bien spécifiés — c’est un argument de robustesse.
Signe opposé : la différence de survie IPTW doit être approximativement \(-\text{ATE}\). Ici : -0.15 + 0.167 = 0.016 (proche de 0).
Critère censuré vs binaire : la différence de survie par KM pondéré est l’estimateur de référence de cette partie, car il exploite toute l’information temporelle et traite correctement la censure. La version binaire est proposée uniquement pour le parallèle avec la Partie 1.
La Partie 3 passe à la Question 2 : l’effet de l’exposition maintenue tout au long du suivi.
Pour continuer, cliquez sur IPCW dans le menu à gauche.