Update repo

.gitignore

@@ -2,3 +2,5 @@
 *.csv
 
 *.html
+
+outputs/reports/

AGENTS.md

@@ -75,11 +75,11 @@ The main teaching example is an ICU septic shock study:
 - [x] Simulate a simple ICU observational cohort.
 - [x] Define the target trial protocol explicitly.
 - [x] Estimate a naive observational association.
-- [ ] Show why naive comparison can be biased.
-- [ ] Align time zero and eligibility criteria.
-- [ ] Introduce treatment assignment windows.
-- [ ] Add censoring logic.
-- [ ] Add inverse probability weighting from first principles.
+- [x] Show why naive comparison can be biased.
+- [x] Align time zero and eligibility criteria.
+- [x] Introduce treatment assignment windows.
+- [x] Add censoring logic.
+- [x] Add inverse probability weighting from first principles.
 - [x] Refactor repeated logic into reusable project functions.
 - [ ] Re-implement selected steps with external dependencies.
 - [ ] Build wrapper functions around external dependency workflows.
@@ -131,5 +131,15 @@ Initial estimand:
 - `scripts/01_simulate_icu_data.R`: simulate an ICU cohort in memory and print a quick `skimr` summary.
 - `R/simulate_icu_cohort.R`: first reusable simulation primitive.
 - `R/estimate_naive_vasopressor_mortality_effect.R`: shared naive mortality-effect primitive used by notebook workflows.
+- `R/estimate_standardized_vasopressor_mortality_effect.R`: shared outcome-regression standardization primitive.
+- `R/estimate_iptw_vasopressor_mortality_effect.R`: shared inverse-probability-of-treatment weighting primitive with unstabilized weights, propensity model diagnostics, weighted baseline balance, and weighted effect estimates.
 - `notebooks/01_target_trial_basics.qmd`: report-style walkthrough of the target trial protocol and initial results.
 - `notebooks/02_explore_simulated_data.qmd`: exploratory visual diagnostics for the simulated cohort.
+- `notebooks/03_why_naive_analysis_is_biased.qmd`: explanation of confounding by indication and first standardized mortality-effect estimate.
+- `notebooks/04_inverse_probability_weighting.qmd`: IPTW from first principles, weight diagnostics, baseline balance table, weighted effect estimates, and a three-way comparison of naive, standardized, and IPTW results.
+- `R/simulate_icu_cohort_longitudinal.R`: longitudinal simulation primitive with time-varying covariates, treatment timing, and censoring events at sparse time points.
+- `R/clone_trial_arms.R`: cloning function that duplicates each eligible patient into two trial arms at time zero and applies censoring rules at the 2-hour mark.
+- `R/estimate_iptw_and_ipcw_effect.R`: combined IPTW + IPCW weighting primitive for per-protocol effect estimation in the cloned dataset.
+- `notebooks/05_treatment_assignment_windows.qmd`: treatment assignment windows, grace periods, cloning mechanics, and censoring rules.
+- `notebooks/06_censoring_and_ipcw.qmd`: inverse probability of censoring weighting, combined weight diagnostics, and comparison with cross-sectional IPTW.
+- `notebooks/07_full_emulation_pipeline.qmd`: end-to-end target trial emulation pipeline with four-way comparison of naive, standardized, cross-sectional IPTW, and longitudinal IPTW + IPCW methods.

R/clone_trial_arms.R

@@ -0,0 +1,111 @@
+suppressPackageStartupMessages({
+  library(dplyr)
+})
+
+# clone_trial_arms() creates a cloned dataset for target trial emulation.
+#
+# At time zero (ICU admission), each eligible patient is duplicated into two
+# hypothetical treatment arms:
+#   - "early"    = assigned to start vasopressors within 2 hours
+#   - "no_early" = assigned to not start vasopressors within 2 hours
+#
+# Each clone is then followed over the patient's actual observed trajectory.
+# A clone is censored if the patient deviated from the assigned strategy
+# (protocol deviation) or died before the 2-hour treatment window closed.
+#
+# Arguments:
+# - longitudinal_data: output from simulate_icu_cohort_longitudinal().
+#
+# Returns:
+# - A named list with two pieces:
+#   - clone_baseline: one row per clone at time 0. This is the main analysis
+#     dataset for weighting and effect estimation.
+#   - clone_longitudinal: the full longitudinal data for each clone. Useful
+#     for teaching trajectories and visualising when censoring occurs.
+#
+# Example REPL use:
+#
+#   source("R/simulate_icu_cohort_longitudinal.R")
+#   source("R/clone_trial_arms.R")
+#   long_data <- simulate_icu_cohort_longitudinal(1000, 20260531)
+#   clones <- clone_trial_arms(long_data)
+#   clones$clone_baseline |> count(clone_strategy)
+#
+clone_trial_arms <- function(longitudinal_data) {
+  # Keep only patients who meet the target trial eligibility criteria.
+  eligible_ids <- longitudinal_data |>
+    filter(time_hours == 0, eligible == 1) |>
+    distinct(patient_id) |>
+    pull(patient_id)
+
+  eligible_longitudinal <- longitudinal_data |>
+    filter(patient_id %in% eligible_ids)
+
+  # Extract patient-level baseline information (constant across time).
+  # We use only the time 0 row to avoid duplicate rows per patient.
+  patient_summary <- eligible_longitudinal |>
+    filter(time_hours == 0) |>
+    select(
+      patient_id,
+      age,
+      sex,
+      sofa_score,
+      lactate,
+      map,
+      early_vasopressor,
+      time_to_vasopressor_hours,
+      death_before_2h,
+      death_28d
+    )
+
+  # Step 1: Create two clones per eligible patient at baseline.
+  # Each clone represents one arm of the target trial.
+  clone_baseline <- patient_summary |>
+    crossing(clone_strategy = c("early", "no_early")) |>
+    mutate(
+      # Censoring rules for the per-protocol analysis:
+      #
+      # - "early" clone: censored if the patient did NOT actually start
+      #   vasopressors within 2 hours (protocol deviation).
+      #
+      # - "no_early" clone: censored if the patient DID actually start
+      #   vasopressors within 2 hours (protocol deviation).
+      #
+      # - Both clones: censored if the patient died before the 2-hour
+      #   treatment window closed (death before treatment).
+      clone_censored = case_when(
+        clone_strategy == "early" & early_vasopressor == 0 ~ 1,
+        clone_strategy == "no_early" & early_vasopressor == 1 ~ 1,
+        death_before_2h == 1 ~ 1,
+        TRUE ~ 0
+      ),
+      clone_censored_reason = case_when(
+        clone_strategy == "early" & early_vasopressor == 0 ~ "protocol_deviation",
+        clone_strategy == "no_early" & early_vasopressor == 1 ~ "protocol_deviation",
+        death_before_2h == 1 ~ "death_before_treatment",
+        TRUE ~ "none"
+      )
+    )
+
+  # Step 2: Expand each clone to all time points from the original data.
+  # A clone is "at risk" only up to the point of censoring.
+  # After censoring, the clone drops out and does not contribute to
+  # later time points.
+  clone_longitudinal <- eligible_longitudinal |>
+    left_join(
+      clone_baseline |>
+        select(patient_id, clone_strategy, clone_censored, clone_censored_reason),
+      by = "patient_id"
+    ) |>
+    mutate(
+      clone_at_risk = case_when(
+        clone_censored == 1 & time_hours > 2 ~ 0,
+        TRUE ~ 1
+      )
+    )
+
+  list(
+    clone_baseline = clone_baseline,
+    clone_longitudinal = clone_longitudinal
+  )
+}

R/estimate_iptw_and_ipcw_effect.R

@@ -0,0 +1,157 @@
+suppressPackageStartupMessages({
+  library(dplyr)
+})
+
+# estimate_iptw_and_ipcw_effect() computes combined IPTW and IPCW weights
+# for a cloned target trial emulation dataset.
+#
+# IPTW (inverse probability of treatment weighting) balances baseline
+# confounders across the two cloned treatment arms.
+#
+# IPCW (inverse probability of censoring weighting) accounts for clones
+# that are censored due to protocol deviation or death before treatment.
+#
+# This function uses baseline confounders only for IPCW, keeping the
+# teaching example simple and transparent.
+#
+# Arguments:
+# - clone_baseline: output from clone_trial_arms()$clone_baseline.
+#   One row per clone with baseline confounders, clone strategy,
+#   censoring indicators, and 28-day outcome.
+#
+# Returns:
+# - A named list with five pieces:
+#   - propensity_score_model: logistic regression for treatment assignment.
+#   - censoring_model: logistic regression for being censored at 2 hours.
+#   - clone_weights: clone_baseline with propensity scores, IPTW weights,
+#     IPCW weights, and combined weights appended.
+#   - weight_diagnostics: summary of combined weights by clone strategy.
+#   - weighted_effect_estimates: per-protocol mortality risks, RD, and RR.
+#
+# Example REPL use:
+#
+#   source("R/estimate_iptw_and_ipcw_effect.R")
+#   effects <- estimate_iptw_and_ipcw_effect(clones$clone_baseline)
+#   effects$weighted_effect_estimates
+#
+estimate_iptw_and_ipcw_effect <- function(clone_baseline) {
+  # Step 1: Propensity score model.
+  # We predict the probability of receiving early vasopressors in the
+  # OBSERVED data using baseline confounders.
+  # Because clone_baseline has two rows per patient, we deduplicate
+  # by patient_id so the model is not fit on duplicate observations.
+  unique_patients <- clone_baseline |>
+    distinct(patient_id, .keep_all = TRUE)
+
+  propensity_model <- glm(
+    early_vasopressor ~ age + sex + sofa_score + lactate + map,
+    data = unique_patients,
+    family = binomial()
+  )
+
+  # Merge the predicted propensity score back onto the clone-level data.
+  patient_propensity <- unique_patients |>
+    mutate(
+      propensity_score = predict(propensity_model, type = "response")
+    ) |>
+    select(patient_id, propensity_score)
+
+  clone_weights <- clone_baseline |>
+    left_join(patient_propensity, by = "patient_id")
+
+  # Step 2: IPTW weights (unstabilized).
+  # Early clone weight = 1 / P(early | confounders)
+  # No_early clone weight = 1 / P(no_early | confounders)
+  clone_weights <- clone_weights |>
+    mutate(
+      iptw_weight = case_when(
+        clone_strategy == "early" ~ 1 / propensity_score,
+        clone_strategy == "no_early" ~ 1 / (1 - propensity_score)
+      )
+    )
+
+  # Step 3: Censoring model (baseline confounders only).
+  # We predict the probability that a clone is censored at the 2-hour
+  # mark, given its assigned strategy and baseline characteristics.
+  censoring_model <- glm(
+    clone_censored ~ clone_strategy + age + sex + sofa_score + lactate + map,
+    data = clone_weights,
+    family = binomial()
+  )
+
+  # Predicted probability of being censored, and therefore the weight
+  # needed to remain uncensored.
+  clone_weights <- clone_weights |>
+    mutate(
+      prob_censored = predict(censoring_model, type = "response"),
+      prob_not_censored = 1 - prob_censored,
+      ipcw_weight = 1 / prob_not_censored
+    )
+
+  # Step 4: Combined weights.
+  clone_weights <- clone_weights |>
+    mutate(
+      combined_weight = iptw_weight * ipcw_weight
+    )
+
+  # Step 5: Weight diagnostics.
+  # Extreme combined weights can indicate positivity problems in either
+  # the treatment model or the censoring model.
+  weight_diagnostics <- clone_weights |>
+    group_by(clone_strategy) |>
+    summarize(
+      n_clones = n(),
+      min_weight = min(combined_weight),
+      max_weight = max(combined_weight),
+      mean_weight = mean(combined_weight),
+      median_weight = median(combined_weight),
+      .groups = "drop"
+    )
+
+  # Step 6: Weighted effect estimates.
+  # We compute the weighted 28-day mortality risk in each clone arm,
+  # using only the clones that were NOT censored.
+  # Each uncensored clone contributes according to its combined weight,
+  # which accounts for both confounding and informative censoring.
+  uncensored_clones <- clone_weights |>
+    filter(clone_censored == 0)
+
+  early_clones <- uncensored_clones |>
+    filter(clone_strategy == "early")
+
+  no_early_clones <- uncensored_clones |>
+    filter(clone_strategy == "no_early")
+
+  weighted_risk_early <- weighted.mean(
+    early_clones$death_28d,
+    early_clones$combined_weight
+  )
+
+  weighted_risk_no_early <- weighted.mean(
+    no_early_clones$death_28d,
+    no_early_clones$combined_weight
+  )
+
+  weighted_effect_estimates <- tibble(
+    estimate = c(
+      "IPTW + IPCW 28-day mortality risk, early vasopressor",
+      "IPTW + IPCW 28-day mortality risk, no early vasopressor",
+      "IPTW + IPCW risk difference",
+      "IPTW + IPCW risk ratio"
+    ),
+    value = c(
+      weighted_risk_early,
+      weighted_risk_no_early,
+      weighted_risk_early - weighted_risk_no_early,
+      weighted_risk_early / weighted_risk_no_early
+    )
+  )
+
+  list(
+    propensity_score_model = propensity_model,
+    censoring_model = censoring_model,
+    clone_weights = clone_weights,
+    weight_diagnostics = weight_diagnostics,
+    weighted_effect_estimates = weighted_effect_estimates
+  )
+}

R/estimate_iptw_vasopressor_mortality_effect.R

@@ -0,0 +1,198 @@
+suppressPackageStartupMessages({
+  library(dplyr)
+  library(tibble)
+})
+
+# estimate_iptw_vasopressor_mortality_effect() estimates a mortality effect
+# using inverse probability of treatment weighting (IPTW).
+#
+# IPTW creates a pseudo-population in which treatment assignment is independent
+# of the measured baseline confounders.
+#
+# This function uses unstabilized weights for clarity in a first teaching pass.
+#
+# Arguments:
+# - icu_data: a data frame or tibble with the columns created by
+#   simulate_icu_cohort().
+#
+# Returns:
+# - A named list with six pieces:
+#   - eligible_icu_patients: the eligible patients with propensity scores and
+#     unstabilized IPTW weights appended.
+#   - propensity_score_model: the fitted logistic regression for treatment.
+#   - weight_summary: min, max, mean, and median weight by observed treatment
+#     group.
+#   - baseline_balance: a tibble comparing unweighted and weighted means for
+#     each baseline confounder, by treatment group.
+#   - weighted_mortality_risks: weighted 28-day mortality risk under each
+#     treatment strategy.
+#   - iptw_mortality_effect_estimates: weighted risk difference and risk ratio.
+#
+# Example REPL use:
+#
+#   source("R/simulate_icu_cohort.R")
+#   icu_data <- simulate_icu_cohort(n_patients = 1000, seed = 20260531)
+#   iptw_analysis <- estimate_iptw_vasopressor_mortality_effect(icu_data)
+#   iptw_analysis$iptw_mortality_effect_estimates
+#
+estimate_iptw_vasopressor_mortality_effect <- function(icu_data) {
+  # Keep only patients who meet the target trial eligibility criteria.
+  eligible_icu_patients <- icu_data |>
+    filter(eligible == 1)
+
+  # Fit a logistic regression model for the probability of receiving early
+  # vasopressors given baseline confounders.
+  # This is the propensity score model.
+  propensity_score_model <- glm(
+    early_vasopressor ~ age + sex + sofa_score + lactate + map,
+    data = eligible_icu_patients,
+    family = binomial()
+  )
+
+  # predict(..., type = "response") gives the predicted probability of
+  # early_vasopressor == 1 for each patient.
+  propensity_score <- predict(
+    propensity_score_model,
+    newdata = eligible_icu_patients,
+    type = "response"
+  )
+
+  # Unstabilized IPTW weights:
+  # If treated, weight = 1 / P(treated | confounders).
+  # If untreated, weight = 1 / P(untreated | confounders).
+  iptw_weight <- ifelse(
+    eligible_icu_patients$early_vasopressor == 1,
+    1 / propensity_score,
+    1 / (1 - propensity_score)
+  )
+
+  # Add the propensity score and weight back into the data for diagnostics
+  # and later use.
+  eligible_icu_patients <- eligible_icu_patients |>
+    mutate(
+      propensity_score = propensity_score,
+      iptw_weight = iptw_weight
+    )
+
+  # Summarize the weight distribution by observed treatment group.
+  # Extreme weights (very large values) can indicate positivity problems.
+  weight_summary <- eligible_icu_patients |>
+    group_by(early_vasopressor) |>
+    summarize(
+      patient_count = n(),
+      min_weight = min(iptw_weight),
+      max_weight = max(iptw_weight),
+      mean_weight = mean(iptw_weight),
+      median_weight = median(iptw_weight),
+      .groups = "drop"
+    ) |>
+    mutate(
+      treatment_group = factor(
+        early_vasopressor,
+        levels = c(0, 1),
+        labels = c("No early vasopressor", "Early vasopressor")
+      )
+    ) |>
+    select(treatment_group, patient_count, min_weight, max_weight, mean_weight, median_weight)
+
+  # Build a baseline balance table that shows unweighted and weighted means
+  # side by side. This lets learners see whether IPTW is rebalancing the
+  # confounders across treatment groups.
+  #
+  # We compute weighted means manually with sum(x * w) / sum(w) so the code
+  # is transparent and does not depend on an external weighted-summary package.
+
+  early_idx <- eligible_icu_patients$early_vasopressor == 1
+  no_early_idx <- eligible_icu_patients$early_vasopressor == 0
+
+  w_early <- eligible_icu_patients$iptw_weight[early_idx]
+  w_no_early <- eligible_icu_patients$iptw_weight[no_early_idx]
+
+  weighted_mean <- function(x, w) {
+    sum(x * w) / sum(w)
+  }
+
+  baseline_balance <- tibble(
+    characteristic = c(
+      "Age, years",
+      "Male sex, %",
+      "SOFA score",
+      "Lactate, mmol/L",
+      "MAP, mmHg"
+    ),
+    no_early_unweighted = c(
+      mean(eligible_icu_patients$age[no_early_idx]),
+      100 * mean(eligible_icu_patients$sex[no_early_idx] == "male"),
+      mean(eligible_icu_patients$sofa_score[no_early_idx]),
+      mean(eligible_icu_patients$lactate[no_early_idx]),
+      mean(eligible_icu_patients$map[no_early_idx])
+    ),
+    no_early_weighted = c(
+      weighted_mean(eligible_icu_patients$age[no_early_idx], w_no_early),
+      100 * weighted_mean(eligible_icu_patients$sex[no_early_idx] == "male", w_no_early),
+      weighted_mean(eligible_icu_patients$sofa_score[no_early_idx], w_no_early),
+      weighted_mean(eligible_icu_patients$lactate[no_early_idx], w_no_early),
+      weighted_mean(eligible_icu_patients$map[no_early_idx], w_no_early)
+    ),
+    early_unweighted = c(
+      mean(eligible_icu_patients$age[early_idx]),
+      100 * mean(eligible_icu_patients$sex[early_idx] == "male"),
+      mean(eligible_icu_patients$sofa_score[early_idx]),
+      mean(eligible_icu_patients$lactate[early_idx]),
+      mean(eligible_icu_patients$map[early_idx])
+    ),
+    early_weighted = c(
+      weighted_mean(eligible_icu_patients$age[early_idx], w_early),
+      100 * weighted_mean(eligible_icu_patients$sex[early_idx] == "male", w_early),
+      weighted_mean(eligible_icu_patients$sofa_score[early_idx], w_early),
+      weighted_mean(eligible_icu_patients$lactate[early_idx], w_early),
+      weighted_mean(eligible_icu_patients$map[early_idx], w_early)
+    )
+  )
+
+  # Compute weighted 28-day mortality risk in each treatment group.
+  # weighted.mean() from base R computes a weighted average.
+  weighted_mortality_risk_early <- weighted.mean(
+    eligible_icu_patients$death_28d[early_idx],
+    w_early
+  )
+
+  weighted_mortality_risk_no_early <- weighted.mean(
+    eligible_icu_patients$death_28d[no_early_idx],
+    w_no_early
+  )
+
+  weighted_mortality_risks <- tibble(
+    treatment_strategy = c("Early vasopressor", "No early vasopressor"),
+    patient_count = nrow(eligible_icu_patients),
+    weighted_mortality_risk_28d = c(
+      weighted_mortality_risk_early,
+      weighted_mortality_risk_no_early
+    )
+  )
+
+  # Compute the IPTW effect estimates.
+  iptw_mortality_effect_estimates <- tibble(
+    estimate = c(
+      "IPTW 28-day mortality risk, early vasopressor",
+      "IPTW 28-day mortality risk, no early vasopressor",
+      "IPTW risk difference",
+      "IPTW risk ratio"
+    ),
+    value = c(
+      weighted_mortality_risk_early,
+      weighted_mortality_risk_no_early,
+      weighted_mortality_risk_early - weighted_mortality_risk_no_early,
+      weighted_mortality_risk_early / weighted_mortality_risk_no_early
+    )
+  )
+
+  list(
+    eligible_icu_patients = eligible_icu_patients,
+    propensity_score_model = propensity_score_model,
+    weight_summary = weight_summary,
+    baseline_balance = baseline_balance,
+    weighted_mortality_risks = weighted_mortality_risks,
+    iptw_mortality_effect_estimates = iptw_mortality_effect_estimates
+  )
+}

R/estimate_standardized_vasopressor_mortality_effect.R

@@ -0,0 +1,112 @@
+suppressPackageStartupMessages({
+  library(dplyr)
+  library(tibble)
+})
+
+# estimate_standardized_vasopressor_mortality_effect() estimates a simple
+# adjusted mortality effect using outcome regression and standardization.
+#
+# Standardization asks a target-trial-style question:
+# "Among the same eligible ICU patients, what would the average 28-day mortality
+# risk be if everyone followed the early vasopressor strategy versus if everyone
+# followed the no early vasopressor strategy?"
+#
+# This is also called g-computation in this simple baseline-treatment setting.
+# It is our first adjusted analysis, so it is intentionally simple and explicit.
+#
+# Arguments:
+# - icu_data: a data frame or tibble with the columns created by
+#   simulate_icu_cohort().
+#
+# Returns:
+# - A named list with four pieces:
+#   - eligible_icu_patients: only the target-trial eligible patients.
+#   - mortality_outcome_model: the fitted logistic regression model.
+#   - standardized_mortality_risks: average predicted 28-day mortality risk
+#     under each treatment strategy.
+#   - standardized_mortality_effect_estimates: standardized risk difference and
+#     risk ratio.
+#
+# Example REPL use:
+#
+#   source("R/simulate_icu_cohort.R")
+#   icu_data <- simulate_icu_cohort(n_patients = 1000, seed = 20260531)
+#   standardized_analysis <- estimate_standardized_vasopressor_mortality_effect(icu_data)
+#   standardized_analysis$standardized_mortality_effect_estimates
+#
+estimate_standardized_vasopressor_mortality_effect <- function(icu_data) {
+  eligible_icu_patients <- icu_data |>
+    filter(eligible == 1)
+
+  # glm() fits a generalized linear model.
+  # family = binomial() makes this a logistic regression for a 0/1 outcome.
+  # The model adjusts for baseline severity variables that affect both treatment
+  # decisions and mortality risk.
+  mortality_outcome_model <- glm(
+    death_28d ~ early_vasopressor + age + sex + sofa_score + lactate + map,
+    data = eligible_icu_patients,
+    family = binomial()
+  )
+
+  # Make two copies of the same eligible patients.
+  # The only thing we change is the treatment strategy column.
+  # This creates two counterfactual prediction datasets.
+  eligible_patients_if_early_vasopressor <- eligible_icu_patients |>
+    mutate(early_vasopressor = 1)
+
+  eligible_patients_if_no_early_vasopressor <- eligible_icu_patients |>
+    mutate(early_vasopressor = 0)
+
+  # predict(..., type = "response") returns predicted probabilities from the
+  # logistic regression model, not log-odds.
+  predicted_mortality_if_early_vasopressor <- predict(
+    mortality_outcome_model,
+    newdata = eligible_patients_if_early_vasopressor,
+    type = "response"
+  )
+
+  predicted_mortality_if_no_early_vasopressor <- predict(
+    mortality_outcome_model,
+    newdata = eligible_patients_if_no_early_vasopressor,
+    type = "response"
+  )
+
+  standardized_mortality_risk_early_vasopressor <- mean(
+    predicted_mortality_if_early_vasopressor
+  )
+
+  standardized_mortality_risk_no_early_vasopressor <- mean(
+    predicted_mortality_if_no_early_vasopressor
+  )
+
+  standardized_mortality_risks <- tibble(
+    treatment_strategy = c("Early vasopressor", "No early vasopressor"),
+    patient_count = nrow(eligible_icu_patients),
+    standardized_mortality_risk_28d = c(
+      standardized_mortality_risk_early_vasopressor,
+      standardized_mortality_risk_no_early_vasopressor
+    )
+  )
+
+  standardized_mortality_effect_estimates <- tibble(
+    estimate = c(
+      "Standardized 28-day mortality risk, early vasopressor",
+      "Standardized 28-day mortality risk, no early vasopressor",
+      "Standardized risk difference",
+      "Standardized risk ratio"
+    ),
+    value = c(
+      standardized_mortality_risk_early_vasopressor,
+      standardized_mortality_risk_no_early_vasopressor,
+      standardized_mortality_risk_early_vasopressor - standardized_mortality_risk_no_early_vasopressor,
+      standardized_mortality_risk_early_vasopressor / standardized_mortality_risk_no_early_vasopressor
+    )
+  )
+
+  list(
+    eligible_icu_patients = eligible_icu_patients,
+    mortality_outcome_model = mortality_outcome_model,
+    standardized_mortality_risks = standardized_mortality_risks,
+    standardized_mortality_effect_estimates = standardized_mortality_effect_estimates
+  )
+}

R/simulate_icu_cohort_longitudinal.R

@@ -0,0 +1,124 @@
+suppressPackageStartupMessages({
+  library(dplyr)
+  library(tidyr)
+})
+
+# simulate_icu_cohort_longitudinal() generates a sparse longitudinal dataset
+# for the ICU septic shock teaching example.
+#
+# It reuses simulate_icu_cohort() for the baseline data-generating process so
+# that cross-sectional and longitudinal results are directly comparable.
+# Then it adds time-varying covariates, treatment timing, and censoring events
+# at sparse time points.
+#
+# A "longitudinal" dataset has multiple rows per patient: one row for each
+# time at which a variable was measured or an event could occur.
+#
+# Arguments:
+# - n_patients: how many ICU patients to simulate.
+# - seed: reproducibility seed.
+#
+# Returns:
+# - A tibble with one row per patient per time point.
+# - Time points: 0h, 2h, 6h, 12h, 24h, day7, day14, day21, day28.
+# - Columns include baseline variables, time-varying covariates,
+#   treatment indicators, and censoring/outcome variables.
+#
+# Example REPL use:
+#
+#   source("R/simulate_icu_cohort.R")
+#   source("R/simulate_icu_cohort_longitudinal.R")
+#   long_data <- simulate_icu_cohort_longitudinal(n_patients = 5, seed = 1)
+#   long_data |> filter(patient_id == 1)
+#
+simulate_icu_cohort_longitudinal <- function(n_patients = 1000, seed = 20260531) {
+  # Step 1: Generate baseline cross-sectional data.
+  # simulate_icu_cohort() handles set.seed() and the full baseline DGP.
+  # By calling it here, we guarantee that the baseline columns are identical
+  # to those produced by the cross-sectional notebook workflows.
+  patients <- simulate_icu_cohort(n_patients = n_patients, seed = seed)
+
+  # Step 2: Add the longitudinal-specific variable.
+  # Some 28-day deaths occur before the 2-hour treatment window closes.
+  # This creates censoring for the per-protocol analysis.
+  # Only patients who die by day 28 can die early; the probability is 15%.
+  patients <- patients |>
+    mutate(
+      death_before_2h = ifelse(death_28d == 1, rbinom(n(), 1, 0.15), 0)
+    )
+
+  # Step 3: Define sparse time points for longitudinal follow-up.
+  # We measure at clinically meaningful intervals during the first day,
+  # then weekly until day 28.
+  time_grid <- tibble(
+    time_hours = c(0, 2, 6, 12, 24, 168, 336, 504, 672),
+    time_label = c("0h", "2h", "6h", "12h", "24h", "day7", "day14", "day21", "day28")
+  )
+
+  # Step 4: Expand each patient to all time points.
+  # crossing() creates the Cartesian product: every patient paired with every
+  # time point. This is a standard tidyverse way to build a longitudinal grid.
+  longitudinal <- patients |>
+    crossing(time_grid) |>
+    arrange(patient_id, time_hours)
+
+  # Step 5: Add time-varying indicators.
+  # These depend on the patient's actual treatment timing and baseline values.
+  longitudinal <- longitudinal |>
+    mutate(
+      # Has vasopressor therapy started by this time point?
+      vasopressor_started = as.integer(time_hours >= time_to_vasopressor_hours),
+
+      # Time-varying MAP: improves modestly after vasopressors start.
+      # this is a huge assumption/limitation to the simulation dataset, since some
+      # patients will get better, some stay same, and some worse
+      map_current = case_when(
+        vasopressor_started == 1 ~ pmin(map + 5 + rnorm(n(), mean = 0, sd = 3), 95),
+        TRUE ~ pmax(map - 1 + rnorm(n(), mean = 0, sd = 3), 35)
+      ) |>
+        round(1),
+
+      # Time-varying lactate: decreases modestly after vasopressors start.
+      lactate_current = case_when(
+        vasopressor_started == 1 ~ pmax(lactate - 0.5 + rnorm(n(), mean = 0, sd = 0.3), 0.5),
+        TRUE ~ pmin(lactate + 0.2 + rnorm(n(), mean = 0, sd = 0.3), 15)
+      ) |>
+        round(1),
+
+      # Alive indicator: 0 if the patient has died by this time point.
+      # Simplified: death_before_2h occurs at 2h; all other deaths at day 28.
+      alive = case_when(
+        death_before_2h == 1 & time_hours > 2 ~ 0,
+        death_28d == 1 & time_hours > 672 ~ 0,
+        TRUE ~ 1
+      )
+    )
+
+  # Step 6: Select columns for the analytic dataset.
+  # We drop intermediate helper columns (severity_score, prob_early_vasopressor,
+  # mortality_linear_predictor, prob_death_28d) so learners focus on the
+  # observable variables.
+  longitudinal |>
+    select(
+      patient_id,
+      time_hours,
+      time_label,
+      age,
+      sex,
+      sofa_score,
+      lactate,
+      map,
+      lactate_current,
+      map_current,
+      suspected_sepsis,
+      hypotension_at_baseline,
+      elevated_lactate_at_baseline,
+      eligible,
+      early_vasopressor,
+      time_to_vasopressor_hours,
+      vasopressor_started,
+      death_before_2h,
+      death_28d,
+      alive
+    )
+}

notebooks/01_target_trial_basics.qmd

@@ -3,6 +3,7 @@ title: "Target Trial Basics: Early Vasopressors in Septic Shock"
 format:
   html:
     embed-resources: true
+  docx: default
 execute:
   echo: true
   warning: false

notebooks/02_explore_simulated_data.qmd

@@ -3,6 +3,7 @@ title: "Explore Simulated ICU Data"
 format:
   html:
     embed-resources: true
+  docx: default
 execute:
   echo: true
   warning: false

notebooks/03_why_naive_analysis_is_biased.qmd

@@ -0,0 +1,217 @@
+---
+title: "Why The Naive Analysis Is Biased"
+format:
+  html:
+    embed-resources: true
+  docx: default
+execute:
+  echo: true
+  warning: false
+  message: false
+---
+
+## Goal
+
+This notebook shows why the naive mortality comparison can be biased.
+
+The key idea is **confounding by indication**: sicker ICU patients are more likely to receive early vasopressors, and sicker ICU patients are also more likely to die.
+
+## Setup
+
+```{r}
+suppressPackageStartupMessages({
+  library(dplyr)
+  library(gt)
+  library(gtsummary)
+  library(tibble)
+})
+
+source("../R/simulate_icu_cohort.R")
+source("../R/estimate_naive_vasopressor_mortality_effect.R")
+source("../R/estimate_standardized_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)
+
+eligible_icu_patients <- naive_mortality_analysis$eligible_icu_patients
+```
+
+Both analyses use the same eligible ICU patients.
+
+The naive analysis compares observed treatment groups directly.
+
+The standardized analysis uses an outcome model to compare two treatment strategies in the same eligible cohort.
+
+## Baseline Imbalance
+
+```{r}
+eligible_icu_patients |>
+  mutate(
+    early_vasopressor = factor(
+      early_vasopressor,
+      levels = c(0, 1),
+      labels = c("No early vasopressor", "Early vasopressor")
+    )
+  ) |>
+  select(early_vasopressor, age, sex, sofa_score, lactate, map, death_28d) |>
+  tbl_summary(
+    by = early_vasopressor,
+    statistic = list(
+      all_continuous() ~ "{mean} ({sd})",
+      all_categorical() ~ "{n} ({p}%)"
+    ),
+    missing = "no"
+  ) |>
+  add_overall()
+```
+
+The early vasopressor group is generally older and sicker.
+
+That matters because age, SOFA score, lactate, and MAP are also predictors of 28-day mortality.
+
+## Naive Mortality Effect Estimates
+
+```{r}
+naive_mortality_analysis$mortality_effect_estimates |>
+  gt() |>
+  tab_header(title = "Naive Mortality Effect Estimates") |>
+  cols_label(
+    estimate = "Estimate",
+    value = "Value"
+  ) |>
+  fmt_number(columns = value, decimals = 3)
+```
+
+The naive estimate does not compare like with like.
+
+It compares patients who actually received early vasopressors with patients who did not, even though those groups differ in baseline severity.
+
+## Outcome Model Used For Standardization
+
+```{r}
+mortality_model_coefficients <- summary(
+  standardized_mortality_analysis$mortality_outcome_model
+)$coefficients |>
+  as.data.frame() |>
+  rownames_to_column("model_term") |>
+  as_tibble()
+
+names(mortality_model_coefficients) <- c(
+  "model_term",
+  "log_odds_estimate",
+  "standard_error",
+  "z_statistic",
+  "p_value"
+)
+
+mortality_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 = "Mortality Outcome 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
+  )
+```
+
+This logistic regression models 28-day mortality using observed treatment and baseline severity variables.
+
+The model is not the target trial by itself. It is a tool for predicting mortality risk under each treatment strategy while holding the eligible patient population fixed.
+
+## Standardized Mortality Risks
+
+```{r}
+standardized_mortality_analysis$standardized_mortality_risks |>
+  gt() |>
+  tab_header(title = "Standardized 28-Day Mortality Risks") |>
+  cols_label(
+    treatment_strategy = "Treatment strategy",
+    patient_count = "Eligible patients",
+    standardized_mortality_risk_28d = "Standardized mortality risk"
+  ) |>
+  fmt_integer(columns = patient_count) |>
+  fmt_number(columns = standardized_mortality_risk_28d, decimals = 3)
+```
+
+These risks answer a target-trial-style question:
+
+What would the average mortality risk be if the same eligible patients all followed one strategy versus the other?
+
+## Standardized Mortality Effect Estimates
+
+```{r}
+standardized_mortality_analysis$standardized_mortality_effect_estimates |>
+  gt() |>
+  tab_header(title = "Standardized Mortality Effect Estimates") |>
+  cols_label(
+    estimate = "Estimate",
+    value = "Value"
+  ) |>
+  fmt_number(columns = value, decimals = 3)
+```
+
+The standardized risk difference is less distorted by baseline severity imbalance than the naive risk difference.
+
+This does not make the estimate automatically correct, but it is closer to the target trial question than a direct treated-versus-untreated comparison.
+
+## Naive Versus Standardized Estimates
+
+```{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)
+
+effect_estimate_comparison <- tibble(
+  method = c("Naive observed comparison", "Outcome regression standardization"),
+  risk_difference = c(naive_risk_difference, standardized_risk_difference),
+  risk_ratio = c(naive_risk_ratio, standardized_risk_ratio)
+)
+
+effect_estimate_comparison |>
+  gt() |>
+  tab_header(title = "Naive Versus Standardized 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)
+```
+
+In the simulated data-generating process, early vasopressors have a modest protective effect.
+
+The naive comparison can still make early vasopressors look harmful because early-treated patients are more severely ill at baseline.
+
+Standardization partially addresses that problem by comparing treatment strategies in the same eligible patient population.
+
+## Next Step
+
+The next tutorial step is to connect this back to target trial emulation mechanics: time zero, eligibility, and treatment assignment windows.
+
+After that, we can introduce inverse probability weighting from first principles.

notebooks/04_inverse_probability_weighting.qmd

@@ -0,0 +1,275 @@
+---
+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.

notebooks/05_treatment_assignment_windows.qmd

@@ -0,0 +1,206 @@
+---
+title: "Treatment Assignment Windows and Cloning"
+format:
+  html:
+    embed-resources: true
+  docx: default
+execute:
+  echo: true
+  warning: false
+  message: false
+---
+
+## Goal
+
+This notebook introduces two core target trial emulation mechanics:
+
+1. **Treatment assignment windows** (the grace period): the time during which a treatment decision is made.
+2. **Cloning**: at time zero, each eligible patient is duplicated into every treatment arm under study.
+
+These ideas move us from a cross-sectional baseline comparison to a longitudinal design that more closely emulates a randomized trial.
+
+## Setup
+
+```{r}
+suppressPackageStartupMessages({
+  library(dplyr)
+  library(gt)
+  library(tibble)
+  library(tidyr)
+})
+
+source("../R/simulate_icu_cohort.R")
+source("../R/simulate_icu_cohort_longitudinal.R")
+source("../R/clone_trial_arms.R")
+```
+
+## Simulate Longitudinal Data
+
+We now generate data with multiple rows per patient: one row for each time point at which we could observe a measurement or event.
+
+Time points:
+
+- `0h` — ICU admission (baseline)
+- `2h` — end of the treatment decision window
+- `6h, 12h, 24h` — early ICU course
+- `day7, day14, day21, day28` — outcome assessment
+
+```{r}
+longitudinal_data <- simulate_icu_cohort_longitudinal(n_patients = 1000, seed = 20260531)
+
+longitudinal_data |>
+  filter(patient_id == 1)
+```
+
+Each row shows the patient's state at one time point.
+
+Notice:
+
+- `vasopressor_started` is `0` before the treatment time and `1` after.
+- `map_current` and `lactate_current` evolve slightly once vasopressors start.
+- `alive` becomes `0` after death (if the patient died before day 28).
+
+## Three Example Patient Trajectories
+
+To see the structure more clearly, here are three patients side by side.
+
+```{r}
+example_patients <- longitudinal_data |>
+  filter(patient_id %in% c(1, 5, 10))
+
+example_patients |>
+  select(
+    patient_id, time_label, vasopressor_started,
+    map, map_current, lactate, lactate_current,
+    alive, death_28d
+  ) |>
+  gt() |>
+  tab_header(title = "Example Patient Trajectories") |>
+  cols_label(
+    patient_id = "Patient ID",
+    time_label = "Time",
+    vasopressor_started = "Vasopressors started",
+    map = "Baseline MAP",
+    map_current = "Current MAP",
+    lactate = "Baseline lactate",
+    lactate_current = "Current lactate",
+    alive = "Alive",
+    death_28d = "Death by day 28"
+  )
+```
+
+These trajectories show that treatment is not assigned instantaneously at time zero.
+
+Instead, there is a **grace period** (0 to 2 hours) during which clinicians decide whether to start vasopressors.
+
+## What Is a Grace Period?
+
+In the target trial we want to emulate:
+
+- **Strategy A**: start vasopressors within 2 hours of ICU admission.
+- **Strategy B**: do not start vasopressors within 2 hours of ICU admission.
+
+The **2-hour window** is the treatment assignment window, also called the grace period.
+
+During this window, patients may receive monitoring, fluid resuscitation, and other care. The treatment decision is made based on the patient's response.
+
+In the observational data, some patients start vasopressors at hour 0, some at hour 1.5, and some never start them within 2 hours.
+
+The grace period is what makes this a longitudinal problem rather than a simple baseline cross-section.
+
+## Clone the Eligible Patients
+
+To emulate a randomized trial, we duplicate each eligible patient at time zero into two **clones**:
+
+- **Clone "early"**: this patient is assigned to the early vasopressor strategy.
+- **Clone "no_early"**: this patient is assigned to the no early vasopressor strategy.
+
+Both clones then follow the patient's actual observed trajectory over time.
+
+```{r}
+clones <- clone_trial_arms(longitudinal_data)
+
+clones$clone_baseline |>
+  count(clone_strategy)
+```
+
+Every eligible patient now has two rows in `clone_baseline`, one for each strategy.
+
+## Censoring Rules
+
+A clone is **censored** if the patient deviated from the assigned strategy or died before the treatment window closed.
+
+### Rule 1: Protocol deviation
+
+- The "early" clone is censored if the patient did NOT actually start vasopressors within 2 hours.
+- The "no_early" clone is censored if the patient DID actually start vasopressors within 2 hours.
+
+### Rule 2: Death before treatment
+
+- Both clones are censored if the patient died before the 2-hour window closed.
+
+```{r}
+clones$clone_baseline |>
+  count(clone_strategy, clone_censored, clone_censored_reason) |>
+  gt() |>
+  tab_header(title = "Censoring Summary by Clone Strategy") |>
+  cols_label(
+    clone_strategy = "Clone strategy",
+    clone_censored = "Censored",
+    clone_censored_reason = "Censoring reason",
+    n = "Count"
+  )
+```
+
+This table shows how many clones are censored and why.
+
+Protocol deviation is the most common reason because the observational data does not perfectly align with either strategy.
+
+## One Patient, Two Clones
+
+To make the cloning concrete, here is patient 1 at time zero, before any censoring is applied.
+
+```{r}
+clones$clone_baseline |>
+  filter(patient_id == 1) |>
+  select(
+    patient_id, clone_strategy, age, sex, sofa_score,
+    lactate, map, early_vasopressor, clone_censored, clone_censored_reason
+  ) |>
+  gt() |>
+  tab_header(title = "Patient 1: Two Clones at Time Zero") |>
+  cols_label(
+    patient_id = "Patient ID",
+    clone_strategy = "Clone strategy",
+    age = "Age",
+    sex = "Sex",
+    sofa_score = "SOFA",
+    lactate = "Lactate",
+    map = "MAP",
+    early_vasopressor = "Observed early treatment",
+    clone_censored = "Clone censored?",
+    clone_censored_reason = "Reason"
+  )
+```
+
+Both clones share the same baseline characteristics because they come from the same patient.
+
+They differ only in the strategy they are assigned to.
+
+## What We Have So Far
+
+At this point in the target trial emulation:
+
+1. We identified eligible patients at ICU admission (time zero).
+2. We cloned each eligible patient into two treatment arms.
+3. We applied censoring rules at the 2-hour mark.
+4. Uncensored clones continue to follow the patient's trajectory.
+5. Censored clones drop out and do not contribute to later time points.
+
+The next step is to account for the fact that censoring is not random.
+
+Some patients are more likely to be censored because of their baseline severity. We handle that with **inverse probability of censoring weighting (IPCW)** in the next notebook.
+
+## Next Step
+
+The next tutorial step is to compute inverse probability of treatment and censoring weights on the cloned dataset, and estimate a per-protocol effect that accounts for both baseline confounding and informative censoring.

notebooks/06_censoring_and_ipcw.qmd

@@ -0,0 +1,265 @@
+---
+title: "Censoring and Inverse Probability of Censoring Weighting"
+format:
+  html:
+    embed-resources: true
+  docx: default
+execute:
+  echo: true
+  warning: false
+  message: false
+---
+
+## Goal
+
+This notebook adds **inverse probability of censoring weighting (IPCW)** to the cloned dataset from notebook 05.
+
+The key idea is that clones are censored for a reason: sicker patients might die before the 2-hour window closes, or clinicians might deviate from the protocol based on severity.
+
+IPCW weights the uncensored clones so they represent the full population that started in each trial arm.
+
+## Setup
+
+```{r}
+suppressPackageStartupMessages({
+  library(dplyr)
+  library(gt)
+  library(tibble)
+  library(tidyr)
+})
+
+source("../R/simulate_icu_cohort.R")
+source("../R/simulate_icu_cohort_longitudinal.R")
+source("../R/clone_trial_arms.R")
+source("../R/estimate_iptw_and_ipcw_effect.R")
+source("../R/estimate_iptw_vasopressor_mortality_effect.R")
+```
+
+## Simulate, Clone, and Weight
+
+```{r}
+longitudinal_data <- simulate_icu_cohort_longitudinal(n_patients = 1000, seed = 20260531)
+clones <- clone_trial_arms(longitudinal_data)
+weighted_effects <- estimate_iptw_and_ipcw_effect(clones$clone_baseline)
+```
+
+## Propensity Score Model (IPTW)
+
+The IPTW model predicts the probability of receiving early vasopressors given baseline confounders.
+
+It is identical in purpose to the model in notebook 04, but it is now applied to the **cloned** dataset.
+
+Because both clones of the same patient share the same observed treatment, we fit the model once per patient, then assign the propensity score to both clones.
+
+```{r}
+propensity_coefficients <- summary(
+  weighted_effects$propensity_score_model
+)$coefficients |>
+  as.data.frame() |>
+  rownames_to_column("model_term") |>
+  as_tibble()
+
+names(propensity_coefficients) <- c(
+  "model_term",
+  "log_odds_estimate",
+  "standard_error",
+  "z_statistic",
+  "p_value"
+)
+
+propensity_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 (Treatment Assignment)") |>
+  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 lactate are associated with a higher probability of early vasopressors.
+
+This is the same confounding pattern we adjusted for in notebook 04.
+
+## Censoring Model (IPCW)
+
+The IPCW model predicts the probability that a clone is censored at the 2-hour mark.
+
+Censoring can happen for two reasons:
+
+1. **Protocol deviation**: the patient did not follow the assigned clone strategy.
+2. **Death before treatment**: the patient died before the 2-hour window closed.
+
+Both reasons may depend on baseline severity, so we model censoring using the same confounders plus the clone strategy.
+
+```{r}
+censoring_coefficients <- summary(
+  weighted_effects$censoring_model
+)$coefficients |>
+  as.data.frame() |>
+  rownames_to_column("model_term") |>
+  as_tibble()
+
+names(censoring_coefficients) <- c(
+  "model_term",
+  "log_odds_estimate",
+  "standard_error",
+  "z_statistic",
+  "p_value"
+)
+
+censoring_coefficients |>
+  mutate(odds_ratio = exp(log_odds_estimate)) |>
+  select(model_term, log_odds_estimate, odds_ratio, standard_error, p_value) |>
+  gt() |>
+  tab_header(title = "Censoring Model (Probability of Being Censored at 2 Hours)") |>
+  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
+  )
+```
+
+A positive coefficient means the factor is associated with a **higher** probability of being censored.
+
+If sicker patients (higher SOFA, higher lactate) are more likely to be censored, the IPCW weight will give more weight to the uncensored sicker patients so the analysis represents the full population.
+
+## Combined Weight Diagnostics
+
+The combined weight for each clone is:
+
+`combined_weight = IPTW_weight × IPCW_weight`
+
+- IPTW balances baseline confounders across treatment arms.
+- IPCW accounts for informative censoring.
+
+Extreme weights indicate either a positivity problem (some patients have near-zero probability of treatment or near-zero probability of remaining uncensored) or model misspecification.
+
+```{r}
+weighted_effects$weight_diagnostics |>
+  gt() |>
+  tab_header(title = "Combined IPTW + IPCW Weight Diagnostics") |>
+  cols_label(
+    clone_strategy = "Clone strategy",
+    n_clones = "Clones",
+    min_weight = "Minimum weight",
+    max_weight = "Maximum weight",
+    mean_weight = "Mean weight",
+    median_weight = "Median weight"
+  ) |>
+  fmt_integer(columns = n_clones) |>
+  fmt_number(columns = c(min_weight, max_weight, mean_weight, median_weight), decimals = 3)
+```
+
+If the maximum weights are very large, we would consider trimming them (capping at the 99th percentile) or stabilizing them.
+
+For this teaching example the weights are moderate, so we proceed.
+
+## Weighted Mortality Risks
+
+Using the combined weights, we compute the weighted 28-day mortality risk in each clone arm.
+
+Only uncensored clones are included in the numerator, but their weights account for the censored clones who would have had similar outcomes.
+
+```{r}
+weighted_effects$weighted_effect_estimates |>
+  head(2) |>
+  gt() |>
+  tab_header(title = "IPTW + IPCW 28-Day Mortality Risks") |>
+  cols_label(
+    estimate = "Estimate",
+    value = "Value"
+  ) |>
+  fmt_number(columns = value, decimals = 3)
+```
+
+These are **per-protocol** risks: the risk under each strategy for patients who were able to follow the strategy through the 2-hour window.
+
+## IPTW + IPCW Mortality Effect Estimates
+
+```{r}
+weighted_effects$weighted_effect_estimates |>
+  tail(2) |>
+  gt() |>
+  tab_header(title = "IPTW + IPCW Mortality Effect Estimates") |>
+  cols_label(
+    estimate = "Estimate",
+    value = "Value"
+  ) |>
+  fmt_number(columns = value, decimals = 3)
+```
+
+## Comparison with Cross-Sectional IPTW
+
+How does the longitudinal IPTW + IPCW estimate compare with the cross-sectional IPTW estimate from notebook 04?
+
+```{r}
+# Pull the cross-sectional IPTW estimate from notebook 04
+icu_data <- simulate_icu_cohort(n_patients = 1000, seed = 20260531)
+iptw_analysis <- estimate_iptw_vasopressor_mortality_effect(icu_data)
+
+cross_sectional_rd <- iptw_analysis$iptw_mortality_effect_estimates |>
+  filter(estimate == "IPTW risk difference") |>
+  pull(value)
+
+cross_sectional_rr <- iptw_analysis$iptw_mortality_effect_estimates |>
+  filter(estimate == "IPTW risk ratio") |>
+  pull(value)
+
+longitudinal_rd <- weighted_effects$weighted_effect_estimates |>
+  filter(estimate == "IPTW + IPCW risk difference") |>
+  pull(value)
+
+longitudinal_rr <- weighted_effects$weighted_effect_estimates |>
+  filter(estimate == "IPTW + IPCW risk ratio") |>
+  pull(value)
+
+comparison <- tibble(
+  method = c("Cross-sectional IPTW", "Longitudinal IPTW + IPCW"),
+  risk_difference = c(cross_sectional_rd, longitudinal_rd),
+  risk_ratio = c(cross_sectional_rr, longitudinal_rr)
+)
+
+comparison |>
+  gt() |>
+  tab_header(title = "Cross-Sectional Versus Longitudinal IPTW 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
+
+- The **cross-sectional IPTW** estimate treats the treatment as assigned at baseline, with no treatment window.
+- The **longitudinal IPTW + IPCW** estimate respects the grace period, censors protocol deviations, and reweights for informative censoring.
+- The two estimates may differ because the longitudinal design removes patients who could not adhere to the assigned strategy, and the IPCW adjustment accounts for the severity of those who were censored.
+
+Both are valid approaches, but they answer slightly different questions:
+
+- Cross-sectional IPTW answers: "What is the effect of receiving early vasopressors versus not, among all eligible patients?"
+- Longitudinal IPTW + IPCW answers: "What is the effect of the early vasopressor strategy versus the no early vasopressor strategy, among patients who can adhere to the strategy through the 2-hour window?"
+
+The second is closer to the **per-protocol effect** of the target trial.
+
+## Next Step
+
+The next tutorial step is to put the full pipeline together in one place: simulate, clone, weight, and estimate.
+
+We will also compare all four methods we have learned so far: naive, standardized, cross-sectional IPTW, and longitudinal IPTW + IPCW.

notebooks/07_full_emulation_pipeline.qmd

@@ -0,0 +1,202 @@
+---
+title: "Full Emulation Pipeline"
+format:
+  html:
+    embed-resources: true
+  docx: default
+execute:
+  echo: true
+  warning: false
+  message: false
+---
+
+## Goal
+
+This notebook puts the entire target trial emulation pipeline together in one place:
+
+1. Simulate the observational data.
+2. Define eligibility at time zero.
+3. Clone eligible patients into treatment arms.
+4. Apply censoring rules at the 2-hour mark.
+5. Compute IPTW + IPCW weights.
+6. Estimate the per-protocol effect.
+
+Then we compare all four methods we have learned so far.
+
+## Setup
+
+```{r}
+suppressPackageStartupMessages({
+  library(dplyr)
+  library(gt)
+  library(tibble)
+  library(tidyr)
+})
+
+source("../R/simulate_icu_cohort.R")
+source("../R/simulate_icu_cohort_longitudinal.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")
+source("../R/clone_trial_arms.R")
+source("../R/estimate_iptw_and_ipcw_effect.R")
+```
+
+## Step 1: Simulate Data
+
+We generate both the cross-sectional and longitudinal datasets using the same seed.
+
+```{r}
+icu_data <- simulate_icu_cohort(n_patients = 1000, seed = 20260531)
+longitudinal_data <- simulate_icu_cohort_longitudinal(n_patients = 1000, seed = 20260531)
+```
+
+## Step 2: Cross-Sectional Estimates
+
+### Naive comparison
+
+```{r}
+naive_analysis <- estimate_naive_vasopressor_mortality_effect(icu_data)
+```
+
+### Outcome regression standardization
+
+```{r}
+standardized_analysis <- estimate_standardized_vasopressor_mortality_effect(icu_data)
+```
+
+### Cross-sectional IPTW
+
+```{r}
+iptw_analysis <- estimate_iptw_vasopressor_mortality_effect(icu_data)
+```
+
+## Step 3: Longitudinal Emulation
+
+### Clone and censor
+
+```{r}
+clones <- clone_trial_arms(longitudinal_data)
+```
+
+### Compute IPTW + IPCW weights and estimate effect
+
+```{r}
+longitudinal_analysis <- estimate_iptw_and_ipcw_effect(clones$clone_baseline)
+```
+
+## Four-Way Comparison
+
+We now extract the risk difference and risk ratio from each method and place them in one table.
+
+```{r}
+# Naive
+naive_rd <- naive_analysis$mortality_effect_estimates |>
+  filter(estimate == "Naive risk difference") |>
+  pull(value)
+
+naive_rr <- naive_analysis$mortality_effect_estimates |>
+  filter(estimate == "Naive risk ratio") |>
+  pull(value)
+
+# Standardized
+std_rd <- standardized_analysis$standardized_mortality_effect_estimates |>
+  filter(estimate == "Standardized risk difference") |>
+  pull(value)
+
+std_rr <- standardized_analysis$standardized_mortality_effect_estimates |>
+  filter(estimate == "Standardized risk ratio") |>
+  pull(value)
+
+# Cross-sectional IPTW
+iptw_rd <- iptw_analysis$iptw_mortality_effect_estimates |>
+  filter(estimate == "IPTW risk difference") |>
+  pull(value)
+
+iptw_rr <- iptw_analysis$iptw_mortality_effect_estimates |>
+  filter(estimate == "IPTW risk ratio") |>
+  pull(value)
+
+# Longitudinal IPTW + IPCW
+long_rd <- longitudinal_analysis$weighted_effect_estimates |>
+  filter(estimate == "IPTW + IPCW risk difference") |>
+  pull(value)
+
+long_rr <- longitudinal_analysis$weighted_effect_estimates |>
+  filter(estimate == "IPTW + IPCW risk ratio") |>
+  pull(value)
+
+four_way <- tibble(
+  method = c(
+    "1. Naive observed comparison",
+    "2. Outcome regression standardization",
+    "3. Cross-sectional IPTW",
+    "4. Longitudinal IPTW + IPCW (per-protocol)"
+  ),
+  risk_difference = c(naive_rd, std_rd, iptw_rd, long_rd),
+  risk_ratio = c(naive_rr, std_rr, iptw_rr, long_rr)
+)
+
+four_way |>
+  gt() |>
+  tab_header(title = "Four-Way Comparison of Effect Estimation Methods") |>
+  cols_label(
+    method = "Method",
+    risk_difference = "Risk difference",
+    risk_ratio = "Risk ratio"
+  ) |>
+  fmt_number(columns = c(risk_difference, risk_ratio), decimals = 3)
+```
+
+## Interpretation
+
+### What each method answers
+
+| Method | Question it answers |
+|--------|-------------------|
+| **Naive** | "What was the mortality difference between patients who did and did not receive early vasopressors?" |
+| **Standardization** | "What would the mortality risk be if everyone followed each strategy, holding the eligible population fixed?" |
+| **Cross-sectional IPTW** | "What is the effect of receiving early vasopressors versus not, reweighted to balance confounders?" |
+| **Longitudinal IPTW + IPCW** | "What is the per-protocol effect of the early vasopressor strategy versus the no early strategy, respecting the grace period and accounting for censoring?" |
+
+### What to notice in the simulated data
+
+In the data-generating process, early vasopressors have a modest **protective** effect.
+
+1. The **naive** estimate shows **harm** (positive risk difference, risk ratio > 1). This is because sicker patients are more likely to receive early vasopressors and more likely to die — confounding by indication.
+
+2. **Standardization** and **cross-sectional IPTW** both move the estimate toward a **protective** direction, correcting for baseline confounding.
+
+3. The **longitudinal IPTW + IPCW** estimate may differ slightly from cross-sectional IPTW because it:
+   - Restricts to the per-protocol population (patients who could adhere through the 2-hour window)
+   - Re-weights for informative censoring (patients censored due to protocol deviation or early death)
+   - Respects the grace period as a longitudinal treatment assignment window
+
+None of the methods perfectly recover the true effect in a single finite sample, but the longitudinal method most closely emulates the target trial design.
+
+## Assumption Checklist
+
+Every method above relies on assumptions. A quick checklist:
+
+| Assumption | Naive | Standardized | IPTW | IPTW + IPCW |
+|------------|-------|-------------|------|-------------|
+| No unmeasured confounding | ❌ | ✅ | ✅ | ✅ |
+| Positivity (every patient has some probability of each treatment) | ❌ | ✅ | ✅ | ✅ |
+| Correct model specification | N/A | ✅ | ✅ | ✅ |
+| No informative censoring | N/A | N/A | N/A | ✅ |
+
+- **No unmeasured confounding**: We must have measured all variables that affect both treatment assignment and mortality. In a real study, this is never fully testable.
+- **Positivity**: Every patient must have a non-zero probability of receiving each treatment. Extreme propensity scores cause unstable weights.
+- **Correct model specification**: The logistic regression models must capture the true relationships between confounders, treatment, and outcome.
+- **No informative censoring (for IPCW)**: Censoring must be independent of the outcome given measured confounders. In practice, we use baseline-only IPCW here; a full analysis would include time-varying covariates.
+
+## Next Steps
+
+From here, the tutorial can extend into several directions:
+
+1. **Time-varying confounders**: Include `map_current` and `lactate_current` in the censoring model to handle post-baseline severity changes.
+2. **Survival analysis**: Model time-to-death rather than 28-day binary mortality, using Kaplan-Meier or Cox models with IPCW.
+3. **Sensitivity analysis**: Test how sensitive the results are to unmeasured confounding (e.g., E-values).
+4. **`targets` pipeline**: Convert the analysis into a reproducible pipeline with dependency tracking.
+
+These topics move the project from a teaching scaffold toward a production-ready target trial emulation workflow.

run_all.sh

@@ -18,5 +18,18 @@ Rscript "scripts/01_simulate_icu_data.R"
 
 quarto render "notebooks/01_target_trial_basics.qmd" --output-dir "../outputs/reports"
 quarto render "notebooks/02_explore_simulated_data.qmd" --output-dir "../outputs/reports"
+quarto render "notebooks/03_why_naive_analysis_is_biased.qmd" --output-dir "../outputs/reports"
+quarto render "notebooks/04_inverse_probability_weighting.qmd" --output-dir "../outputs/reports"
+quarto render "notebooks/05_treatment_assignment_windows.qmd" --output-dir "../outputs/reports"
+quarto render "notebooks/06_censoring_and_ipcw.qmd" --output-dir "../outputs/reports"
+quarto render "notebooks/07_full_emulation_pipeline.qmd" --output-dir "../outputs/reports"
+
+quarto render "notebooks/01_target_trial_basics.qmd" --to docx --output-dir "../outputs/reports"
+quarto render "notebooks/02_explore_simulated_data.qmd" --to docx --output-dir "../outputs/reports"
+quarto render "notebooks/03_why_naive_analysis_is_biased.qmd" --to docx --output-dir "../outputs/reports"
+quarto render "notebooks/04_inverse_probability_weighting.qmd" --to docx --output-dir "../outputs/reports"
+quarto render "notebooks/05_treatment_assignment_windows.qmd" --to docx --output-dir "../outputs/reports"
+quarto render "notebooks/06_censoring_and_ipcw.qmd" --to docx --output-dir "../outputs/reports"
+quarto render "notebooks/07_full_emulation_pipeline.qmd" --to docx --output-dir "../outputs/reports"
 
 printf '\nWorkflow complete. Reports are in outputs/reports/.\n'