ready set go

2026-06-03 11:28:14 -08:00
commit 097f88f85d
22 changed files with 8793 additions and 0 deletions
@@ -0,0 +1,211 @@
+---
+title: "Target Trial Basics: Early Vasopressors in Septic Shock"
+format: html
+execute:
+  echo: true
+  warning: false
+  message: false
+---
+
+## Goal
+
+This notebook introduces the target trial we want to emulate.
+
+The clinical question is:
+
+> Among ICU patients with suspected septic shock at ICU admission, what is the effect of starting vasopressors within 2 hours compared with not starting vasopressors within 2 hours on 28-day mortality?
+
+## Setup
+
+```{r}
+library(dplyr)
+library(gt)
+library(gtsummary)
+library(readr)
+library(skimr)
+library(tibble)
+```
+
+These packages make the routine analysis code easier to read.
+
+`dplyr` handles data manipulation, `readr` reads rectangular files, `skimr` gives quick data summaries, `gt` builds display tables, and `gtsummary` builds analytic summary tables.
+
+## Why A Target Trial?
+
+Observational ICU data are not randomized.
+
+Sicker patients are often treated earlier, so a simple comparison between patients who received early vasopressors and patients who did not can be biased.
+
+The target trial framework asks us to describe the randomized trial we wish we had run, then emulate it as closely as possible using observational data.
+
+## Target Trial Protocol
+
+```{r}
+target_trial_protocol <- tribble(
+  ~component, ~definition,
+  "Eligibility criteria", "ICU admission, suspected sepsis, hypotension, elevated lactate",
+  "Time zero", "ICU admission",
+  "Treatment strategy 1", "Start vasopressors within 2 hours",
+  "Treatment strategy 2", "Do not start vasopressors within 2 hours",
+  "Outcome", "Death within 28 days",
+  "Causal contrast", "Risk difference and risk ratio"
+)
+
+target_trial_protocol |>
+  gt() |>
+  tab_header(title = "Target Trial Protocol") |>
+  cols_label(
+    component = "Component",
+    definition = "Definition"
+  )
+```
+
+`tribble()` creates a small tibble by typing the rows directly.
+
+`gt()` turns that tibble into a clearer presentation table.
+
+## Load The Simulated Cohort
+
+This first version uses a CSV generated by `scripts/01_simulate_icu_data_base_r.R`.
+
+```{r}
+icu_data <- read_csv("../data/icu_septic_shock_base_r.csv", show_col_types = FALSE)
+```
+
+`read_csv()` reads a rectangular CSV file into R.
+
+The object `icu_data` is a tibble, where each row is one ICU patient.
+
+## Inspect The Data
+
+```{r}
+icu_data |>
+  slice_head(n = 6)
+```
+
+`slice_head()` prints the first few rows so we can inspect the structure before analyzing anything.
+
+```{r}
+skim(icu_data)
+```
+
+`skim()` gives a quick summary of variable types, missingness, and distributions.
+
+## Apply Eligibility Criteria
+
+```{r}
+eligible_data <- icu_data |>
+  filter(eligible == 1)
+```
+
+`filter()` keeps rows that satisfy a condition.
+
+Here, we keep only patients who satisfy the simulated eligibility criteria.
+
+## Count Treatment Groups
+
+```{r}
+eligible_data |>
+  count(early_vasopressor)
+```
+
+`count()` counts how many eligible patients were observed under each treatment group.
+
+In this first simplified dataset:
+
+- `1` means vasopressors started within 2 hours.
+- `0` means vasopressors were not started within 2 hours.
+
+## Estimate Naive Mortality Risks
+
+```{r}
+naive_risks <- eligible_data |>
+  group_by(early_vasopressor) |>
+  summarize(
+    n_patients = n(),
+    risk_death_28d = mean(death_28d),
+    .groups = "drop"
+  )
+
+naive_risks |>
+  gt() |>
+  tab_header(title = "Naive 28-Day Mortality Risk") |>
+  cols_label(
+    early_vasopressor = "Early vasopressor",
+    n_patients = "Patients",
+    risk_death_28d = "28-day mortality risk"
+  ) |>
+  fmt_number(columns = risk_death_28d, decimals = 3)
+```
+
+Because `death_28d` is coded as 0 or 1, its mean is the proportion who died.
+
+This is a naive comparison because it does not yet adjust for the fact that treatment decisions depend on patient severity.
+
+## Estimate Naive Contrasts
+
+```{r}
+risk_early <- naive_risks |>
+  filter(early_vasopressor == 1) |>
+  pull(risk_death_28d)
+
+risk_not_early <- naive_risks |>
+  filter(early_vasopressor == 0) |>
+  pull(risk_death_28d)
+
+naive_contrasts <- tibble(
+  measure = c("Risk difference", "Risk ratio"),
+  value = c(
+    risk_early - risk_not_early,
+    risk_early / risk_not_early
+  )
+)
+
+naive_contrasts |>
+  gt() |>
+  tab_header(title = "Naive Treatment Contrast") |>
+  cols_label(
+    measure = "Measure",
+    value = "Value"
+  ) |>
+  fmt_number(columns = value, decimals = 3)
+```
+
+The risk difference is an absolute difference in 28-day mortality risk.
+
+The risk ratio is a relative comparison of 28-day mortality risk.
+
+## Check Confounding By Severity
+
+```{r}
+eligible_data |>
+  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()
+```
+
+This compares baseline severity between the two treatment groups.
+
+If early vasopressor patients have higher SOFA scores, higher lactate, or lower MAP, then the naive comparison mixes the treatment effect with baseline severity differences.
+
+That problem is one reason we need target trial emulation methods rather than a simple treated-versus-untreated comparison.
+
+## Next Step
+
+The next lesson should walk through `R/simulate_icu_cohort.R` line by line.
+
+After that, we can use `scripts/02_naive_analysis_base_r.R` to compute the first naive association and then discuss why it is not yet a causal estimate.