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