Update repo

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