learn-tte/notebooks/04_inverse_probability_weighting.qmd

---
title: "Inverse Probability Weighting"
format:
  html:
    embed-resources: true
  docx: default
execute:
  echo: true
  warning: false
  message: false
---

## Goal

This notebook introduces inverse probability of treatment weighting (IPTW) from first principles.

The key idea is to create a **pseudo-population** in which treatment assignment is independent of the measured baseline confounders.

If that pseudo-population behaves like a randomized experiment, a simple weighted average of outcomes by treatment group gives an unbiased effect estimate.

## Setup

```{r}
suppressPackageStartupMessages({
  library(dplyr)
  library(gt)
  library(tibble)
})

source("../R/simulate_icu_cohort.R")
source("../R/estimate_naive_vasopressor_mortality_effect.R")
source("../R/estimate_standardized_vasopressor_mortality_effect.R")
source("../R/estimate_iptw_vasopressor_mortality_effect.R")
```

## Simulate Data And Estimate Effects

```{r}
icu_data <- simulate_icu_cohort(n_patients = 1000, seed = 20260531)

naive_mortality_analysis <- estimate_naive_vasopressor_mortality_effect(icu_data)
standardized_mortality_analysis <- estimate_standardized_vasopressor_mortality_effect(icu_data)
iptw_mortality_analysis <- estimate_iptw_vasopressor_mortality_effect(icu_data)

eligible_icu_patients <- iptw_mortality_analysis$eligible_icu_patients
```

All three analyses use the same eligible ICU patients and the same confounder set.

- **Naive**: direct comparison of observed treatment groups.
- **Standardized**: outcome regression and g-computation.
- **IPTW**: reweight the sample so confounders are balanced.

## Propensity Score Model

IPTW starts with a model that predicts the probability of receiving early vasopressors given baseline characteristics.

This probability is called the **propensity score**.

```{r}
propensity_model_coefficients <- summary(
  iptw_mortality_analysis$propensity_score_model
)$coefficients |>
  as.data.frame() |>
  rownames_to_column("model_term") |>
  as_tibble()

names(propensity_model_coefficients) <- c(
  "model_term",
  "log_odds_estimate",
  "standard_error",
  "z_statistic",
  "p_value"
)

propensity_model_coefficients |>
  mutate(odds_ratio = exp(log_odds_estimate)) |>
  select(model_term, log_odds_estimate, odds_ratio, standard_error, p_value) |>
  gt() |>
  tab_header(title = "Propensity Score Model") |>
  cols_label(
    model_term = "Model term",
    log_odds_estimate = "Log-odds estimate",
    odds_ratio = "Odds ratio",
    standard_error = "Standard error",
    p_value = "P-value"
  ) |>
  fmt_number(
    columns = c(log_odds_estimate, odds_ratio, standard_error, p_value),
    decimals = 3
  )
```

Higher SOFA score and higher lactate are associated with a higher probability of receiving early vasopressors.

That is exactly the confounding pattern we want to adjust for.

## Weight Diagnostics

Unstabilized IPTW weights are:

- `1 / propensity_score` for patients who received early vasopressors.
- `1 / (1 - propensity_score)` for patients who did not.

Very large weights can signal a **positivity problem**: some patients have an extremely low or high probability of receiving the treatment they actually received.

```{r}
iptw_mortality_analysis$weight_summary |>
  gt() |>
  tab_header(title = "IPTW Weight Distribution by Treatment Group") |>
  cols_label(
    treatment_group = "Treatment group",
    patient_count = "Patients",
    min_weight = "Minimum weight",
    max_weight = "Maximum weight",
    mean_weight = "Mean weight",
    median_weight = "Median weight"
  ) |>
  fmt_integer(columns = patient_count) |>
  fmt_number(columns = c(min_weight, max_weight, mean_weight, median_weight), decimals = 3)
```

If the maximum weights are extremely large, we would consider trimming or stabilizing them.

For this teaching example the weights are moderate, so we proceed with unstabilized weights.

## Baseline Balance

IPTW should rebalance the measured confounders across treatment groups.

The table below shows unweighted and weighted means side by side so you can see the rebalancing directly.

```{r}
iptw_mortality_analysis$baseline_balance |>
  gt() |>
  tab_header(title = "Baseline Characteristics: Unweighted and Weighted Means") |>
  cols_label(
    characteristic = "Characteristic",
    no_early_unweighted = "No early vasopressor (unweighted)",
    no_early_weighted = "No early vasopressor (weighted)",
    early_unweighted = "Early vasopressor (unweighted)",
    early_weighted = "Early vasopressor (weighted)"
  ) |>
  fmt_number(decimals = 2)
```

After weighting, the weighted means in the two treatment groups are much closer for age, SOFA score, lactate, and MAP.

That is the goal of IPTW: to make the two groups comparable on measured confounders in the pseudo-population.

## Weighted Mortality Risks

Once the confounders are balanced by weighting, a simple weighted average of 28-day mortality in each group estimates the risk under each treatment strategy.

```{r}
iptw_mortality_analysis$weighted_mortality_risks |>
  gt() |>
  tab_header(title = "IPTW 28-Day Mortality Risks") |>
  cols_label(
    treatment_strategy = "Treatment strategy",
    patient_count = "Eligible patients",
    weighted_mortality_risk_28d = "Weighted mortality risk"
  ) |>
  fmt_integer(columns = patient_count) |>
  fmt_number(columns = weighted_mortality_risk_28d, decimals = 3)
```

These risks answer the same target-trial-style question as standardization:

What would the average mortality risk be if the same eligible patients all followed one strategy versus the other?

## IPTW Mortality Effect Estimates

```{r}
iptw_mortality_analysis$iptw_mortality_effect_estimates |>
  gt() |>
  tab_header(title = "IPTW Mortality Effect Estimates") |>
  cols_label(
    estimate = "Estimate",
    value = "Value"
  ) |>
  fmt_number(columns = value, decimals = 3)
```

The IPTW risk difference and risk ratio use the pseudo-population to reduce confounding by indication.

## Three-Way Comparison

The table below puts naive, standardized, and IPTW estimates side by side.

This makes it easy to see how each method addresses the same confounding problem in a different way.

```{r}
naive_risk_difference <- naive_mortality_analysis$mortality_effect_estimates |>
  filter(estimate == "Naive risk difference") |>
  pull(value)

naive_risk_ratio <- naive_mortality_analysis$mortality_effect_estimates |>
  filter(estimate == "Naive risk ratio") |>
  pull(value)

standardized_risk_difference <- standardized_mortality_analysis$standardized_mortality_effect_estimates |>
  filter(estimate == "Standardized risk difference") |>
  pull(value)

standardized_risk_ratio <- standardized_mortality_analysis$standardized_mortality_effect_estimates |>
  filter(estimate == "Standardized risk ratio") |>
  pull(value)

iptw_risk_difference <- iptw_mortality_analysis$iptw_mortality_effect_estimates |>
  filter(estimate == "IPTW risk difference") |>
  pull(value)

iptw_risk_ratio <- iptw_mortality_analysis$iptw_mortality_effect_estimates |>
  filter(estimate == "IPTW risk ratio") |>
  pull(value)

three_way_comparison <- tibble(
  method = c(
    "Naive observed comparison",
    "Outcome regression standardization",
    "Inverse probability weighting (IPTW)"
  ),
  risk_difference = c(
    naive_risk_difference,
    standardized_risk_difference,
    iptw_risk_difference
  ),
  risk_ratio = c(
    naive_risk_ratio,
    standardized_risk_ratio,
    iptw_risk_ratio
  )
)

three_way_comparison |>
  gt() |>
  tab_header(title = "Naive, Standardized, and IPTW Mortality Effect Estimates") |>
  cols_label(
    method = "Method",
    risk_difference = "Risk difference",
    risk_ratio = "Risk ratio"
  ) |>
  fmt_number(columns = c(risk_difference, risk_ratio), decimals = 3)
```

### What to notice

1. **Naive comparison**: early vasopressors appear harmful. The risk difference is positive and the risk ratio is greater than 1.

2. **Standardized comparison**: after adjusting for measured confounders with an outcome model, the risk difference is smaller and the risk ratio moves toward 1.

3. **IPTW comparison**: after reweighting to balance confounders, the estimate is similar to the standardized estimate.

Both adjusted methods point in the same direction: the apparent harm in the naive comparison is largely due to confounding by indication.

In the simulated data-generating process, early vasopressors actually have a modest protective effect. Neither method perfectly recovers the true effect in a single finite sample, but both are closer to the target trial question than the naive comparison.

## What IPTW Does Conceptually

- **Observed data**: treatment is assigned based on severity. Sicker patients get vasopressors and are also more likely to die.

- **Pseudo-population**: each patient is duplicated according to their IPTW weight. Patients who received an unexpected treatment (given their characteristics) receive more weight. After reweighting, the treatment groups look similar on measured confounders.

- **Effect estimation**: a simple weighted average of outcomes in each group now compares like with like.

## Next Step

The next tutorial step is to connect these ideas back to target trial emulation mechanics:

- Time zero and eligibility criteria alignment.
- Treatment assignment windows.
- Censoring logic and inverse probability of censoring weights.

These topics move us from a cross-sectional baseline adjustment to a longitudinal design that more closely emulates a randomized trial.