166 lines
4.4 KiB
Plaintext
166 lines
4.4 KiB
Plaintext
---
|
|
title: "Explore Simulated ICU Data"
|
|
format:
|
|
html:
|
|
embed-resources: true
|
|
docx: default
|
|
execute:
|
|
echo: true
|
|
warning: false
|
|
message: false
|
|
---
|
|
|
|
## Goal
|
|
|
|
This notebook is for exploring the simulated ICU cohort.
|
|
|
|
The report notebook focuses on target trial components and core results. This exploratory notebook focuses on visualizing the data-generating process and understanding why the naive comparison can be biased.
|
|
|
|
## Setup
|
|
|
|
```{r}
|
|
suppressPackageStartupMessages({
|
|
library(dplyr)
|
|
library(ggplot2)
|
|
library(gt)
|
|
library(gtsummary)
|
|
library(tibble)
|
|
})
|
|
|
|
source("../R/simulate_icu_cohort.R")
|
|
source("../R/estimate_naive_vasopressor_mortality_effect.R")
|
|
```
|
|
|
|
## Simulate Data
|
|
|
|
```{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
|
|
```
|
|
|
|
## Eligibility Overview
|
|
|
|
```{r}
|
|
eligibility_overview <- icu_data |>
|
|
summarize(
|
|
simulated_patients = n(),
|
|
suspected_sepsis = sum(suspected_sepsis == 1),
|
|
hypotension_at_baseline = sum(hypotension_at_baseline == 1),
|
|
elevated_lactate_at_baseline = sum(elevated_lactate_at_baseline == 1),
|
|
eligible = sum(eligible == 1)
|
|
) |>
|
|
tidyr::pivot_longer(
|
|
cols = everything(),
|
|
names_to = "measure",
|
|
values_to = "patients"
|
|
)
|
|
|
|
eligibility_overview |>
|
|
gt() |>
|
|
tab_header(title = "Eligibility Overview") |>
|
|
cols_label(
|
|
measure = "Measure",
|
|
patients = "Patients"
|
|
) |>
|
|
fmt_integer(columns = patients)
|
|
```
|
|
|
|
## Baseline Distributions
|
|
|
|
```{r}
|
|
eligible_icu_patients |>
|
|
select(age, sofa_score, lactate, map) |>
|
|
tbl_summary(
|
|
statistic = all_continuous() ~ "{mean} ({sd}); {median} [{p25}, {p75}]",
|
|
missing = "no"
|
|
)
|
|
```
|
|
|
|
## Severity By Observed Treatment
|
|
|
|
```{r}
|
|
eligible_icu_patients |>
|
|
mutate(
|
|
observed_treatment = factor(
|
|
early_vasopressor,
|
|
levels = c(0, 1),
|
|
labels = c("No early vasopressor", "Early vasopressor")
|
|
)
|
|
) |>
|
|
ggplot(aes(x = observed_treatment, y = sofa_score, fill = observed_treatment)) +
|
|
geom_boxplot(alpha = 0.75, width = 0.65, show.legend = FALSE) +
|
|
labs(
|
|
title = "SOFA Score Is Higher In Early-Treated Patients",
|
|
x = NULL,
|
|
y = "SOFA score"
|
|
) +
|
|
theme_minimal()
|
|
```
|
|
|
|
Early vasopressor patients tend to have higher SOFA scores in this simulated cohort. That happens because the treatment assignment mechanism makes sicker patients more likely to receive early vasopressors.
|
|
|
|
## Lactate And MAP By Treatment
|
|
|
|
```{r}
|
|
eligible_icu_patients |>
|
|
mutate(
|
|
observed_treatment = factor(
|
|
early_vasopressor,
|
|
levels = c(0, 1),
|
|
labels = c("No early vasopressor", "Early vasopressor")
|
|
)
|
|
) |>
|
|
ggplot(aes(x = map, y = lactate, color = observed_treatment)) +
|
|
geom_point(alpha = 0.55) +
|
|
labs(
|
|
title = "Shock Severity Markers Differ By Observed Treatment",
|
|
x = "Mean arterial pressure",
|
|
y = "Lactate",
|
|
color = "Observed treatment"
|
|
) +
|
|
theme_minimal()
|
|
```
|
|
|
|
Higher lactate and lower MAP are both markers of greater shock severity. If treatment groups differ on these variables, a simple treated-versus-untreated comparison is not yet a causal estimate.
|
|
|
|
## Mortality By SOFA Score
|
|
|
|
```{r}
|
|
eligible_icu_patients |>
|
|
mutate(
|
|
observed_treatment = factor(
|
|
early_vasopressor,
|
|
levels = c(0, 1),
|
|
labels = c("No early vasopressor", "Early vasopressor")
|
|
)
|
|
) |>
|
|
ggplot(aes(x = sofa_score, y = death_28d, color = observed_treatment)) +
|
|
geom_jitter(height = 0.04, width = 0.15, alpha = 0.35) +
|
|
geom_smooth(method = "glm", method.args = list(family = "binomial"), se = FALSE) +
|
|
labs(
|
|
title = "Mortality Risk Rises With SOFA Score",
|
|
x = "SOFA score",
|
|
y = "Observed 28-day death",
|
|
color = "Observed treatment"
|
|
) +
|
|
theme_minimal()
|
|
```
|
|
|
|
This plot shows why baseline severity matters. If SOFA score predicts death and also affects treatment assignment, then SOFA score is a confounder for the naive treatment comparison.
|
|
|
|
## Naive Mortality Effect Estimates
|
|
|
|
```{r}
|
|
naive_mortality_analysis$mortality_effect_estimates |>
|
|
gt() |>
|
|
tab_header(title = "Naive 28-Day Mortality Effect Estimates") |>
|
|
cols_label(
|
|
estimate = "Estimate",
|
|
value = "Value"
|
|
) |>
|
|
fmt_number(columns = value, decimals = 3)
|
|
```
|
|
|
|
The next methodological step is to adjust for baseline severity rather than comparing observed treatment groups directly.
|