218 lines
6.5 KiB
Plaintext
218 lines
6.5 KiB
Plaintext
---
|
|
title: "Why The Naive Analysis Is Biased"
|
|
format:
|
|
html:
|
|
embed-resources: true
|
|
docx: default
|
|
execute:
|
|
echo: true
|
|
warning: false
|
|
message: false
|
|
---
|
|
|
|
## Goal
|
|
|
|
This notebook shows why the naive mortality comparison can be biased.
|
|
|
|
The key idea is **confounding by indication**: sicker ICU patients are more likely to receive early vasopressors, and sicker ICU patients are also more likely to die.
|
|
|
|
## Setup
|
|
|
|
```{r}
|
|
suppressPackageStartupMessages({
|
|
library(dplyr)
|
|
library(gt)
|
|
library(gtsummary)
|
|
library(tibble)
|
|
})
|
|
|
|
source("../R/simulate_icu_cohort.R")
|
|
source("../R/estimate_naive_vasopressor_mortality_effect.R")
|
|
source("../R/estimate_standardized_vasopressor_mortality_effect.R")
|
|
```
|
|
|
|
## Simulate Data And Estimate Effects
|
|
|
|
```{r}
|
|
icu_data <- simulate_icu_cohort(n_patients = 1000, seed = 20260531)
|
|
|
|
naive_mortality_analysis <- estimate_naive_vasopressor_mortality_effect(icu_data)
|
|
standardized_mortality_analysis <- estimate_standardized_vasopressor_mortality_effect(icu_data)
|
|
|
|
eligible_icu_patients <- naive_mortality_analysis$eligible_icu_patients
|
|
```
|
|
|
|
Both analyses use the same eligible ICU patients.
|
|
|
|
The naive analysis compares observed treatment groups directly.
|
|
|
|
The standardized analysis uses an outcome model to compare two treatment strategies in the same eligible cohort.
|
|
|
|
## Baseline Imbalance
|
|
|
|
```{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()
|
|
```
|
|
|
|
The early vasopressor group is generally older and sicker.
|
|
|
|
That matters because age, SOFA score, lactate, and MAP are also predictors of 28-day mortality.
|
|
|
|
## 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 naive estimate does not compare like with like.
|
|
|
|
It compares patients who actually received early vasopressors with patients who did not, even though those groups differ in baseline severity.
|
|
|
|
## Outcome Model Used For Standardization
|
|
|
|
```{r}
|
|
mortality_model_coefficients <- summary(
|
|
standardized_mortality_analysis$mortality_outcome_model
|
|
)$coefficients |>
|
|
as.data.frame() |>
|
|
rownames_to_column("model_term") |>
|
|
as_tibble()
|
|
|
|
names(mortality_model_coefficients) <- c(
|
|
"model_term",
|
|
"log_odds_estimate",
|
|
"standard_error",
|
|
"z_statistic",
|
|
"p_value"
|
|
)
|
|
|
|
mortality_model_coefficients |>
|
|
mutate(odds_ratio = exp(log_odds_estimate)) |>
|
|
select(model_term, log_odds_estimate, odds_ratio, standard_error, p_value) |>
|
|
gt() |>
|
|
tab_header(title = "Mortality Outcome Model") |>
|
|
cols_label(
|
|
model_term = "Model term",
|
|
log_odds_estimate = "Log-odds estimate",
|
|
odds_ratio = "Odds ratio",
|
|
standard_error = "Standard error",
|
|
p_value = "P-value"
|
|
) |>
|
|
fmt_number(
|
|
columns = c(log_odds_estimate, odds_ratio, standard_error, p_value),
|
|
decimals = 3
|
|
)
|
|
```
|
|
|
|
This logistic regression models 28-day mortality using observed treatment and baseline severity variables.
|
|
|
|
The model is not the target trial by itself. It is a tool for predicting mortality risk under each treatment strategy while holding the eligible patient population fixed.
|
|
|
|
## Standardized Mortality Risks
|
|
|
|
```{r}
|
|
standardized_mortality_analysis$standardized_mortality_risks |>
|
|
gt() |>
|
|
tab_header(title = "Standardized 28-Day Mortality Risks") |>
|
|
cols_label(
|
|
treatment_strategy = "Treatment strategy",
|
|
patient_count = "Eligible patients",
|
|
standardized_mortality_risk_28d = "Standardized mortality risk"
|
|
) |>
|
|
fmt_integer(columns = patient_count) |>
|
|
fmt_number(columns = standardized_mortality_risk_28d, decimals = 3)
|
|
```
|
|
|
|
These risks answer a target-trial-style question:
|
|
|
|
What would the average mortality risk be if the same eligible patients all followed one strategy versus the other?
|
|
|
|
## Standardized Mortality Effect Estimates
|
|
|
|
```{r}
|
|
standardized_mortality_analysis$standardized_mortality_effect_estimates |>
|
|
gt() |>
|
|
tab_header(title = "Standardized Mortality Effect Estimates") |>
|
|
cols_label(
|
|
estimate = "Estimate",
|
|
value = "Value"
|
|
) |>
|
|
fmt_number(columns = value, decimals = 3)
|
|
```
|
|
|
|
The standardized risk difference is less distorted by baseline severity imbalance than the naive risk difference.
|
|
|
|
This does not make the estimate automatically correct, but it is closer to the target trial question than a direct treated-versus-untreated comparison.
|
|
|
|
## Naive Versus Standardized Estimates
|
|
|
|
```{r}
|
|
naive_risk_difference <- naive_mortality_analysis$mortality_effect_estimates |>
|
|
filter(estimate == "Naive risk difference") |>
|
|
pull(value)
|
|
|
|
naive_risk_ratio <- naive_mortality_analysis$mortality_effect_estimates |>
|
|
filter(estimate == "Naive risk ratio") |>
|
|
pull(value)
|
|
|
|
standardized_risk_difference <- standardized_mortality_analysis$standardized_mortality_effect_estimates |>
|
|
filter(estimate == "Standardized risk difference") |>
|
|
pull(value)
|
|
|
|
standardized_risk_ratio <- standardized_mortality_analysis$standardized_mortality_effect_estimates |>
|
|
filter(estimate == "Standardized risk ratio") |>
|
|
pull(value)
|
|
|
|
effect_estimate_comparison <- tibble(
|
|
method = c("Naive observed comparison", "Outcome regression standardization"),
|
|
risk_difference = c(naive_risk_difference, standardized_risk_difference),
|
|
risk_ratio = c(naive_risk_ratio, standardized_risk_ratio)
|
|
)
|
|
|
|
effect_estimate_comparison |>
|
|
gt() |>
|
|
tab_header(title = "Naive Versus Standardized Mortality Effect Estimates") |>
|
|
cols_label(
|
|
method = "Method",
|
|
risk_difference = "Risk difference",
|
|
risk_ratio = "Risk ratio"
|
|
) |>
|
|
fmt_number(columns = c(risk_difference, risk_ratio), decimals = 3)
|
|
```
|
|
|
|
In the simulated data-generating process, early vasopressors have a modest protective effect.
|
|
|
|
The naive comparison can still make early vasopressors look harmful because early-treated patients are more severely ill at baseline.
|
|
|
|
Standardization partially addresses that problem by comparing treatment strategies in the same eligible patient population.
|
|
|
|
## Next Step
|
|
|
|
The next tutorial step is to connect this back to target trial emulation mechanics: time zero, eligibility, and treatment assignment windows.
|
|
|
|
After that, we can introduce inverse probability weighting from first principles.
|