cody/learn-tte
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

update project design

Browse Source
This commit is contained in:
cody
2026-06-03 22:06:23 -08:00
parent 49409a7d1b
commit 73e5d46c30
27 changed files with 490 additions and 8513 deletions
Download Patch File Download Diff File Expand all files Collapse all files
notebooks/01_target_trial_basics.qmd
+91 -117
View File
@@ -1,6 +1,8 @@
---
title: "Target Trial Basics: Early Vasopressors in Septic Shock"
format: html
format:
html:
embed-resources: true
execute:
echo: true
warning: false
@@ -18,18 +20,20 @@ The clinical question is:
## Setup
```{r}
library(dplyr)
library(gt)
library(gtsummary)
library(readr)
library(skimr)
library(tibble)
# 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")
```
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.
@@ -41,14 +45,25 @@ The target trial framework asks us to describe the randomized trial we wish we h
## 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"
# 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 |>
@@ -60,112 +75,73 @@ target_trial_protocol |>
)
```
`tribble()` creates a small tibble by typing the rows directly.
## Simulate The Cohort
`gt()` turns that tibble into a clearer presentation table.
For this report, we call the reusable simulation function directly.
## Load The Simulated Cohort
This first version uses a CSV generated by `scripts/01_simulate_icu_data_base_r.R`.
Using the same seed gives the same simulated cohort each time the notebook renders.
```{r}
icu_data <- read_csv("../data/icu_septic_shock_base_r.csv", show_col_types = FALSE)
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
```
`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
## Cohort Overview
```{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"),
# 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(
risk_early - risk_not_early,
risk_early / risk_not_early
nrow(icu_data),
nrow(eligible_icu_patients),
sum(eligible_icu_patients$early_vasopressor == 1),
sum(eligible_icu_patients$early_vasopressor == 0)
)
)
naive_contrasts |>
cohort_overview |>
gt() |>
tab_header(title = "Naive Treatment Contrast") |>
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)
@@ -175,10 +151,10 @@ 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
## Baseline Severity By Treatment Group
```{r}
eligible_data |>
eligible_icu_patients |>
mutate(
early_vasopressor = factor(
early_vasopressor,
@@ -198,14 +174,12 @@ eligible_data |>
add_overall()
```
This compares baseline severity between the two treatment groups.
Early vasopressor patients are generally sicker at baseline in this simulated observational cohort.
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.
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 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.
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.