update project design

R/estimate_naive_vasopressor_mortality_effect.R

@@ -0,0 +1,98 @@
+suppressPackageStartupMessages({
+  library(dplyr)
+  library(tidyr)
+})
+
+# estimate_naive_vasopressor_mortality_effect() computes the first simple
+# mortality comparison for the early vasopressor teaching example.
+#
+# This function deliberately does NOT adjust for confounding.
+# It only compares observed 28-day mortality between eligible patients who did
+# and did not receive early vasopressors.
+#
+# 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_risks_by_early_vasopressor: observed 28-day mortality risk in
+#     each treatment group.
+#   - mortality_effect_estimates: naive risk difference and risk ratio.
+#   - baseline_characteristics_by_early_vasopressor: compact baseline means by
+#     observed treatment group.
+#
+# Example REPL use:
+#
+#   source("R/simulate_icu_cohort.R")
+#   icu_data <- simulate_icu_cohort(n_patients = 1000, seed = 20260531)
+#   mortality_analysis <- estimate_naive_vasopressor_mortality_effect(icu_data)
+#   mortality_analysis$mortality_effect_estimates
+#
+estimate_naive_vasopressor_mortality_effect <- function(icu_data) {
+  eligible_icu_patients <- icu_data |>
+    filter(eligible == 1)
+
+  mortality_risks_by_early_vasopressor <- eligible_icu_patients |>
+    group_by(early_vasopressor) |>
+    summarize(
+      patient_count = n(),
+      mortality_risk_28d = mean(death_28d),
+      .groups = "drop"
+    ) |>
+    mutate(
+      observed_treatment_group = factor(
+        early_vasopressor,
+        levels = c(0, 1),
+        labels = c("No early vasopressor", "Early vasopressor")
+      )
+    ) |>
+    select(observed_treatment_group, patient_count, mortality_risk_28d)
+
+  mortality_risk_early_vasopressor <- mortality_risks_by_early_vasopressor |>
+    filter(observed_treatment_group == "Early vasopressor") |>
+    pull(mortality_risk_28d)
+
+  mortality_risk_no_early_vasopressor <- mortality_risks_by_early_vasopressor |>
+    filter(observed_treatment_group == "No early vasopressor") |>
+    pull(mortality_risk_28d)
+
+  mortality_effect_estimates <- tibble(
+    estimate = c(
+      "Eligible patients",
+      "Early vasopressor patients",
+      "No early vasopressor patients",
+      "28-day mortality risk, early vasopressor",
+      "28-day mortality risk, no early vasopressor",
+      "Naive risk difference",
+      "Naive risk ratio"
+    ),
+    value = c(
+      nrow(eligible_icu_patients),
+      sum(eligible_icu_patients$early_vasopressor == 1),
+      sum(eligible_icu_patients$early_vasopressor == 0),
+      mortality_risk_early_vasopressor,
+      mortality_risk_no_early_vasopressor,
+      mortality_risk_early_vasopressor - mortality_risk_no_early_vasopressor,
+      mortality_risk_early_vasopressor / mortality_risk_no_early_vasopressor
+    )
+  )
+
+  baseline_characteristics_by_early_vasopressor <- eligible_icu_patients |>
+    group_by(early_vasopressor) |>
+    summarize(
+      mean_age = mean(age),
+      mean_sofa_score = mean(sofa_score),
+      mean_lactate = mean(lactate),
+      mean_map = mean(map),
+      .groups = "drop"
+    )
+
+  list(
+    eligible_icu_patients = eligible_icu_patients,
+    mortality_risks_by_early_vasopressor = mortality_risks_by_early_vasopressor,
+    mortality_effect_estimates = mortality_effect_estimates,
+    baseline_characteristics_by_early_vasopressor = baseline_characteristics_by_early_vasopressor
+  )
+}

R/simulate_icu_cohort.R

@@ -1,58 +1,141 @@
-suppressPackageStartupMessages(library(dplyr))
+suppressPackageStartupMessages({
+  library(dplyr)
+})
 
+# simulate_icu_cohort() is our first reusable project primitive.
+#
+# A "primitive" is a small function that does one useful job for the project.
+# Here, the job is to create one simulated ICU observational cohort that we can
+# reuse in scripts, notebooks, and later targets pipelines.
+#
+# Arguments:
+# - n_patients: how many ICU patients to simulate.
+# - seed: a number that makes the random simulation reproducible.
+#
+# Returns:
+# - A tibble with one row per ICU patient.
+# - The columns include baseline variables, eligibility indicators, observed
+#   early vasopressor treatment, treatment timing, and 28-day mortality.
+#
+# Example REPL use:
+#
+#   source("R/simulate_icu_cohort.R")
+#   icu_data <- simulate_icu_cohort(n_patients = 5, seed = 1)
+#   icu_data
+#
+# Example output shape:
+#
+#   # A tibble: 5 x 13
+#     patient_id   age sex    sofa_score lactate   map suspected_sepsis ...
+#          <int> <dbl> <chr>       <dbl>   <dbl> <dbl>            <int> ...
+#   1          1    56 female          8     2.9    59                1 ...
+#
 simulate_icu_cohort <- function(n_patients = 1000, seed = 20260531) {
+  # set.seed() fixes the random-number stream.
+  # That means the same inputs produce the same simulated dataset each time.
   set.seed(seed)
 
+  # tibble() creates a modern data frame.
+  # Each argument below becomes a column.
+  # Each column must have either one value or n_patients values.
   tibble(
+    # seq_len(n_patients) creates patient IDs 1, 2, ..., n_patients.
     patient_id = seq_len(n_patients),
 
+    # rnorm() draws from a normal distribution.
+    # round() makes age whole-number-like.
+    # pmin() and pmax() cap ages to a plausible ICU range.
     age = round(rnorm(n_patients, mean = 65, sd = 14)) |>
       pmin(95) |>
       pmax(18),
 
-    sex = sample(c("female", "male"), size = n_patients, replace = TRUE, prob = c(0.45, 0.55)),
+    # sample() draws categorical values.
+    # replace = TRUE means each patient gets an independent draw.
+    sex = sample(
+      c("female", "male"),
+      size = n_patients,
+      replace = TRUE,
+      prob = c(0.45, 0.55)
+    ),
 
+    # rpois() draws count-like SOFA scores from a Poisson distribution.
+    # pmin(20) keeps the simulated score within a plausible upper range.
     sofa_score = rpois(n_patients, lambda = 7) |>
       pmin(20),
 
+    # rlnorm() creates right-skewed lactate values.
+    # Clinical lab values often have this kind of skew.
     lactate = round(rlnorm(n_patients, meanlog = log(3), sdlog = 0.5), 1) |>
       pmin(15),
 
+    # MAP is mean arterial pressure.
+    # Lower MAP means more hypotension and greater shock severity.
     map = round(rnorm(n_patients, mean = 62, sd = 10)) |>
       pmin(95) |>
       pmax(35),
 
+    # rbinom(..., size = 1) creates 0/1 indicators.
+    # Here 1 means suspected sepsis is present at ICU admission.
     suspected_sepsis = rbinom(n_patients, size = 1, prob = 0.90)
   ) |>
+    # mutate() adds new columns or changes existing columns.
+    # These columns depend on the baseline variables created above.
     mutate(
+      # as.integer(TRUE) is 1 and as.integer(FALSE) is 0.
       hypotension_at_baseline = as.integer(map < 65),
       elevated_lactate_at_baseline = as.integer(lactate >= 2),
+
+      # This is the simulated eligibility definition for the target trial.
+      # A patient is eligible only if all three baseline criteria are true.
       eligible = as.integer(
         suspected_sepsis == 1 &
           hypotension_at_baseline == 1 &
           elevated_lactate_at_baseline == 1
       ),
+
+      # This is not a real clinical score.
+      # It is a simulation device that makes sicker patients more likely to
+      # receive early vasopressors and more likely to die.
       severity_score = 0.04 * (age - 65) +
         0.18 * (sofa_score - 7) +
         0.25 * (lactate - 3) -
         0.04 * (map - 62),
+
+      # plogis() converts any real number into a probability between 0 and 1.
+      # Higher severity_score gives a higher chance of early vasopressors.
       prob_early_vasopressor = plogis(-0.2 + severity_score),
+
+      # This is the observed treatment group in the observational data.
+      # It is not randomized; it depends on severity through the probability above.
       early_vasopressor = rbinom(n(), size = 1, prob = prob_early_vasopressor),
+
+      # ifelse() chooses one value when the condition is TRUE and another when FALSE.
+      # Early-treated patients get a time between 0 and 2 hours.
+      # Not-early-treated patients get a time between 2 and 24 hours.
       time_to_vasopressor_hours = ifelse(
         early_vasopressor == 1,
         runif(n(), min = 0, max = 2),
         runif(n(), min = 2, max = 24)
       ) |>
         round(2),
+
+      # This linear predictor controls each patient's mortality risk.
+      # Sicker patients have higher risk; early vasopressor has a modest
+      # protective effect in the data-generating process.
       mortality_linear_predictor = -1.4 +
         0.03 * (age - 65) +
         0.20 * (sofa_score - 7) +
         0.28 * (lactate - 3) -
         0.05 * (map - 62) -
         0.25 * early_vasopressor,
+
+      # Convert the mortality linear predictor into a probability, then draw
+      # the observed 28-day death indicator.
       prob_death_28d = plogis(mortality_linear_predictor),
       death_28d = rbinom(n(), size = 1, prob = prob_death_28d)
     ) |>
+    # select() keeps the columns learners should analyze.
+    # We intentionally drop helper columns like severity_score and probabilities.
     select(
       patient_id,
       age,