187 lines
5.1 KiB
Plaintext
187 lines
5.1 KiB
Plaintext
---
|
|
title: "Target Trial Basics: Early Vasopressors in Septic Shock"
|
|
format:
|
|
html:
|
|
embed-resources: true
|
|
docx: default
|
|
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() attaches a package so its functions are available by name.
|
|
# suppressPackageStartupMessages() keeps package startup text out of the report.
|
|
suppressPackageStartupMessages({
|
|
library(dplyr)
|
|
library(gt)
|
|
library(gtsummary)
|
|
library(tibble)
|
|
})
|
|
|
|
# source() loads reusable project functions from the R/ folder.
|
|
source("../R/simulate_icu_cohort.R")
|
|
source("../R/estimate_naive_vasopressor_mortality_effect.R")
|
|
```
|
|
|
|
## 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}
|
|
# tibble() creates a small rectangular dataset.
|
|
# Each named argument becomes one column.
|
|
target_trial_protocol <- tibble(
|
|
component = c(
|
|
"Eligibility criteria",
|
|
"Time zero",
|
|
"Treatment strategy 1",
|
|
"Treatment strategy 2",
|
|
"Outcome",
|
|
"Estimand"
|
|
),
|
|
definition = c(
|
|
"ICU admission, suspected sepsis, hypotension, elevated lactate",
|
|
"ICU admission",
|
|
"Start vasopressors within 2 hours",
|
|
"Do not start vasopressors within 2 hours",
|
|
"Death within 28 days",
|
|
"Risk difference and risk ratio"
|
|
)
|
|
)
|
|
|
|
target_trial_protocol |>
|
|
gt() |>
|
|
tab_header(title = "Target Trial Protocol") |>
|
|
cols_label(
|
|
component = "Component",
|
|
definition = "Definition"
|
|
)
|
|
```
|
|
|
|
## Simulate The Cohort
|
|
|
|
For this report, we call the reusable simulation function directly.
|
|
|
|
Using the same seed gives the same simulated cohort each time the notebook renders.
|
|
|
|
```{r}
|
|
icu_data <- simulate_icu_cohort(n_patients = 1000, seed = 20260531)
|
|
naive_mortality_analysis <- estimate_naive_vasopressor_mortality_effect(icu_data)
|
|
eligible_icu_patients <- naive_mortality_analysis$eligible_icu_patients
|
|
```
|
|
|
|
## Cohort Overview
|
|
|
|
```{r}
|
|
# These summary counts describe how the full simulated cohort maps onto the
|
|
# eligible target-trial cohort.
|
|
cohort_overview <- tibble(
|
|
measure = c(
|
|
"Simulated ICU patients",
|
|
"Eligible patients",
|
|
"Early vasopressor patients",
|
|
"Not early vasopressor patients"
|
|
),
|
|
value = c(
|
|
nrow(icu_data),
|
|
nrow(eligible_icu_patients),
|
|
sum(eligible_icu_patients$early_vasopressor == 1),
|
|
sum(eligible_icu_patients$early_vasopressor == 0)
|
|
)
|
|
)
|
|
|
|
cohort_overview |>
|
|
gt() |>
|
|
tab_header(title = "Cohort Overview") |>
|
|
cols_label(
|
|
measure = "Measure",
|
|
value = "Patients"
|
|
) |>
|
|
fmt_integer(columns = value)
|
|
```
|
|
|
|
## Naive Mortality Risk
|
|
|
|
```{r}
|
|
naive_mortality_analysis$mortality_risks_by_early_vasopressor |>
|
|
gt() |>
|
|
tab_header(title = "Naive 28-Day Mortality Risk") |>
|
|
cols_label(
|
|
observed_treatment_group = "Observed treatment group",
|
|
patient_count = "Patients",
|
|
mortality_risk_28d = "28-day mortality risk"
|
|
) |>
|
|
fmt_integer(columns = patient_count) |>
|
|
fmt_number(columns = mortality_risk_28d, decimals = 3)
|
|
```
|
|
|
|
This is a naive comparison because it does not yet adjust for the fact that treatment decisions depend on patient severity.
|
|
|
|
## 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 risk difference is an absolute difference in 28-day mortality risk.
|
|
|
|
The risk ratio is a relative comparison of 28-day mortality risk.
|
|
|
|
## Baseline Severity By Treatment Group
|
|
|
|
```{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()
|
|
```
|
|
|
|
Early vasopressor patients are generally sicker at baseline in this simulated observational cohort.
|
|
|
|
That means the naive comparison mixes the effect of treatment with baseline severity differences, which is why 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 extend the notebooks to show why the naive mortality effect estimates are biased and start building adjusted analyses in reusable `R/` functions.
|