Evidence Brief

1. Overview

Cohort: Synthetic RWE Cohort
Input: data/sim_rwe.csv
Outcome: y_event; Treatment: treat; Covariates: age, sex, bmi
Model: logistic (GLM)

This brief is parameterized. Render with custom inputs via Quarto:

quarto render brief.qmd \
  -P cohort_name="My Cohort" \
  -P data_path="data/my_data.csv" \
  -P outcome="y" -P treatment="t" \
  -P covariates="[age,sex,bmi]" -P model="logistic"

2. Data

Code
dat <- readr::read_csv(params$data_path, show_col_types = FALSE) |>
  mutate(
    across(all_of(params$treatment), as.integer),
    across(all_of(params$outcome), as.integer),
    sex = factor(sex, levels = c(0,1), labels = c("Female","Male"))
  )

dplyr::glimpse(dat)
Rows: 400
Columns: 6
$ id      <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18,…
$ treat   <int> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1,…
$ age     <dbl> 59.9, 51.4, 43.3, 41.6, 50.4, 42.4, 55.4, 42.1, 59.5, 63.5, 43…
$ sex     <fct> Male, Female, Female, Male, Female, Male, Male, Female, Male, …
$ bmi     <dbl> 26.1, 27.7, 17.2, 29.7, 29.2, 27.5, 20.1, 20.0, 29.6, 32.3, 34…
$ y_event <int> 0, 1, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 1,…

2.1 Cohort summary

Code
summary_tbl <- dat |>
  summarise(
    n = n(),
    events = sum(.data[[params$outcome]], na.rm = TRUE),
    treated = sum(.data[[params$treatment]] == 1, na.rm = TRUE),
    mean_age = mean(age, na.rm = TRUE),
    mean_bmi = mean(bmi, na.rm = TRUE)
  )
knitr::kable(summary_tbl, digits = 2)
Table 1: Cohort overview
n events treated mean_age mean_bmi
400 112 194 52.12 27.33

3. Model

Code
# Build formula
rhs <- paste(c(params$treatment, params$covariates), collapse = " + ")
fm <- as.formula(paste(params$outcome, "~", rhs))

if (params$model == "logistic") {
  fit <- glm(fm, data = dat, family = binomial())
  tidy_fit <- broom::tidy(fit, conf.int = TRUE, exponentiate = TRUE)
  tidy_fit <- tidy_fit |>
    mutate(term = dplyr::recode(term, !!params$treatment := "Treatment (OR)"))
  ylab <- "Odds Ratio (95% CI)"
} else {
  fit <- glm(fm, data = dat)
  tidy_fit <- broom::tidy(fit, conf.int = TRUE)
  tidy_fit <- tidy_fit |>
    mutate(term = dplyr::recode(term, !!params$treatment := "Treatment (beta)"))
  ylab <- "Estimate (95% CI)"
}

3.1 Results table

Code
res_tbl <- tidy_fit |>
  filter(term != "(Intercept)") |>
  select(Term = term, Estimate = estimate, `CI Low` = conf.low, `CI High` = conf.high, `p` = p.value)
knitr::kable(res_tbl, digits = 3)
Table 2: Adjusted model estimates
Term Estimate CI Low CI High p
Treatment (OR) 1.807 1.158 2.838 0.010
age 1.016 0.998 1.036 0.081
sexMale 1.466 0.940 2.294 0.092
bmi 0.994 0.945 1.046 0.827

3.2 Forest plot

Code
plot_dat <- tidy_fit |>
  dplyr::filter(term != "(Intercept)") |>
  dplyr::arrange(dplyr::desc(term))

ggplot(plot_dat, aes(x = estimate, y = term)) +
  geom_point() +
  geom_errorbarh(aes(xmin = conf.low, xmax = conf.high), height = 0.2) +
  geom_vline(xintercept = ifelse(params$model == "logistic", 1, 0), linetype = "dashed") +
  labs(x = ylab, y = NULL)
Figure 1: Adjusted estimates with 95% CI

4. Notes

  • Treatment variable appears first in the table and plot.
  • For logistic models, estimates are Odds Ratios.
  • Edit params: in the header or pass -P flags at render time.

5. Reproducibility

Code
sessionInfo()
R version 4.3.1 (2023-06-16 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19045)

Matrix products: default


locale:
[1] LC_COLLATE=English_United States.utf8 
[2] LC_CTYPE=English_United States.utf8   
[3] LC_MONETARY=English_United States.utf8
[4] LC_NUMERIC=C                          
[5] LC_TIME=English_United States.utf8    

time zone: Europe/Berlin
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] broom_1.0.10  ggplot2_4.0.0 dplyr_1.1.4   readr_2.1.5  

loaded via a namespace (and not attached):
 [1] bit_4.0.5          gtable_0.3.6       jsonlite_1.8.7     crayon_1.5.2      
 [5] compiler_4.3.1     tidyselect_1.2.1   parallel_4.3.1     tidyr_1.3.0       
 [9] scales_1.4.0       yaml_2.3.7         fastmap_1.1.1      R6_2.5.1          
[13] labeling_0.4.3     generics_0.1.3     knitr_1.43         MASS_7.3-60.0.1   
[17] htmlwidgets_1.6.4  backports_1.4.1    tibble_3.2.1       pillar_1.9.0      
[21] RColorBrewer_1.1-3 tzdb_0.4.0         rlang_1.1.1        utf8_1.2.3        
[25] xfun_0.40          S7_0.2.0           bit64_4.0.5        cli_3.6.1         
[29] withr_2.5.0        magrittr_2.0.3     digest_0.6.33      grid_4.3.1        
[33] vroom_1.6.5        rstudioapi_0.15.0  hms_1.1.3          lifecycle_1.0.3   
[37] vctrs_0.6.5        evaluate_0.21      glue_1.6.2         farver_2.1.1      
[41] fansi_1.0.4        rmarkdown_2.24     purrr_1.0.2        tools_4.3.1       
[45] pkgconfig_2.0.3    htmltools_0.5.7