99 lines
3.4 KiB
R
99 lines
3.4 KiB
R
suppressPackageStartupMessages({
|
|
library(dplyr)
|
|
library(tidyr)
|
|
})
|
|
|
|
# estimate_naive_vasopressor_mortality_effect() computes the first simple
|
|
# mortality comparison for the early vasopressor teaching example.
|
|
#
|
|
# This function deliberately does NOT adjust for confounding.
|
|
# It only compares observed 28-day mortality between eligible patients who did
|
|
# and did not receive early vasopressors.
|
|
#
|
|
# Arguments:
|
|
# - icu_data: a data frame or tibble with the columns created by
|
|
# simulate_icu_cohort().
|
|
#
|
|
# Returns:
|
|
# - A named list with four pieces:
|
|
# - eligible_icu_patients: only the target-trial eligible patients.
|
|
# - mortality_risks_by_early_vasopressor: observed 28-day mortality risk in
|
|
# each treatment group.
|
|
# - mortality_effect_estimates: naive risk difference and risk ratio.
|
|
# - baseline_characteristics_by_early_vasopressor: compact baseline means by
|
|
# observed treatment group.
|
|
#
|
|
# Example REPL use:
|
|
#
|
|
# source("R/simulate_icu_cohort.R")
|
|
# icu_data <- simulate_icu_cohort(n_patients = 1000, seed = 20260531)
|
|
# mortality_analysis <- estimate_naive_vasopressor_mortality_effect(icu_data)
|
|
# mortality_analysis$mortality_effect_estimates
|
|
#
|
|
estimate_naive_vasopressor_mortality_effect <- function(icu_data) {
|
|
eligible_icu_patients <- icu_data |>
|
|
filter(eligible == 1)
|
|
|
|
mortality_risks_by_early_vasopressor <- eligible_icu_patients |>
|
|
group_by(early_vasopressor) |>
|
|
summarize(
|
|
patient_count = n(),
|
|
mortality_risk_28d = mean(death_28d),
|
|
.groups = "drop"
|
|
) |>
|
|
mutate(
|
|
observed_treatment_group = factor(
|
|
early_vasopressor,
|
|
levels = c(0, 1),
|
|
labels = c("No early vasopressor", "Early vasopressor")
|
|
)
|
|
) |>
|
|
select(observed_treatment_group, patient_count, mortality_risk_28d)
|
|
|
|
mortality_risk_early_vasopressor <- mortality_risks_by_early_vasopressor |>
|
|
filter(observed_treatment_group == "Early vasopressor") |>
|
|
pull(mortality_risk_28d)
|
|
|
|
mortality_risk_no_early_vasopressor <- mortality_risks_by_early_vasopressor |>
|
|
filter(observed_treatment_group == "No early vasopressor") |>
|
|
pull(mortality_risk_28d)
|
|
|
|
mortality_effect_estimates <- tibble(
|
|
estimate = c(
|
|
"Eligible patients",
|
|
"Early vasopressor patients",
|
|
"No early vasopressor patients",
|
|
"28-day mortality risk, early vasopressor",
|
|
"28-day mortality risk, no early vasopressor",
|
|
"Naive risk difference",
|
|
"Naive risk ratio"
|
|
),
|
|
value = c(
|
|
nrow(eligible_icu_patients),
|
|
sum(eligible_icu_patients$early_vasopressor == 1),
|
|
sum(eligible_icu_patients$early_vasopressor == 0),
|
|
mortality_risk_early_vasopressor,
|
|
mortality_risk_no_early_vasopressor,
|
|
mortality_risk_early_vasopressor - mortality_risk_no_early_vasopressor,
|
|
mortality_risk_early_vasopressor / mortality_risk_no_early_vasopressor
|
|
)
|
|
)
|
|
|
|
baseline_characteristics_by_early_vasopressor <- eligible_icu_patients |>
|
|
group_by(early_vasopressor) |>
|
|
summarize(
|
|
mean_age = mean(age),
|
|
mean_sofa_score = mean(sofa_score),
|
|
mean_lactate = mean(lactate),
|
|
mean_map = mean(map),
|
|
.groups = "drop"
|
|
)
|
|
|
|
list(
|
|
eligible_icu_patients = eligible_icu_patients,
|
|
mortality_risks_by_early_vasopressor = mortality_risks_by_early_vasopressor,
|
|
mortality_effect_estimates = mortality_effect_estimates,
|
|
baseline_characteristics_by_early_vasopressor = baseline_characteristics_by_early_vasopressor
|
|
)
|
|
}
|