Prevalence, Risk Factors and Renoprotective Treatment of Chronic Kidney Disease Among Internal Medicine Outpatients at a Central European Tertiary Care Centre: A Cross-Sectional Study
Statistical report
Authors and affiliations
Ivan Zahradka1, Vojtech Petr1, Filip Tichanek2, Adriana Chroma1, Tomas Neskudla2, Michal Kahle2, Robert Bem3, Pavel Trunecka4, Vera Adamkova5, Petra Hruba6, Ivo Hlavac7, Ondrej Viklicky1,6
1 Department of Nephrology, Institute for Clinical and Experimental Medicine, Prague, Czech Republic
2 Department of Data Science, Institute for Clinical and Experimental Medicine, Prague, Czech Republic
3 Diabetes Centre, Institute for Clinical and Experimental Medicine, Prague, Czech Republic
4 Department of Hepatogastroenterology, Institute for Clinical and Experimental Medicine, Prague, Czech Republic
5 Center of Preventive Medicine, Institute for Clinical and Experimental Medicine, Prague, Czech Republic
6 Transplantation Laboratory, Institute for Clinical and Experimental Medicine, Prague, Czech Republic
7 Department of Epidemiology and Public Health, Faculty of Medicine, University of Ostrava, Ostrava, Czech Republic
This is a statistical report of the study of Zahradka et al., Prevalence, Risk Factors and Renoprotective Treatment of Chronic Kidney Disease Among Internal Medicine Outpatients at a Central European Tertiary Care Centre: A Cross-Sectional Study.
When using this code or data, cite the original publication:
TO BE ADDED
Statistical report can be found here: https://filip-tichanek.github.io/ckd_ikem/
Original GitHub repository: https://github.com/filip-tichanek/ckd_ikem.
The repository is organized as follows:
quarto/736_code01.qmd: Primary analysis script. It contains the complete workflow to answer all research questions, including data processing, statistical modeling, and generation of results.r/: Supporting R scripts and initialization.r/736_initiation.R: Initialization script for loading libraries and global constants.r/functions/: Custom R functions
data/: Directory containing the .rds datasets and .md metadata
1 Introduction
This repository contains the R code and data wrangling for our study on CKD screening in specialized internal medicine outpatient departments, investigating whether tertiary care centres are effective settings for CKD screening and evaluating how renoprotective drugs are prescribed in practice
1.1 Research Questions:
1/ What is the prevalence of CKD within non-nephrology internal medicine outpatient clinics?
2/ How does CKD prevalence vary across age?
3/ To address potential overestimation in older populations due to physiological eGFR decline, what is the prevalence when using an age-calibrated CKD definition?
4/ What are the primary clinical risk factors associated with CKD in this setting?
5/ What is the prevalence of previously undetected CKD, and which factors are associated with new CKD cases?
6/ What proportion of eligible CKD patients are currently not receiving indicated renoprotective therapies (the treatment gap)?
7/ What is the model-projected gain in dialysis-free time if all eligible individuals received guideline-recommended renoprotective treatment?
1.2 Datasets
All data needed for the analysis are available in the .rds format in Zenodo as well as GitHub repository. There are two datasets:
1/ data_ckd.rds are primarily data needed to asnwer the questions #1 to #6. This includes the data of 2903 patients, with each row representing one patient.
2/ data_survival.rds contains historical data used for Cox proportional hazards modeling to address question #7. These data allow for the prediction of remaining survival and the estimation of potential gain in dialysis-free survival following the initiation of indicated renoprotective therapies.
1.2.1 data_ckd.rds data dictionary
| Variable | Type | Description | Values / Units |
|---|---|---|---|
date_sampling |
Date | Date of laboratory sample collection | YYYY-MM-DD |
consent |
Numeric (Binary) | Informed consent obtained from the participant | 0: No (unscreened patient), 1: Yes (patient from screening cohort) |
age |
Numeric | Patient age at the time of sampling | Years |
sex |
Factor | Biological sex | F: Female, M: Male |
uACR_value |
Numeric | Urinary Albumin-to-Creatinine Ratio | mg/g |
eGFR_value |
Numeric | Estimated Glomerular Filtration Rate | mL/s/1.73m² |
identified_CKD_by_lab |
Numeric (Binary) | CKD status based on laboratory threshold criteria | 0: No, 1: Yes |
CKD_record |
Numeric (Binary) | CKD diagnosis present in official medical records | 0: No, 1: Yes |
new_cases |
Numeric (Binary) | Incident CKD cases newly identified during the study | 0: No, 1: Yes |
transplant |
Numeric (Binary) | History of non-renal transplantation | 0: No, 1: Yes |
BMI_last |
Numeric | Last recorded Body Mass Index | kg/m² |
FU_stroke |
Numeric (Binary) | History of Stroke | 0: No, 1: Yes |
FU_PAD |
Numeric (Binary) | History of Peripheral Artery Disease | 0: No, 1: Yes |
FU_DM |
Numeric (Binary) | Diabetes Mellitus (any type) | 0: No, 1: Yes |
FU_DM1 |
Numeric (Binary) | Type 1 Diabetes Mellitus | 0: No, 1: Yes |
FU_DM2 |
Numeric (Binary) | Type 2 Diabetes Mellitus | 0: No, 1: Yes |
FU_atherosclerosis |
Numeric (Binary) | Presence of Atherosclerosis | 0: No, 1: Yes |
ischemic_heart_disease |
Numeric (Binary) | Presence of Ischemic Heart Disease | 0: No, 1: Yes |
FU_steatosis |
Numeric (Binary) | Presence of Hepatic Steatosis | 0: No, 1: Yes |
FU_hypertension |
Numeric (Binary) | Presence of Hypertension | 0: No, 1: Yes |
FU_atrial_fibrillation |
Numeric (Binary) | Presence of Atrial Fibrillation | 0: No, 1: Yes |
FU_heart_failure |
Numeric (Binary) | Presence of Heart Failure | 0: No, 1: Yes |
FU_charlson_index |
Numeric | Charlson Comorbidity Index score | Range: 0–14 |
FU_GLP1 |
Numeric (Binary) | Current use of GLP-1 Receptor Agonists | 0: No, 1: Yes |
FU_SGLT2 |
Numeric (Binary) | Current use of SGLT2 Inhibitors | 0: No, 1: Yes |
FU_RAASi |
Numeric (Binary) | Current use of RAAS Inhibitors (ACEi/ARB) | 0: No, 1: Yes |
FU_finerenone |
Numeric (Binary) | Current use of Finerenone | 0: No, 1: Yes |
elig_RAASi_all |
Numeric (Binary) | Eligible for RAASi treatment based on guidelines | 0: No, 1: Yes |
elig_SGLT2i_total |
Numeric (Binary) | Eligible for SGLT2i treatment based on guidelines | 0: No, 1: Yes |
elig_GLP1_RA |
Numeric (Binary) | Eligible for GLP-1 RA treatment based on guidelines | 0: No, 1: Yes |
elig_finerenone |
Numeric (Binary) | Eligible for Finerenone treatment based on guidelines | 0: No, 1: Yes |
1.2.2 data_survival.rds data dictionary
| Variable | Type | Description | Values / Units |
|---|---|---|---|
EntryDate |
Date | Date of entry into the study | YYYY-MM-DD |
Sex |
Factor | Biological sex | F: Female, M: Male |
age |
Numeric | Age at the time of entry | Years |
BMI |
Numeric | Body Mass Index | kg/m² |
eGFR_ckd_epi |
Numeric | Estimated Glomerular Filtration Rate | mL/s/1.73m² |
ACR |
Numeric | Urinary Albumin-to-Creatinine Ratio | mg/g |
transplant |
Numeric (Binary) | History of non-renal transplantation | 0: No, 1: Yes |
CKD_record |
Numeric (Binary) | CKD diagnosis present in medical records | 0: No, 1: Yes |
FU_DM |
Numeric (Binary) | Presence of Diabetes Mellitus | 0: No, 1: Yes |
FU_hypertension |
Numeric (Binary) | Presence of Hypertension | 0: No, 1: Yes |
FU_heart_failure |
Numeric (Binary) | Presence of Heart Failure | 0: No, 1: Yes |
FU_atrial_fibrillation |
Numeric (Binary) | Presence of Atrial Fibrillation | 0: No, 1: Yes |
ischemic_heart_disease |
Numeric (Binary) | Presence of Ischemic Heart Disease | 0: No, 1: Yes |
FU_atherosclerosis_PAD |
Numeric (Binary) | Presence of Peripheral Artery Disease | 0: No, 1: Yes |
FU_stroke |
Numeric (Binary) | History of Stroke | 0: No, 1: Yes |
FU_steatosis |
Numeric (Binary) | Presence of Hepatic Steatosis | 0: No, 1: Yes |
time |
Numeric | Follow-up time (years) from entry to event or censoring | Years |
event |
Numeric (Binary) | Mortality indicator (status) | 0: Alive/Censored, 1: Dead |
2 Initiation
Upload initiation file
Open code
setwd(path)
source('r/736_initiation.R')
## New names:
## • `ACR` -> `ACR...10`
## • `GFR` -> `GFR...11`
## • `ACR` -> `ACR...45`
## • `GFR` -> `GFR...46`2.1 Function to get age-specific CKD cut-off
According to Delanaye et al.
Open code
trans_egfr_cut <- function(age, sex){
if (sex == 'male'){
cut_point = 86.4* (0.993^age)
} else if (sex == 'female'){
cut_point = 88.2 * (0.993^age)
} else {
cut_point = "Sex is not correctly specified. Choose any of 'male' or 'female'"
}
return(cut_point)
}
trans_egfr_cut(20, 'male')
## [1] 75.07558
trans_egfr_cut(20, 'female')
## [1] 76.63966
trans_egfr_cut(40, 'male')
## [1] 65.23545
trans_egfr_cut(40, 'female')
## [1] 66.59452
trans_egfr_cut(60, 'male')
## [1] 56.68507
trans_egfr_cut(60, 'female')
## [1] 57.866
trans_egfr_cut(80, 'male')
## [1] 49.25537
trans_egfr_cut(80, 'female')
## [1] 50.28153
trans_egfr_cut(80, 'nevim')
## [1] "Sex is not correctly specified. Choose any of 'male' or 'female'"2.2 Further data wrangling
2.2.1 data_ckd
BMI_over30 = Obesity indicator (BMI > 30 kg/m²)
sex_female = Binary indicator for female sex
HF_or_AF = Combined indicator of heart failure or atrial fibrillation
eGFR_AgeSpecCut = Age- and sex-specific eGFR thresholds for CKD definition
eGFR_min = eGFR in mL/min/1.73m² unit
GFR_text_AgeSpecCut = Categorical eGFR status (normal/altered) based on age-calibrated thresholds
identified_CKD_by_lab_AgeSpecCut = CKD status based on laboratory criteria using age-specific thresholds
Open code
data_ckd <- data_ckd %>%
dplyr::mutate(
BMI_over30 = if_else(BMI_last > 30, 1, 0),
sex_female = if_else(sex == "F", 1, 0),
HF_or_AF = if_else(
(FU_heart_failure == 1 | FU_atrial_fibrillation == 1), 1, 0
),
eGFR_AgeSpecCut = if_else(
sex == "M", trans_egfr_cut(age, "male"), trans_egfr_cut(age, "female")
),
eGFR_min = eGFR_value * 60
) %>%
dplyr::mutate(
GFR_text_AgeSpecCut = if_else(
eGFR_min > eGFR_AgeSpecCut, "normal", "altered"
)
) %>%
dplyr::mutate(
identified_CKD_by_lab_AgeSpecCut = if_else(
(GFR_text_AgeSpecCut == "altered") | (ACR_text == "altered"), 1, 0
)
)2.2.2 data_survival
sex_female = Binary indicator for female sex
HF_or_AF = Combined indicator of heart failure or atrial fibrillation
FU_atherosclerosis = Combined indicator of atherosclerotic disease (ischemic heart disease, other atherosclerosis, peripheral artery disease, or stroke)
Open code
data_survival <- data_survival %>%
dplyr::mutate(
sex_female = if_else(Sex == "F", 1, 0),
HF_or_AF = pmax(FU_heart_failure, FU_atrial_fibrillation),
FU_atherosclerosis = pmax(
ischemic_heart_disease,
FU_atherosclerosis_PAD,
FU_stroke
)
)2.2.3 data_ckd_complete
Only these rows with BMI data (30 cases are thus excluded). Consent as factor
Open code
data_ckd_complete <- data_ckd %>%
dplyr::filter(
!is.na(BMI_over30)
) %>%
dplyr::mutate(
consent = factor(consent)
)2.3 Explore data_ckd data
Open code
skimr::skim(data_ckd)| Name | data_ckd |
| Number of rows | 2903 |
| Number of columns | 40 |
| _______________________ | |
| Column type frequency: | |
| character | 2 |
| Date | 1 |
| factor | 2 |
| numeric | 35 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| eGFR_text | 0 | 1 | 6 | 7 | 0 | 2 | 0 |
| GFR_text_AgeSpecCut | 0 | 1 | 6 | 7 | 0 | 2 | 0 |
Variable type: Date
| skim_variable | n_missing | complete_rate | min | max | median | n_unique |
|---|---|---|---|---|---|---|
| date_sampling | 0 | 1 | 2025-02-24 | 2025-05-08 | 2025-03-25 | 54 |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| sex | 0 | 1 | FALSE | 2 | M: 1628, F: 1275 |
| ACR_text | 0 | 1 | FALSE | 2 | nor: 2310, alt: 593 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| consent | 0 | 1.00 | 0.67 | 0.47 | 0.00 | 0.00 | 1.00 | 1.00 | 1.00 | ▅▁▁▁▇ |
| age | 0 | 1.00 | 62.23 | 14.19 | 19.00 | 53.00 | 64.00 | 73.00 | 97.00 | ▁▃▆▇▁ |
| uACR_value | 0 | 1.00 | 7.83 | 36.18 | 0.00 | 0.00 | 0.70 | 2.10 | 684.40 | ▇▁▁▁▁ |
| eGFR_value | 0 | 1.00 | 1.23 | 0.39 | 0.13 | 0.98 | 1.28 | 1.52 | 2.26 | ▂▃▇▇▁ |
| identified_CKD_by_lab | 0 | 1.00 | 0.37 | 0.48 | 0.00 | 0.00 | 0.00 | 1.00 | 1.00 | ▇▁▁▁▅ |
| CKD_record | 0 | 1.00 | 0.19 | 0.39 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▂ |
| new_cases | 0 | 1.00 | 0.14 | 0.35 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▁ |
| transplant | 0 | 1.00 | 0.12 | 0.33 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▁ |
| BMI_last | 30 | 0.99 | 28.57 | 5.28 | 5.10 | 24.80 | 28.20 | 31.70 | 57.10 | ▁▅▇▁▁ |
| FU_stroke | 0 | 1.00 | 0.05 | 0.22 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▁ |
| FU_PAD | 0 | 1.00 | 0.06 | 0.24 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▁ |
| FU_DM | 0 | 1.00 | 0.58 | 0.49 | 0.00 | 0.00 | 1.00 | 1.00 | 1.00 | ▆▁▁▁▇ |
| FU_DM1 | 0 | 1.00 | 0.17 | 0.38 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▂ |
| FU_DM2 | 0 | 1.00 | 0.41 | 0.49 | 0.00 | 0.00 | 0.00 | 1.00 | 1.00 | ▇▁▁▁▆ |
| FU_atherosclerosis | 0 | 1.00 | 0.27 | 0.44 | 0.00 | 0.00 | 0.00 | 1.00 | 1.00 | ▇▁▁▁▃ |
| ischemic_heart_disease | 0 | 1.00 | 0.18 | 0.38 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▂ |
| FU_steatosis | 0 | 1.00 | 0.28 | 0.45 | 0.00 | 0.00 | 0.00 | 1.00 | 1.00 | ▇▁▁▁▃ |
| FU_hypertension | 0 | 1.00 | 0.81 | 0.39 | 0.00 | 1.00 | 1.00 | 1.00 | 1.00 | ▂▁▁▁▇ |
| FU_atrial_fibrillation | 0 | 1.00 | 0.18 | 0.38 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▂ |
| FU_heart_failure | 0 | 1.00 | 0.18 | 0.39 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▂ |
| FU_charlson_index | 0 | 1.00 | 2.64 | 2.01 | 0.00 | 1.00 | 2.00 | 4.00 | 14.00 | ▇▅▁▁▁ |
| FU_GLP1 | 0 | 1.00 | 0.13 | 0.34 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▁ |
| FU_SGLT2 | 0 | 1.00 | 0.21 | 0.41 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▂ |
| FU_RAASi | 0 | 1.00 | 0.64 | 0.48 | 0.00 | 0.00 | 1.00 | 1.00 | 1.00 | ▅▁▁▁▇ |
| FU_finerenone | 0 | 1.00 | 0.00 | 0.06 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▁ |
| elig_RAASi_all | 0 | 1.00 | 0.37 | 0.48 | 0.00 | 0.00 | 0.00 | 1.00 | 1.00 | ▇▁▁▁▅ |
| elig_SGLT2i_total | 0 | 1.00 | 0.37 | 0.48 | 0.00 | 0.00 | 0.00 | 1.00 | 1.00 | ▇▁▁▁▅ |
| elig_GLP1_RA | 0 | 1.00 | 0.09 | 0.29 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▁ |
| elig_finerenone | 0 | 1.00 | 0.01 | 0.10 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▁ |
| BMI_over30 | 30 | 0.99 | 0.36 | 0.48 | 0.00 | 0.00 | 0.00 | 1.00 | 1.00 | ▇▁▁▁▅ |
| sex_female | 0 | 1.00 | 0.44 | 0.50 | 0.00 | 0.00 | 0.00 | 1.00 | 1.00 | ▇▁▁▁▆ |
| HF_or_AF | 0 | 1.00 | 0.27 | 0.44 | 0.00 | 0.00 | 0.00 | 1.00 | 1.00 | ▇▁▁▁▃ |
| eGFR_AgeSpecCut | 0 | 1.00 | 56.60 | 5.82 | 44.62 | 52.10 | 55.50 | 59.96 | 76.64 | ▃▇▅▂▁ |
| eGFR_min | 0 | 1.00 | 73.67 | 23.15 | 7.80 | 58.80 | 76.80 | 91.20 | 135.60 | ▂▃▇▇▁ |
| identified_CKD_by_lab_AgeSpecCut | 0 | 1.00 | 0.32 | 0.47 | 0.00 | 0.00 | 0.00 | 1.00 | 1.00 | ▇▁▁▁▃ |
Open code
summary(data_ckd)
## date_sampling consent age sex
## Min. :2025-02-24 Min. :0.0000 Min. :19.00 F:1275
## 1st Qu.:2025-03-10 1st Qu.:0.0000 1st Qu.:53.00 M:1628
## Median :2025-03-25 Median :1.0000 Median :64.00
## Mean :2025-03-27 Mean :0.6659 Mean :62.23
## 3rd Qu.:2025-04-14 3rd Qu.:1.0000 3rd Qu.:73.00
## Max. :2025-05-08 Max. :1.0000 Max. :97.00
##
## uACR_value ACR_text eGFR_value eGFR_text
## Min. : 0.000 altered: 593 Min. :0.130 Length:2903
## 1st Qu.: 0.000 normal :2310 1st Qu.:0.980 Class :character
## Median : 0.700 Median :1.280 Mode :character
## Mean : 7.827 Mean :1.228
## 3rd Qu.: 2.100 3rd Qu.:1.520
## Max. :684.400 Max. :2.260
##
## identified_CKD_by_lab CKD_record new_cases transplant
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :0.0000 Median :0.0000 Median :0.0000 Median :0.0000
## Mean :0.3689 Mean :0.1895 Mean :0.1388 Mean :0.1216
## 3rd Qu.:1.0000 3rd Qu.:0.0000 3rd Qu.:0.0000 3rd Qu.:0.0000
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.0000
##
## BMI_last FU_stroke FU_PAD FU_DM
## Min. : 5.10 Min. :0.0000 Min. :0.00000 Min. :0.0000
## 1st Qu.:24.80 1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.0000
## Median :28.20 Median :0.0000 Median :0.00000 Median :1.0000
## Mean :28.57 Mean :0.0527 Mean :0.06063 Mean :0.5822
## 3rd Qu.:31.70 3rd Qu.:0.0000 3rd Qu.:0.00000 3rd Qu.:1.0000
## Max. :57.10 Max. :1.0000 Max. :1.00000 Max. :1.0000
## NA's :30
## FU_DM1 FU_DM2 FU_atherosclerosis ischemic_heart_disease
## Min. :0.000 Min. :0.0000 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :0.000 Median :0.0000 Median :0.0000 Median :0.0000
## Mean :0.175 Mean :0.4072 Mean :0.2677 Mean :0.1784
## 3rd Qu.:0.000 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:0.0000
## Max. :1.000 Max. :1.0000 Max. :1.0000 Max. :1.0000
##
## FU_steatosis FU_hypertension FU_atrial_fibrillation FU_heart_failure
## Min. :0.000 Min. :0.0000 Min. :0.000 Min. :0.000
## 1st Qu.:0.000 1st Qu.:1.0000 1st Qu.:0.000 1st Qu.:0.000
## Median :0.000 Median :1.0000 Median :0.000 Median :0.000
## Mean :0.278 Mean :0.8112 Mean :0.176 Mean :0.185
## 3rd Qu.:1.000 3rd Qu.:1.0000 3rd Qu.:0.000 3rd Qu.:0.000
## Max. :1.000 Max. :1.0000 Max. :1.000 Max. :1.000
##
## FU_charlson_index FU_GLP1 FU_SGLT2 FU_RAASi
## Min. : 0.00 Min. :0.0000 Min. :0.0000 Min. :0.0000
## 1st Qu.: 1.00 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000
## Median : 2.00 Median :0.0000 Median :0.0000 Median :1.0000
## Mean : 2.64 Mean :0.1302 Mean :0.2081 Mean :0.6417
## 3rd Qu.: 4.00 3rd Qu.:0.0000 3rd Qu.:0.0000 3rd Qu.:1.0000
## Max. :14.00 Max. :1.0000 Max. :1.0000 Max. :1.0000
##
## FU_finerenone elig_RAASi_all elig_SGLT2i_total elig_GLP1_RA
## Min. :0.000000 Min. :0.0000 Min. :0.0000 Min. :0.00000
## 1st Qu.:0.000000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.00000
## Median :0.000000 Median :0.0000 Median :0.0000 Median :0.00000
## Mean :0.003445 Mean :0.3689 Mean :0.3686 Mean :0.09094
## 3rd Qu.:0.000000 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:0.00000
## Max. :1.000000 Max. :1.0000 Max. :1.0000 Max. :1.00000
##
## elig_finerenone BMI_over30 sex_female HF_or_AF
## Min. :0.00000 Min. :0.0000 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :0.00000 Median :0.0000 Median :0.0000 Median :0.0000
## Mean :0.01033 Mean :0.3561 Mean :0.4392 Mean :0.2666
## 3rd Qu.:0.00000 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.0000
## Max. :1.00000 Max. :1.0000 Max. :1.0000 Max. :1.0000
## NA's :30
## eGFR_AgeSpecCut eGFR_min GFR_text_AgeSpecCut
## Min. :44.62 Min. : 7.80 Length:2903
## 1st Qu.:52.10 1st Qu.: 58.80 Class :character
## Median :55.50 Median : 76.80 Mode :character
## Mean :56.60 Mean : 73.67
## 3rd Qu.:59.96 3rd Qu.: 91.20
## Max. :76.64 Max. :135.60
##
## identified_CKD_by_lab_AgeSpecCut
## Min. :0.0000
## 1st Qu.:0.0000
## Median :0.0000
## Mean :0.3186
## 3rd Qu.:1.0000
## Max. :1.0000
## 2.3.1 Comapre cohorts
consent == 1 indicates screening cohort whereas consent == 0 indicates unscreened patient
Open code
data_ckd %>%
dplyr::mutate(consent = if_else(consent == 1, 'consent', 'no_consent')) %>%
dplyr::select(
consent:sex,
uACR_value:identified_CKD_by_lab_AgeSpecCut
) %>%
gtsummary::tbl_summary(by = consent) %>%
add_p()| Characteristic | consent N = 1,9331 |
no_consent N = 9701 |
p-value2 |
|---|---|---|---|
| age | 64 (53, 72) | 65 (52, 74) | 0.2 |
| sex | 0.10 | ||
| F | 870 (45%) | 405 (42%) | |
| M | 1,063 (55%) | 565 (58%) | |
| uACR_value | 1 (0, 2) | 1 (0, 3) | <0.001 |
| ACR_text | <0.001 | ||
| altered | 353 (18%) | 240 (25%) | |
| normal | 1,580 (82%) | 730 (75%) | |
| eGFR_value | 1.30 (1.04, 1.52) | 1.19 (0.85, 1.48) | <0.001 |
| eGFR_text | <0.001 | ||
| altered | 419 (22%) | 344 (35%) | |
| normal | 1,514 (78%) | 626 (65%) | |
| identified_CKD_by_lab | 629 (33%) | 442 (46%) | <0.001 |
| CKD_record | 244 (13%) | 306 (32%) | <0.001 |
| new_cases | 299 (15%) | 104 (11%) | <0.001 |
| transplant | 248 (13%) | 105 (11%) | 0.12 |
| BMI_last | 28.2 (24.8, 31.6) | 28.2 (24.9, 31.8) | 0.7 |
| Unknown | 20 | 10 | |
| FU_stroke | 84 (4.3%) | 69 (7.1%) | 0.002 |
| FU_PAD | 90 (4.7%) | 86 (8.9%) | <0.001 |
| FU_DM | 1,127 (58%) | 563 (58%) | 0.9 |
| FU_DM1 | 355 (18%) | 153 (16%) | 0.083 |
| FU_DM2 | 772 (40%) | 410 (42%) | 0.2 |
| FU_atherosclerosis | 454 (23%) | 323 (33%) | <0.001 |
| ischemic_heart_disease | 289 (15%) | 229 (24%) | <0.001 |
| FU_steatosis | 557 (29%) | 250 (26%) | 0.084 |
| FU_hypertension | 1,537 (80%) | 818 (84%) | 0.002 |
| FU_atrial_fibrillation | 273 (14%) | 238 (25%) | <0.001 |
| FU_heart_failure | 302 (16%) | 235 (24%) | <0.001 |
| FU_charlson_index | 2.00 (1.00, 4.00) | 2.00 (1.00, 4.00) | <0.001 |
| FU_GLP1 | 249 (13%) | 129 (13%) | 0.8 |
| FU_SGLT2 | 323 (17%) | 281 (29%) | <0.001 |
| FU_RAASi | 1,203 (62%) | 660 (68%) | 0.002 |
| FU_finerenone | 4 (0.2%) | 6 (0.6%) | 0.094 |
| elig_RAASi_all | 629 (33%) | 442 (46%) | <0.001 |
| elig_SGLT2i_total | 640 (33%) | 430 (44%) | <0.001 |
| elig_GLP1_RA | 159 (8.2%) | 105 (11%) | 0.022 |
| elig_finerenone | 19 (1.0%) | 11 (1.1%) | 0.7 |
| BMI_over30 | 681 (36%) | 342 (36%) | >0.9 |
| Unknown | 20 | 10 | |
| sex_female | 870 (45%) | 405 (42%) | 0.10 |
| HF_or_AF | 443 (23%) | 331 (34%) | <0.001 |
| eGFR_AgeSpecCut | 55.9 (52.5, 60.0) | 55.1 (52.1, 60.4) | 0.12 |
| eGFR_min | 78 (62, 91) | 71 (51, 89) | <0.001 |
| GFR_text_AgeSpecCut | <0.001 | ||
| altered | 308 (16%) | 270 (28%) | |
| normal | 1,625 (84%) | 700 (72%) | |
| identified_CKD_by_lab_AgeSpecCut | 538 (28%) | 387 (40%) | <0.001 |
| 1 Median (Q1, Q3); n (%) | |||
| 2 Wilcoxon rank sum test; Pearson’s Chi-squared test; Fisher’s exact test | |||
2.3.2 Number of people based on CKD
2.3.2.1 Select data
Open code
data_ckd_sum <- data_ckd %>%
dplyr::mutate(
ckd_status = case_when(
(identified_CKD_by_lab == 1) & (identified_CKD_by_lab_AgeSpecCut == 1) ~
'CKD_both',
(identified_CKD_by_lab == 1) & (identified_CKD_by_lab_AgeSpecCut == 0) ~
'CKD_only_original',
(identified_CKD_by_lab == 0) & (identified_CKD_by_lab_AgeSpecCut == 1) ~
'CKD_only_age_calibrated',
(identified_CKD_by_lab == 0) & (identified_CKD_by_lab_AgeSpecCut == 0) ~
'NO CKD',
)
) %>%
dplyr::select(
consent:uACR_value, eGFR_value,
identified_CKD_by_lab:HF_or_AF, eGFR_AgeSpecCut, ckd_status,
ACR_text, eGFR_text, GFR_text_AgeSpecCut
)2.3.2.2 Data summary - both cohorts
Open code
data_ckd_sum %>%
gtsummary::tbl_summary(by = ckd_status)| Characteristic | CKD_both N = 9151 |
CKD_only_age_calibrated N = 101 |
CKD_only_original N = 1561 |
NO CKD N = 1,8221 |
|---|---|---|---|---|
| consent | 531 (58%) | 7 (70%) | 98 (63%) | 1,297 (71%) |
| age | 70 (60, 77) | 41 (35, 46) | 76 (72, 80) | 60 (50, 69) |
| sex | ||||
| F | 371 (41%) | 4 (40%) | 76 (49%) | 824 (45%) |
| M | 544 (59%) | 6 (60%) | 80 (51%) | 998 (55%) |
| uACR_value | 5 (2, 13) | 1 (0, 1) | 1 (0, 1) | 0 (0, 1) |
| eGFR_value | 0.82 (0.61, 1.17) | 1.04 (1.02, 1.07) | 0.94 (0.90, 0.97) | 1.41 (1.23, 1.58) |
| identified_CKD_by_lab | 915 (100%) | 0 (0%) | 156 (100%) | 0 (0%) |
| CKD_record | 444 (49%) | 3 (30%) | 31 (20%) | 72 (4.0%) |
| new_cases | 311 (34%) | 0 (0%) | 92 (59%) | 0 (0%) |
| transplant | 205 (22%) | 6 (60%) | 11 (7.1%) | 131 (7.2%) |
| BMI_last | 28.4 (25.2, 31.8) | 24.0 (21.2, 29.4) | 27.9 (25.1, 30.7) | 28.1 (24.6, 31.7) |
| Unknown | 6 | 0 | 0 | 24 |
| FU_stroke | 71 (7.8%) | 1 (10%) | 13 (8.3%) | 68 (3.7%) |
| FU_PAD | 113 (12%) | 0 (0%) | 11 (7.1%) | 52 (2.9%) |
| FU_DM | 598 (65%) | 3 (30%) | 85 (54%) | 1,004 (55%) |
| FU_DM1 | 110 (12%) | 2 (20%) | 10 (6.4%) | 386 (21%) |
| FU_DM2 | 488 (53%) | 1 (10%) | 75 (48%) | 618 (34%) |
| FU_atherosclerosis | 365 (40%) | 1 (10%) | 67 (43%) | 344 (19%) |
| ischemic_heart_disease | 265 (29%) | 1 (10%) | 46 (29%) | 206 (11%) |
| FU_steatosis | 305 (33%) | 2 (20%) | 38 (24%) | 462 (25%) |
| FU_hypertension | 865 (95%) | 8 (80%) | 140 (90%) | 1,342 (74%) |
| FU_atrial_fibrillation | 251 (27%) | 2 (20%) | 44 (28%) | 214 (12%) |
| FU_heart_failure | 266 (29%) | 3 (30%) | 40 (26%) | 228 (13%) |
| FU_charlson_index | 3.00 (2.00, 5.00) | 3.00 (2.00, 4.00) | 3.00 (1.00, 4.00) | 2.00 (1.00, 3.00) |
| FU_GLP1 | 152 (17%) | 1 (10%) | 9 (5.8%) | 216 (12%) |
| FU_SGLT2 | 355 (39%) | 0 (0%) | 31 (20%) | 218 (12%) |
| FU_RAASi | 707 (77%) | 4 (40%) | 116 (74%) | 1,036 (57%) |
| FU_finerenone | 9 (1.0%) | 0 (0%) | 0 (0%) | 1 (<0.1%) |
| elig_RAASi_all | 915 (100%) | 0 (0%) | 156 (100%) | 0 (0%) |
| elig_SGLT2i_total | 579 (63%) | 3 (30%) | 94 (60%) | 394 (22%) |
| elig_GLP1_RA | 229 (25%) | 0 (0%) | 35 (22%) | 0 (0%) |
| elig_finerenone | 30 (3.3%) | 0 (0%) | 0 (0%) | 0 (0%) |
| BMI_over30 | 344 (38%) | 2 (20%) | 48 (31%) | 629 (35%) |
| Unknown | 6 | 0 | 0 | 24 |
| sex_female | 371 (41%) | 4 (40%) | 76 (49%) | 824 (45%) |
| HF_or_AF | 364 (40%) | 4 (40%) | 62 (40%) | 344 (19%) |
| eGFR_AgeSpecCut | 53.6 (51.0, 57.5) | 65.5 (63.8, 67.6) | 51.4 (49.9, 52.8) | 57.1 (53.6, 61.2) |
| ACR_text | ||||
| altered | 593 (65%) | 0 (0%) | 0 (0%) | 0 (0%) |
| normal | 322 (35%) | 10 (100%) | 156 (100%) | 1,822 (100%) |
| eGFR_text | ||||
| altered | 607 (66%) | 0 (0%) | 156 (100%) | 0 (0%) |
| normal | 308 (34%) | 10 (100%) | 0 (0%) | 1,822 (100%) |
| GFR_text_AgeSpecCut | ||||
| altered | 568 (62%) | 10 (100%) | 0 (0%) | 0 (0%) |
| normal | 347 (38%) | 0 (0%) | 156 (100%) | 1,822 (100%) |
| 1 n (%); Median (Q1, Q3) | ||||
2.3.2.3 Data summary - screening cohort
Open code
data_ckd_sum %>%
dplyr::filter(consent == 1) %>%
dplyr::select(-consent) %>%
gtsummary::tbl_summary(by = ckd_status)| Characteristic | CKD_both N = 5311 |
CKD_only_age_calibrated N = 71 |
CKD_only_original N = 981 |
NO CKD N = 1,2971 |
|---|---|---|---|---|
| age | 70 (60, 76) | 39 (32, 46) | 76 (72, 80) | 60 (50, 69) |
| sex | ||||
| F | 220 (41%) | 3 (43%) | 50 (51%) | 597 (46%) |
| M | 311 (59%) | 4 (57%) | 48 (49%) | 700 (54%) |
| uACR_value | 5 (2, 13) | 1 (0, 1) | 1 (0, 1) | 0 (0, 1) |
| eGFR_value | 0.86 (0.69, 1.25) | 1.03 (1.01, 1.07) | 0.95 (0.90, 0.97) | 1.41 (1.24, 1.58) |
| identified_CKD_by_lab | 531 (100%) | 0 (0%) | 98 (100%) | 0 (0%) |
| CKD_record | 199 (37%) | 0 (0%) | 13 (13%) | 32 (2.5%) |
| new_cases | 230 (43%) | 0 (0%) | 69 (70%) | 0 (0%) |
| transplant | 132 (25%) | 4 (57%) | 7 (7.1%) | 105 (8.1%) |
| BMI_last | 28.7 (25.3, 32.0) | 23.1 (20.9, 30.3) | 27.5 (25.0, 30.8) | 28.1 (24.5, 31.6) |
| Unknown | 5 | 0 | 0 | 15 |
| FU_stroke | 35 (6.6%) | 0 (0%) | 5 (5.1%) | 44 (3.4%) |
| FU_PAD | 56 (11%) | 0 (0%) | 5 (5.1%) | 29 (2.2%) |
| FU_DM | 363 (68%) | 2 (29%) | 52 (53%) | 710 (55%) |
| FU_DM1 | 67 (13%) | 2 (29%) | 6 (6.1%) | 280 (22%) |
| FU_DM2 | 296 (56%) | 0 (0%) | 46 (47%) | 430 (33%) |
| FU_atherosclerosis | 189 (36%) | 0 (0%) | 38 (39%) | 227 (18%) |
| ischemic_heart_disease | 135 (25%) | 0 (0%) | 27 (28%) | 127 (9.8%) |
| FU_steatosis | 191 (36%) | 2 (29%) | 29 (30%) | 335 (26%) |
| FU_hypertension | 500 (94%) | 6 (86%) | 84 (86%) | 947 (73%) |
| FU_atrial_fibrillation | 110 (21%) | 1 (14%) | 29 (30%) | 133 (10%) |
| FU_heart_failure | 119 (22%) | 2 (29%) | 25 (26%) | 156 (12%) |
| FU_charlson_index | 3.00 (2.00, 5.00) | 3.00 (2.00, 4.00) | 3.00 (1.00, 4.00) | 2.00 (1.00, 3.00) |
| FU_GLP1 | 99 (19%) | 1 (14%) | 4 (4.1%) | 145 (11%) |
| FU_SGLT2 | 168 (32%) | 0 (0%) | 14 (14%) | 141 (11%) |
| FU_RAASi | 403 (76%) | 2 (29%) | 71 (72%) | 727 (56%) |
| FU_finerenone | 3 (0.6%) | 0 (0%) | 0 (0%) | 1 (<0.1%) |
| elig_RAASi_all | 531 (100%) | 0 (0%) | 98 (100%) | 0 (0%) |
| elig_SGLT2i_total | 311 (59%) | 2 (29%) | 58 (59%) | 269 (21%) |
| elig_GLP1_RA | 138 (26%) | 0 (0%) | 21 (21%) | 0 (0%) |
| elig_finerenone | 19 (3.6%) | 0 (0%) | 0 (0%) | 0 (0%) |
| BMI_over30 | 213 (40%) | 2 (29%) | 30 (31%) | 436 (34%) |
| Unknown | 5 | 0 | 0 | 15 |
| sex_female | 220 (41%) | 3 (43%) | 50 (51%) | 597 (46%) |
| HF_or_AF | 175 (33%) | 3 (43%) | 38 (39%) | 227 (18%) |
| eGFR_AgeSpecCut | 53.2 (51.0, 57.1) | 65.7 (63.8, 69.0) | 51.7 (50.0, 52.8) | 57.1 (53.9, 60.8) |
| ACR_text | ||||
| altered | 353 (66%) | 0 (0%) | 0 (0%) | 0 (0%) |
| normal | 178 (34%) | 7 (100%) | 98 (100%) | 1,297 (100%) |
| eGFR_text | ||||
| altered | 321 (60%) | 0 (0%) | 98 (100%) | 0 (0%) |
| normal | 210 (40%) | 7 (100%) | 0 (0%) | 1,297 (100%) |
| GFR_text_AgeSpecCut | ||||
| altered | 301 (57%) | 7 (100%) | 0 (0%) | 0 (0%) |
| normal | 230 (43%) | 0 (0%) | 98 (100%) | 1,297 (100%) |
| 1 Median (Q1, Q3); n (%) | ||||
3 Correlations
3.1 Overall correlations
Open code
M <- data_ckd %>%
dplyr::select(
where(is.numeric)
) %>%
dplyr::select(
age:FU_finerenone, FU_stroke:BMI_over30,
CKD_record:identified_CKD_by_lab, HF_or_AF
) %>%
cor(method = "spearman", use = "pairwise.complete.obs")
kableExtra::kable(M)| age | uACR_value | eGFR_value | identified_CKD_by_lab | CKD_record | new_cases | transplant | BMI_last | FU_stroke | FU_PAD | FU_DM | FU_DM1 | FU_DM2 | FU_atherosclerosis | ischemic_heart_disease | FU_steatosis | FU_hypertension | FU_atrial_fibrillation | FU_heart_failure | FU_charlson_index | FU_GLP1 | FU_SGLT2 | FU_RAASi | FU_finerenone | elig_RAASi_all | elig_SGLT2i_total | elig_GLP1_RA | elig_finerenone | BMI_over30 | HF_or_AF | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| age | 1.0000000 | 0.1438115 | -0.5485449 | 0.3518026 | 0.1373354 | 0.2064700 | -0.0485906 | 0.0477478 | 0.1405227 | 0.1859326 | 0.0115023 | -0.3648338 | 0.2936970 | 0.3248418 | 0.2667146 | 0.0114453 | 0.2872101 | 0.2810557 | 0.2173686 | 0.2451918 | 0.0291430 | 0.1550354 | 0.2484819 | 0.0245473 | 0.3518026 | 0.4013146 | 0.1551095 | 0.0640625 | 0.0152382 | 0.2914339 |
| uACR_value | 0.1438115 | 1.0000000 | -0.2304800 | 0.5156411 | 0.2980254 | 0.2278229 | 0.0970113 | 0.0784040 | 0.0581415 | 0.1130855 | 0.1316775 | -0.0728417 | 0.1885196 | 0.1657676 | 0.1729872 | 0.0510682 | 0.1961610 | 0.1026473 | 0.1037616 | 0.2572110 | 0.1195255 | 0.2404619 | 0.1580258 | 0.0695379 | 0.5156411 | 0.1891801 | 0.2473725 | 0.1726782 | 0.0607234 | 0.1131036 |
| eGFR_value | -0.5485449 | -0.2304800 | 1.0000000 | -0.6273781 | -0.4555025 | -0.2214475 | -0.2025908 | -0.0305185 | -0.1130875 | -0.1758653 | 0.0460171 | 0.2651377 | -0.1588538 | -0.2800259 | -0.2402767 | -0.0833796 | -0.2605943 | -0.2447025 | -0.2270257 | -0.2879623 | 0.0227401 | -0.2204749 | -0.1995405 | -0.0754564 | -0.6273781 | -0.5438662 | -0.2435248 | -0.1367272 | -0.0087684 | -0.2762712 |
| identified_CKD_by_lab | 0.3518026 | 0.5156411 | -0.6273781 | 1.0000000 | 0.4956882 | 0.5251103 | 0.1873520 | 0.0262629 | 0.0880361 | 0.1767042 | 0.0861409 | -0.1266679 | 0.1844344 | 0.2343634 | 0.2235534 | 0.0721458 | 0.2484246 | 0.1995980 | 0.1983615 | 0.3260864 | 0.0457045 | 0.2869684 | 0.2020231 | 0.0647095 | 1.0000000 | 0.4117616 | 0.4136664 | 0.1336475 | 0.0192361 | 0.2267517 |
| CKD_record | 0.1373354 | 0.2980254 | -0.4555025 | 0.4956882 | 1.0000000 | -0.1941122 | 0.1052219 | 0.0007835 | 0.0826657 | 0.1644855 | 0.0281853 | -0.0491510 | 0.0663059 | 0.1604063 | 0.1466140 | 0.0355267 | 0.1838009 | 0.1573842 | 0.1681193 | 0.2241734 | 0.0114523 | 0.2567612 | 0.1723983 | 0.0765969 | 0.4956882 | 0.2792951 | 0.1986696 | 0.1331306 | -0.0064424 | 0.1716730 |
| new_cases | 0.2064700 | 0.2278229 | -0.2214475 | 0.5251103 | -0.1941122 | 1.0000000 | 0.1493573 | -0.0080609 | 0.0479772 | 0.0107179 | -0.0476902 | -0.1219815 | 0.0464620 | 0.0880647 | 0.0887045 | 0.0866624 | 0.0791119 | 0.0681775 | 0.0576099 | 0.1289762 | -0.0487714 | -0.0118998 | 0.0319456 | -0.0066013 | 0.5251103 | 0.1351858 | 0.1398161 | -0.0114735 | -0.0037454 | 0.0846053 |
| transplant | -0.0485906 | 0.0970113 | -0.2025908 | 0.1873520 | 0.1052219 | 0.1493573 | 1.0000000 | -0.1281321 | 0.0065825 | -0.0106057 | -0.0459493 | -0.1352930 | 0.0585043 | -0.0082893 | 0.0082917 | 0.3008336 | 0.1283034 | 0.0245296 | -0.0170970 | 0.3687513 | -0.0750543 | -0.0452984 | -0.0605333 | 0.0141039 | 0.1873520 | 0.1046307 | 0.0362842 | 0.0140914 | -0.0812494 | 0.0140224 |
| BMI_last | 0.0477478 | 0.0784040 | -0.0305185 | 0.0262629 | 0.0007835 | -0.0080609 | -0.1281321 | 1.0000000 | 0.0162968 | 0.0171101 | 0.1678017 | -0.1321862 | 0.2706854 | 0.1123256 | 0.1168833 | 0.0983141 | 0.2556678 | 0.0821163 | 0.0863723 | 0.0826331 | 0.3336926 | 0.1522972 | 0.2987545 | 0.0366925 | 0.0262629 | 0.1435401 | 0.3642304 | 0.0352900 | 0.8293901 | 0.1016758 |
| FU_stroke | 0.1405227 | 0.0581415 | -0.1130875 | 0.0880361 | 0.0826657 | 0.0479772 | 0.0065825 | 0.0162968 | 1.0000000 | 0.0757382 | 0.0154104 | -0.0558857 | 0.0586901 | 0.3901670 | 0.1397161 | -0.0121548 | 0.0862051 | 0.1217171 | 0.0980619 | 0.2103110 | -0.0088053 | 0.0727939 | 0.0829923 | 0.0124447 | 0.0880361 | 0.1137870 | 0.0433564 | 0.0063855 | 0.0016857 | 0.1297184 |
| FU_PAD | 0.1859326 | 0.1130855 | -0.1758653 | 0.1767042 | 0.1644855 | 0.0107179 | -0.0106057 | 0.0171101 | 0.0757382 | 1.0000000 | 0.1040154 | -0.0372239 | 0.1332050 | 0.4202279 | 0.2510628 | -0.0190929 | 0.0893512 | 0.1061988 | 0.1168913 | 0.2502272 | 0.0432476 | 0.1329275 | 0.1055208 | 0.0097000 | 0.1767042 | 0.1709358 | 0.1254789 | 0.1024982 | 0.0051275 | 0.1438731 |
| FU_DM | 0.0115023 | 0.1316775 | 0.0460171 | 0.0861409 | 0.0281853 | -0.0476902 | -0.0459493 | 0.1678017 | 0.0154104 | 0.1040154 | 1.0000000 | 0.3901810 | 0.7021103 | 0.0704601 | 0.0938405 | -0.0293092 | 0.0303802 | -0.0375624 | -0.0676666 | 0.3689505 | 0.2987397 | 0.2759490 | 0.1230020 | 0.0498096 | 0.0861409 | 0.1724190 | 0.2679596 | 0.0865725 | 0.1217397 | -0.0751661 |
| FU_DM1 | -0.3648338 | -0.0728417 | 0.2651377 | -0.1266679 | -0.0491510 | -0.1219815 | -0.1352930 | -0.1321862 | -0.0558857 | -0.0372239 | 0.3901810 | 1.0000000 | -0.3816782 | -0.1596572 | -0.1293922 | -0.1967329 | -0.2527669 | -0.1747790 | -0.1703784 | -0.0188653 | -0.1081524 | -0.1243910 | -0.0964463 | -0.0116038 | -0.1266679 | -0.3124114 | -0.1456671 | -0.0470622 | -0.1040881 | -0.2161838 |
| FU_DM2 | 0.2936970 | 0.1885196 | -0.1588538 | 0.1844344 | 0.0663059 | 0.0464620 | 0.0585043 | 0.2706854 | 0.0586901 | 0.1332050 | 0.7021103 | -0.3816782 | 1.0000000 | 0.1942059 | 0.1942707 | 0.1227242 | 0.2259791 | 0.0974608 | 0.0638370 | 0.3849657 | 0.3835353 | 0.3732150 | 0.1980655 | 0.0589760 | 0.1844344 | 0.4146937 | 0.3816489 | 0.1233032 | 0.2027185 | 0.0917329 |
| FU_atherosclerosis | 0.3248418 | 0.1657676 | -0.2800259 | 0.2343634 | 0.1604063 | 0.0880647 | -0.0082893 | 0.1123256 | 0.3901670 | 0.4202279 | 0.0704601 | -0.1596572 | 0.1942059 | 1.0000000 | 0.7708889 | -0.0173615 | 0.2180594 | 0.2721835 | 0.3371835 | 0.3103856 | 0.0204070 | 0.2383235 | 0.2001738 | 0.0308543 | 0.2343634 | 0.3509625 | 0.1741043 | 0.0844011 | 0.0852352 | 0.3604145 |
| ischemic_heart_disease | 0.2667146 | 0.1729872 | -0.2402767 | 0.2235534 | 0.1466140 | 0.0887045 | 0.0082917 | 0.1168833 | 0.1397161 | 0.2510628 | 0.0938405 | -0.1293922 | 0.1942707 | 0.7708889 | 1.0000000 | -0.0100368 | 0.1949220 | 0.2405340 | 0.3433464 | 0.2834855 | 0.0469210 | 0.2620341 | 0.1849589 | 0.0340222 | 0.2235534 | 0.3283663 | 0.1967967 | 0.0858219 | 0.0876130 | 0.3334520 |
| FU_steatosis | 0.0114453 | 0.0510682 | -0.0833796 | 0.0721458 | 0.0355267 | 0.0866624 | 0.3008336 | 0.0983141 | -0.0121548 | -0.0190929 | -0.0293092 | -0.1967329 | 0.1227242 | -0.0173615 | -0.0100368 | 1.0000000 | 0.0989057 | -0.0142376 | -0.0183762 | 0.3408819 | 0.0615064 | 0.0172279 | -0.0094486 | -0.0102346 | 0.0721458 | 0.0741967 | 0.0524439 | 0.0430358 | 0.0926648 | -0.0159328 |
| FU_hypertension | 0.2872101 | 0.1961610 | -0.2605943 | 0.2484246 | 0.1838009 | 0.0791119 | 0.1283034 | 0.2556678 | 0.0862051 | 0.0893512 | 0.0303802 | -0.2527669 | 0.2259791 | 0.2180594 | 0.1949220 | 0.0989057 | 1.0000000 | 0.1859768 | 0.1527323 | 0.2437345 | 0.1160189 | 0.1995457 | 0.5868840 | 0.0283609 | 0.2484246 | 0.2481284 | 0.1342036 | 0.0492933 | 0.1996070 | 0.2052561 |
| FU_atrial_fibrillation | 0.2810557 | 0.1026473 | -0.2447025 | 0.1995980 | 0.1573842 | 0.0681775 | 0.0245296 | 0.0821163 | 0.1217171 | 0.1061988 | -0.0375624 | -0.1747790 | 0.0974608 | 0.2721835 | 0.2405340 | -0.0142376 | 0.1859768 | 1.0000000 | 0.4180851 | 0.1750324 | 0.0012434 | 0.2132033 | 0.1321718 | 0.0500142 | 0.1995980 | 0.3537103 | 0.1369360 | 0.0600964 | 0.0825674 | 0.7665619 |
| FU_heart_failure | 0.2173686 | 0.1037616 | -0.2270257 | 0.1983615 | 0.1681193 | 0.0576099 | -0.0170970 | 0.0863723 | 0.0980619 | 0.1168913 | -0.0676666 | -0.1703784 | 0.0638370 | 0.3371835 | 0.3433464 | -0.0183762 | 0.1527323 | 0.4180851 | 1.0000000 | 0.2709789 | -0.0182499 | 0.2541193 | 0.1431726 | 0.0628415 | 0.1983615 | 0.6235469 | 0.1146740 | 0.0741327 | 0.0700245 | 0.7901274 |
| FU_charlson_index | 0.2451918 | 0.2572110 | -0.2879623 | 0.3260864 | 0.2241734 | 0.1289762 | 0.3687513 | 0.0826331 | 0.2103110 | 0.2502272 | 0.3689505 | -0.0188653 | 0.3849657 | 0.3103856 | 0.2834855 | 0.3408819 | 0.2437345 | 0.1750324 | 0.2709789 | 1.0000000 | 0.1321378 | 0.2429765 | 0.1447587 | 0.0465658 | 0.3260864 | 0.3994967 | 0.2239890 | 0.1011811 | 0.0619656 | 0.2481446 |
| FU_GLP1 | 0.0291430 | 0.1195255 | 0.0227401 | 0.0457045 | 0.0114523 | -0.0487714 | -0.0750543 | 0.3336926 | -0.0088053 | 0.0432476 | 0.2987397 | -0.1081524 | 0.3835353 | 0.0204070 | 0.0469210 | 0.0615064 | 0.1160189 | 0.0012434 | -0.0182499 | 0.1321378 | 1.0000000 | 0.2606189 | 0.1545956 | 0.0296625 | 0.0457045 | 0.0735726 | 0.2692226 | 0.0414341 | 0.2944725 | -0.0133856 |
| FU_SGLT2 | 0.1550354 | 0.2404619 | -0.2204749 | 0.2869684 | 0.2567612 | -0.0118998 | -0.0452984 | 0.1522972 | 0.0727939 | 0.1329275 | 0.2759490 | -0.1243910 | 0.3732150 | 0.2383235 | 0.2620341 | 0.0172279 | 0.1995457 | 0.2132033 | 0.2541193 | 0.2429765 | 0.2606189 | 1.0000000 | 0.2201391 | 0.0567680 | 0.2869684 | 0.3313672 | 0.2658442 | 0.1322320 | 0.1118875 | 0.2494101 |
| FU_RAASi | 0.2484819 | 0.1580258 | -0.1995405 | 0.2020231 | 0.1723983 | 0.0319456 | -0.0605333 | 0.2987545 | 0.0829923 | 0.1055208 | 0.1230020 | -0.0964463 | 0.1980655 | 0.2001738 | 0.1849589 | -0.0094486 | 0.5868840 | 0.1321718 | 0.1431726 | 0.1447587 | 0.1545956 | 0.2201391 | 1.0000000 | 0.0316658 | 0.2020231 | 0.2253559 | 0.1513622 | 0.0621412 | 0.2199462 | 0.1564324 |
| FU_finerenone | 0.0245473 | 0.0695379 | -0.0754564 | 0.0647095 | 0.0765969 | -0.0066013 | 0.0141039 | 0.0366925 | 0.0124447 | 0.0097000 | 0.0498096 | -0.0116038 | 0.0589760 | 0.0308543 | 0.0340222 | -0.0102346 | 0.0283609 | 0.0500142 | 0.0628415 | 0.0465658 | 0.0296625 | 0.0567680 | 0.0316658 | 1.0000000 | 0.0647095 | 0.0525770 | 0.1245406 | 0.1102640 | 0.0301065 | 0.0443254 |
| elig_RAASi_all | 0.3518026 | 0.5156411 | -0.6273781 | 1.0000000 | 0.4956882 | 0.5251103 | 0.1873520 | 0.0262629 | 0.0880361 | 0.1767042 | 0.0861409 | -0.1266679 | 0.1844344 | 0.2343634 | 0.2235534 | 0.0721458 | 0.2484246 | 0.1995980 | 0.1983615 | 0.3260864 | 0.0457045 | 0.2869684 | 0.2020231 | 0.0647095 | 1.0000000 | 0.4117616 | 0.4136664 | 0.1336475 | 0.0192361 | 0.2267517 |
| elig_SGLT2i_total | 0.4013146 | 0.1891801 | -0.5438662 | 0.4117616 | 0.2792951 | 0.1351858 | 0.1046307 | 0.1435401 | 0.1137870 | 0.1709358 | 0.1724190 | -0.3124114 | 0.4146937 | 0.3509625 | 0.3283663 | 0.0741967 | 0.2481284 | 0.3537103 | 0.6235469 | 0.3994967 | 0.0735726 | 0.3313672 | 0.2253559 | 0.0525770 | 0.4117616 | 1.0000000 | 0.2972513 | 0.1337464 | 0.1031231 | 0.5727910 |
| elig_GLP1_RA | 0.1551095 | 0.2473725 | -0.2435248 | 0.4136664 | 0.1986696 | 0.1398161 | 0.0362842 | 0.3642304 | 0.0433564 | 0.1254789 | 0.2679596 | -0.1456671 | 0.3816489 | 0.1741043 | 0.1967967 | 0.0524439 | 0.1342036 | 0.1369360 | 0.1146740 | 0.2239890 | 0.2692226 | 0.2658442 | 0.1513622 | 0.1245406 | 0.4136664 | 0.2972513 | 1.0000000 | 0.1453800 | 0.4076417 | 0.1452547 |
| elig_finerenone | 0.0640625 | 0.1726782 | -0.1367272 | 0.1336475 | 0.1331306 | -0.0114735 | 0.0140914 | 0.0352900 | 0.0063855 | 0.1024982 | 0.0865725 | -0.0470622 | 0.1233032 | 0.0844011 | 0.0858219 | 0.0430358 | 0.0492933 | 0.0600964 | 0.0741327 | 0.1011811 | 0.0414341 | 0.1322320 | 0.0621412 | 0.1102640 | 0.1336475 | 0.1337464 | 0.1453800 | 1.0000000 | 0.0298188 | 0.0539317 |
| BMI_over30 | 0.0152382 | 0.0607234 | -0.0087684 | 0.0192361 | -0.0064424 | -0.0037454 | -0.0812494 | 0.8293901 | 0.0016857 | 0.0051275 | 0.1217397 | -0.1040881 | 0.2027185 | 0.0852352 | 0.0876130 | 0.0926648 | 0.1996070 | 0.0825674 | 0.0700245 | 0.0619656 | 0.2944725 | 0.1118875 | 0.2199462 | 0.0301065 | 0.0192361 | 0.1031231 | 0.4076417 | 0.0298188 | 1.0000000 | 0.0920107 |
| HF_or_AF | 0.2914339 | 0.1131036 | -0.2762712 | 0.2267517 | 0.1716730 | 0.0846053 | 0.0140224 | 0.1016758 | 0.1297184 | 0.1438731 | -0.0751661 | -0.2161838 | 0.0917329 | 0.3604145 | 0.3334520 | -0.0159328 | 0.2052561 | 0.7665619 | 0.7901274 | 0.2481446 | -0.0133856 | 0.2494101 | 0.1564324 | 0.0443254 | 0.2267517 | 0.5727910 | 0.1452547 | 0.0539317 | 0.0920107 | 1.0000000 |
Open code
par(mfrow = c(1, 1))
corrplot::corrplot(
M,
method = "square",
col = colorRampPalette(c("blue", "white", "red"))(200),
tl.col = "black",
tl.cex = 0.8,
tl.srt = 40,
diag = TRUE,
order = "hclust",
hclust.method = "average",
)3.2 Correlations between canditate predictors in multivariable models
Open code
M <- data_ckd %>%
dplyr::select(
where(is.numeric)
) %>%
dplyr::select(
age:eGFR_value,
transplant, BMI_last, BMI_over30, FU_stroke:FU_charlson_index, FU_stroke,
HF_or_AF
) %>%
cor(method = "spearman", use = "pairwise.complete.obs")
corrplot::corrplot(
M,
method = "number",
col = colorRampPalette(c("blue", "white", "red"))(200),
tl.col = "black",
tl.cex = 0.8,
tl.srt = 40,
diag = TRUE,
order = "hclust",
hclust.method = "average",
)3.3 UpSet plot for comorbidities
Only these combinations of comorbodities present in at least 30 people are shown
Open code
data_upset <- data_ckd %>%
dplyr::mutate(
age_60plus = if_else(age >= 60, 1, 0),
BMI_over30 = if_else(is.na(BMI_over30), 0, BMI_over30),
CKD = if_else(identified_CKD_by_lab == 1, "Yes", "No")
) %>%
dplyr::select(
transplant,
FU_DM1, FU_DM2,
FU_steatosis, FU_hypertension, HF_or_AF,
FU_atherosclerosis, CKD
) %>%
data.frame()
names(data_upset)
## [1] "transplant" "FU_DM1" "FU_DM2"
## [4] "FU_steatosis" "FU_hypertension" "HF_or_AF"
## [7] "FU_atherosclerosis" "CKD"
namely <- c(
"Non-renal TX", "T1DM", "T2DM", "Liver steatosis",
"A. hypertension", "HF or AF",
"ASCVD", "CKD"
)
names(data_upset) <- namely
sets <- names(data_upset)[names(data_upset) != "CKD"]
my_themes <- ComplexUpset::upset_modify_themes(list(
overall_sizes = theme(
axis.text.x = element_blank(),
axis.ticks.x = element_blank()
),
intersections_matrix = theme(
axis.text.y = element_text(size = 11)
),
`Intersection size` = theme(
axis.text.y = element_text(size = 12),
axis.title.y = element_text(size = 13)
)
))
p <- ComplexUpset::upset(
data_upset,
intersect = sets,
set_sizes = ComplexUpset::upset_set_size() +
scale_x_continuous(labels = NULL),
base_annotations = list(
"Intersection size" = ComplexUpset::intersection_size(
text = list(size = 0)
)
),
annotations = list(
"CKD proportion" = (
ggplot(mapping = aes(fill = CKD)) +
geom_bar(position = "fill") +
scale_y_continuous(
labels = percent_format(accuracy = 1),
breaks = c(0, 1),
) +
scale_fill_manual(
values = c(
"Yes" = "red",
"No" = "grey80"
)
) +
labs(y = "CKD", x = NULL, fill = "CKD") +
theme(
axis.text.y = element_text(size = 12),
axis.title.y = element_text(size = 13)
)
)
),
width_ratio = 0.2,
height_ratio = 0.6,
min_size = 30,
themes = my_themes
)
## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.
plotac <- "sup_figure_upset_comorbidities"
path <- "gitignore/figures"
fig <- p + patchwork::plot_layout(
heights = c(
0.5,
1,
0.7
)
)
fig
## Warning: Removed 431 rows containing non-finite outside the scale range
## (`stat_count()`).Open code
if (!dir.exists(path)) {
dir.create(path, recursive = TRUE)
}
if (!file.exists(file.path(path, paste0(plotac, ".pdf")))) {
ggsave(
filename = paste0(plotac, ".pdf"),
plot = fig,
path = path,
device = "pdf",
width = 8,
height = 5.5
)
}4 Precision-based sample size calculation
Select pre-specified data
Open code
data_power <- data_ckd %>%
dplyr::filter(
date_sampling < ymd("2025-03-01"),
consent == 1
) %>%
dplyr::select(identified_CKD_by_lab)
summary(data_power)
## identified_CKD_by_lab
## Min. :0.000
## 1st Qu.:0.000
## Median :0.000
## Mean :0.325
## 3rd Qu.:1.000
## Max. :1.000
dim(data_power)
## [1] 120 1Estimated proportion and CI
Open code
ci <- inv_logit(
confint(
glm(
identified_CKD_by_lab ~ +1,
data = data_power,
family = binomial(link = "logit")
)
)
)
## Waiting for profiling to be done...
ci
## 2.5 % 97.5 %
## 0.2455191 0.4118730
prop <- mean(data_power$identified_CKD_by_lab)
prop
## [1] 0.3254.1 90% probability that 95% CI width ≤ 5%
Open code
plotac <- "suppl_fig_1"
path <- "gitignore/figures"
sim_prec <- function(size, probs, reps = 2000, ci_width = 0.05) {
x <- rbinom(n = reps, size = size, prob = probs)
ciw <- vapply(
x,
function(xx) {
ci <- binom.test(xx, size)$conf.int
ci[2] - ci[1]
},
numeric(1)
)
mean(ciw <= ci_width)
}
sizes <- seq(1000, 2000, by = 25)
res <- mclapply(
sizes,
function(n) {
data.frame(
n = n,
precision_probability = sim_prec(
n,
probs = prop,
reps = 2000
)
)
},
mc.cores = detectCores() - 1
) %>%
dplyr::bind_rows()
kableExtra::kable(res)| n | precision_probability |
|---|---|
| 1000 | 0.0000 |
| 1025 | 0.0000 |
| 1050 | 0.0000 |
| 1075 | 0.0000 |
| 1100 | 0.0000 |
| 1125 | 0.0000 |
| 1150 | 0.0000 |
| 1175 | 0.0000 |
| 1200 | 0.0000 |
| 1225 | 0.0000 |
| 1250 | 0.0000 |
| 1275 | 0.0000 |
| 1300 | 0.0020 |
| 1325 | 0.0180 |
| 1350 | 0.1095 |
| 1375 | 0.3635 |
| 1400 | 0.7155 |
| 1425 | 0.9390 |
| 1450 | 0.9965 |
| 1475 | 1.0000 |
| 1500 | 1.0000 |
| 1525 | 1.0000 |
| 1550 | 1.0000 |
| 1575 | 1.0000 |
| 1600 | 1.0000 |
| 1625 | 1.0000 |
| 1650 | 1.0000 |
| 1675 | 1.0000 |
| 1700 | 1.0000 |
| 1725 | 1.0000 |
| 1750 | 1.0000 |
| 1775 | 1.0000 |
| 1800 | 1.0000 |
| 1825 | 1.0000 |
| 1850 | 1.0000 |
| 1875 | 1.0000 |
| 1900 | 1.0000 |
| 1925 | 1.0000 |
| 1950 | 1.0000 |
| 1975 | 1.0000 |
| 2000 | 1.0000 |
Open code
fig <- ggplot(
res,
aes(
x = n,
y = precision_probability
)
) +
geom_line() +
geom_point() +
geom_hline(
yintercept = 0.9,
linetype = 2
) +
scale_x_continuous(
breaks = seq(1000, 2000, by = 100)
) +
scale_y_continuous(
limits = c(0, 1),
labels = scales::percent_format(accuracy = 1)
) +
labs(
x = "Sample size",
y = "Probability of achieving target precision"
) +
theme_minimal()
figOpen code
if (!dir.exists(path)) {
dir.create(path, recursive = TRUE)
}
if (!file.exists(file.path(path, paste0(plotac, ".pdf")))) {
ggsave(
filename = paste0(plotac, ".pdf"),
plot = fig,
path = path,
device = "pdf",
width = 8,
height = 5.5
)
}\(\Rightarrow\) According to the defined criterion, a total sample size of 1,425 participants was sufficient: it was the smallest evaluated sample size at which more than 90% of the 2000 simulated datasets produced a 95% confidence interval narrower than 5 percentage points. Larger sample sizes (e.g., 1,450) provided an even higher probability that the interval width would be below this threshold, but were not required to meet the predefined target.
5 Models
5.1 Identified_CKD_by_lab
Open code
out_mean <- logit(mean(data_ckd$identified_CKD_by_lab))
sd(log2(data_ckd$FU_charlson_index+1))
## [1] 0.82345195.1.1 Unadjsuted effects
5.1.1.1 Define predictors
Open code
preds <- c(
'age_30y', 'age_60plus', 'sex_female', 'BMI10_last', 'BMI_over30', 'transplant',
'FU_DM1', 'FU_DM2', 'FU_DM',
'FU_atherosclerosis', 'FU_stroke', 'FU_PAD', 'ischemic_heart_disease',
'FU_hypertension', 'FU_atrial_fibrillation','FU_heart_failure', 'HF_or_AF',
'log2_FU_charlson_index', 'charlson_index_5', 'FU_steatosis'
)5.1.1.2 Fit models
Open code
kableExtra::kable(
cbind(
unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age / 30),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
sex_female = if_else(sex == "F", 1, 0),
BMI10_last = (BMI_last / 10)
) %>% dplyr::filter(
consent == 0
),
outcome = "identified_CKD_by_lab",
predictors = preds,
family = "logistic",
rounding = 2
) %>% rename(
`OR [95% CI]` = `OR`
),
unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age / 30),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
sex_female = if_else(sex == "F", 1, 0),
BMI10_last = (BMI_last / 10)
) %>% dplyr::filter(
consent == 1
),
outcome = "identified_CKD_by_lab",
predictors = preds,
family = "logistic",
rounding = 2
) %>%
dplyr::select(OR, N) %>%
rename(
`OR [95% CI]` = `OR`
),
unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age / 30),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
BMI10_last = (BMI_last / 10)
),
outcome = "identified_CKD_by_lab",
predictors = preds,
family = "logistic",
rounding = 2
) %>%
dplyr::select(OR, N) %>%
rename(
`OR [95% CI]` = `OR`
)
),
align = c("r", "c", "c", "c", "c", "c", "c")
) %>%
add_header_above(
c(" " = 1, "unscreened" = 2, "screening" = 2, "enriched" = 2)
) %>%
column_spec(1, width = "10em") %>%
column_spec(c(2, 4, 6), width = "8em") %>%
column_spec(c(3, 5, 7), width = "5em")| predictor | OR [95% CI] | N | OR [95% CI] | N | OR [95% CI] | N |
|---|---|---|---|---|---|---|
| age_30y | 4.61 [3.41, 6.31] | 970 | 6.63 [5.09, 8.73] | 1933 | 5.65 [4.63, 6.93] | 2903 |
| age_60plus | 3.18 [2.41, 4.21] | 970 | 3.6 [2.88, 4.51] | 1933 | 3.37 [2.84, 4.01] | 2903 |
| sex_female | 0.88 [0.68, 1.14] | 970 | 0.88 [0.73, 1.07] | 1933 | 0.87 [0.75, 1.01] | 2903 |
| BMI10_last | 0.92 [0.72, 1.16] | 960 | 1.18 [0.99, 1.42] | 1913 | 1.08 [0.94, 1.25] | 2873 |
| BMI_over30 | 0.86 [0.66, 1.12] | 960 | 1.24 [1.02, 1.51] | 1913 | 1.09 [0.93, 1.27] | 2873 |
| transplant | 3.77 [2.42, 6.02] | 970 | 3.11 [2.37, 4.09] | 1933 | 3.13 [2.49, 3.94] | 2903 |
| FU_DM1 | 0.47 [0.32, 0.68] | 970 | 0.48 [0.36, 0.62] | 1933 | 0.47 [0.38, 0.58] | 2903 |
| FU_DM2 | 1.79 [1.39, 2.32] | 970 | 2.42 [1.99, 2.94] | 1933 | 2.17 [1.86, 2.53] | 2903 |
| FU_DM | 1.22 [0.94, 1.57] | 970 | 1.61 [1.32, 1.97] | 1933 | 1.44 [1.24, 1.68] | 2903 |
| FU_atherosclerosis | 3.01 [2.28, 3.97] | 970 | 2.68 [2.16, 3.33] | 1933 | 2.91 [2.46, 3.45] | 2903 |
| FU_stroke | 2.22 [1.35, 3.74] | 970 | 1.94 [1.25, 3.02] | 1933 | 2.17 [1.57, 3.02] | 2903 |
| FU_PAD | 3.65 [2.26, 6.11] | 970 | 4.72 [3.03, 7.52] | 1933 | 4.48 [3.23, 6.3] | 2903 |
| ischemic_heart_disease | 2.85 [2.1, 3.89] | 970 | 3.21 [2.49, 4.16] | 1933 | 3.21 [2.64, 3.91] | 2903 |
| FU_hypertension | 6.62 [4.18, 10.98] | 970 | 4.78 [3.48, 6.71] | 1933 | 5.44 [4.18, 7.18] | 2903 |
| FU_atrial_fibrillation | 2.97 [2.19, 4.04] | 970 | 2.48 [1.91, 3.21] | 1933 | 2.84 [2.34, 3.46] | 2903 |
| FU_heart_failure | 3.61 [2.64, 4.96] | 970 | 2.15 [1.68, 2.76] | 1933 | 2.77 [2.29, 3.36] | 2903 |
| HF_or_AF | 3.23 [2.45, 4.27] | 970 | 2.39 [1.92, 2.97] | 1933 | 2.82 [2.38, 3.34] | 2903 |
| log2_FU_charlson_index | 2.32 [1.94, 2.79] | 970 | 2.52 [2.2, 2.91] | 1933 | 2.47 [2.22, 2.76] | 2903 |
| charlson_index_5 | 3.54 [2.52, 5.04] | 970 | 4.51 [3.47, 5.89] | 1933 | 4.2 [3.41, 5.19] | 2903 |
| FU_steatosis | 1.22 [0.91, 1.62] | 970 | 1.54 [1.26, 1.89] | 1933 | 1.39 [1.18, 1.64] | 2903 |
5.1.1.3 Visualisation
Open code
unadj_eff_con0 <- unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
BMI10_last = (BMI_last/10)
) %>% dplyr::filter(
consent == 0
),
outcome = "identified_CKD_by_lab",
predictors = preds,
family = "logistic",
paste_CI = FALSE
)
unadj_eff_con1 <- unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
BMI10_last = (BMI_last/10)
) %>% dplyr::filter(
consent == 1
),
outcome = "identified_CKD_by_lab",
predictors = preds,
family = "logistic",
paste_CI = FALSE
)
unadj_eff_overall <- unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
BMI10_last = (BMI_last/10)
),
outcome = "identified_CKD_by_lab",
predictors = preds,
family = "logistic",
paste_CI = FALSE
)
df_plot <- bind_rows(
unadj_eff_con1 %>% mutate(consent = "screening"),
unadj_eff_overall %>% mutate(consent = "overall")
) %>%
mutate(
predictor = recode(
predictor,
"age_30y" = "Age (per 30y)",
"age_60plus" = "Age ≥60y",
"sex_female" = "Female sex",
"BMI10_last" = "BMI (per 10 kg/m²)",
"BMI_over30" = "BMI ≥30 kg/m²",
"transplant" = "Non-renal transplantation",
"FU_DM1" = "T1DM",
"FU_DM2" = "T2DM",
"FU_DM" = "Any diabetes",
"FU_atherosclerosis" = "ASCVD",
"FU_stroke" = "Stroke",
"FU_PAD" = "Peripheral artery disease",
"ischemic_heart_disease" = "Ischemic heart disease",
"FU_hypertension" = "Arterial hypertension",
"FU_atrial_fibrillation" = "Atrial fibrilation",
"FU_heart_failure" = "Heart failure",
"HF_or_AF" = "Heart failure or atrial fibrilation",
"log2_FU_charlson_index" = "log₂ (Charlson index +1)",
"charlson_index_5" = "Charlson index ≥5",
"FU_steatosis" = "Liver steatosis"
),
predictor = factor(predictor, levels = rev(unique(predictor))),
consent = factor(
consent,
levels = c("screening", "overall", "enriched"),
labels = c("Screening cohort", "Enriched cohort", "No consent cohort")
)
)
ggplot(df_plot, aes(x = OR, y = predictor, color = consent, group = consent)) +
geom_point(
position = position_dodge(width = 0.6),
size = 2
) +
geom_errorbarh(
aes(xmin = CI_L, xmax = CI_U),
position = position_dodge(width = 0.6),
height = 0.3
) +
geom_vline(xintercept = 1, linetype = "dashed", color = "gray40") +
scale_x_log10(
breaks = c(1 / 4, 1 / 2, 1, 2, 4, 8),
labels = c("1/4", "1/2", "1", "2", "4", "8")
) +
scale_color_manual(
values = c(
"Enriched cohort" = "skyblue3",
"Screening cohort" = "#d95f02",
"No consent cohort" = "#1b9e77"
),
breaks = c(
"Enriched cohort", "Screening cohort", "No consent cohort")
) +
labs(
x = "Unadjusted odds ratio (log2 scale) for confirmed CKD",
y = NULL,
color = NULL
) +
theme_minimal(base_size = 12) +
theme(
legend.position = "top",
legend.text = element_text(size = 12),
axis.text.y = element_text(size = 11)
)5.1.2 Simple prevalence model
5.1.2.1 Prior
Open code
prior_intercept <- prior_string(
paste0("student_t(3, ", out_mean, ", 100)"),
class = "Intercept"
)5.1.2.2 Fit simple mdoel
Open code
model_simple <- run(
expr = brm(
identified_CKD_by_lab ~ +1,
family = bernoulli(link = "logit"),
data = data_ckd,
backend = "cmdstanr",
seed = 736,
prior = prior_intercept,
cores = 1, chains = 2,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_simple",
reuse = TRUE
)
prior_summary(model_simple)
## Intercept ~ student_t(3, -0.536815474786327, 100)
summary(model_simple, robust = TRUE)
## Family: bernoulli
## Links: mu = logit
## Formula: identified_CKD_by_lab ~ +1
## Data: data_ckd (Number of observations: 2903)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## Intercept -0.54 0.04 -0.61 -0.46 1.00 3369 2717
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
kableExtra::kable(
inv_logit(fixef(model_simple, robust = TRUE)[, c(1, 3,4)])
)| x | |
|---|---|
| Estimate | 0.3691732 |
| Q2.5 | 0.3515779 |
| Q97.5 | 0.3877053 |
5.1.3 Consent-specific
Open code
model_consent_spec <- run(
expr = brm(
identified_CKD_by_lab ~ consent,
family = bernoulli(link = "logit"),
data = data_ckd,
backend = "cmdstanr",
seed = 736,
cores = 1, chains = 2,
prior = prior_intercept,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_consent_spec",
reuse = TRUE
)
prior_summary(model_consent_spec)
## prior class coef group resp dpar nlpar
## (flat) b
## (flat) b consent
## student_t(3, -0.536815474786327, 100) Intercept
## lb ub source
## default
## (vectorized)
## user
summary(model_consent_spec, robust = TRUE)
## Family: bernoulli
## Links: mu = logit
## Formula: identified_CKD_by_lab ~ consent
## Data: data_ckd (Number of observations: 2903)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## Intercept -0.18 0.06 -0.30 -0.05 1.00 6662 5897
## consent -0.55 0.08 -0.71 -0.39 1.00 6073 5337
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
posterior <- as_draws_df(model_consent_spec) %>%
mutate(
consent_prev = inv_logit(b_Intercept + b_consent),
nonconsent_prev = inv_logit(b_Intercept)
)
tr <- posterior_epred(model_consent_spec)
tr2 <- rowMeans(tr)
kableExtra::kable(
data.frame(
rbind(
inv_logit(fixef(model_simple, robust = TRUE)[, c(1, 3, 4)]),
quantile(tr2, probs = c(0.5, 0.025, 0.975)),
quantile(posterior$nonconsent_prev, probs = c(0.5, 0.025, 0.975)),
quantile(posterior$consent_prev, probs = c(0.5, 0.025, 0.975))
)
) %>%
dplyr::mutate(
Estimand = c(
"Marginal prevalence - simple model",
"Marginal prevalence - consent-adj. model",
"Prevalence - consent=0",
"Prevalence - consent=1"
)
) %>% dplyr::select(
Estimand, Estimate, Q2.5, Q97.5
)
)| Estimand | Estimate | Q2.5 | Q97.5 |
|---|---|---|---|
| Marginal prevalence - simple model | 0.3691732 | 0.3515779 | 0.3877053 |
| Marginal prevalence - consent-adj. model | 0.3688440 | 0.3521229 | 0.3864695 |
| Prevalence - consent=0 | 0.4555569 | 0.4249943 | 0.4862831 |
| Prevalence - consent=1 | 0.3252945 | 0.3051103 | 0.3464604 |
Open code
quantile(posterior$consent_prev, probs = c(0.5, 0.025, 0.975))
## 50% 2.5% 97.5%
## 0.3252945 0.3051103 0.34646045.1.4 Non-linear time model
5.1.4.1 Fit model
Open code
model_time_nl <- run(
expr = brm(
identified_CKD_by_lab ~
consent +
s(I( (age-62) / 30), by = consent, k = 5),
family = bernoulli(link = "logit"),
data = data_ckd %>% dplyr::mutate(consent = factor(consent)),
backend = "cmdstanr",
seed = 736,
cores = 1, chains = 2,
prior = prior_intercept,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_time_nl",
reuse = TRUE
)
prior_summary(model_time_nl)
## prior class
## (flat) b
## (flat) b
## (flat) b
## (flat) b
## student_t(3, -0.536815474786327, 100) Intercept
## student_t(3, 0, 2.5) sds
## student_t(3, 0, 2.5) sds
## coef group resp dpar nlpar lb ub
##
## consent1
## sIageM62D30:consent0_1
## sIageM62D30:consent1_1
##
## 0
## s(I((age - 62)/30), by = consent, k = 5) 0
## source
## default
## (vectorized)
## (vectorized)
## (vectorized)
## user
## default
## (vectorized)
summary(model_time_nl, robust = TRUE)
## Warning: There were 1 divergent transitions after warmup. Increasing
## adapt_delta above 0.95 may help. See
## http://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
## Family: bernoulli
## Links: mu = logit
## Formula: identified_CKD_by_lab ~ consent + s(I((age - 62)/30), by = consent, k = 5)
## Data: data_ckd %>% dplyr::mutate(consent = factor(consen (Number of observations: 2903)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Smoothing Spline Hyperparameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## sds(sIageM62D30consent0_1) 2.37 1.10 0.88 6.25 1.00 6090
## sds(sIageM62D30consent1_1) 2.55 1.10 1.13 6.41 1.00 5677
## Tail_ESS
## sds(sIageM62D30consent0_1) 5919
## sds(sIageM62D30consent1_1) 6416
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -0.23 0.07 -0.36 -0.09 1.00 14222
## consent1 -0.58 0.09 -0.75 -0.41 1.00 13088
## sIageM62D30:consent0_1 6.95 2.46 2.49 12.53 1.00 7611
## sIageM62D30:consent1_1 6.43 2.08 2.44 10.80 1.00 8104
## Tail_ESS
## Intercept 6930
## consent1 7068
## sIageM62D30:consent0_1 6532
## sIageM62D30:consent1_1 6506
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).5.1.4.2 Get posteriors
Open code
quantile(data_ckd$age, probs = c(0, 0.01, 0.05, 0.25, 0.5, 0.75, 0.95, 0.99))
## 0% 1% 5% 25% 50% 75% 95% 99%
## 19 23 35 53 64 73 82 87
age_seq <- c(
seq(min(data_ckd$age),
max(data_ckd$age),
length.out = 101
),
c(seq(25, 80, by = 5))
)
consent_prop <- mean(data_ckd$consent)
new0 <- data.frame(
age = age_seq,
consent = factor(0, levels = c(0, 1))
)
new1 <- data.frame(
age = age_seq,
consent = factor(1, levels = c(0, 1))
)
p0 <- posterior_epred(model_time_nl, newdata = new0)
p1 <- posterior_epred(model_time_nl, newdata = new1)
p_overall <- (1 - consent_prop) * p0 + consent_prop * p1
summarize_epred <- function(mat, cohort) {
posterior_summary(mat, robust = TRUE) %>%
as.data.frame() %>%
dplyr::mutate(
cohort = cohort,
age = age_seq
)
}
prediction_NL <- dplyr::bind_rows(
summarize_epred(p1, "screening"),
summarize_epred(p0, "unscreened"),
summarize_epred(p_overall, "enriched")
) %>%
dplyr::mutate(age_calibrated = "No calibration")
kableExtra::kable(
prediction_NL %>%
dplyr::filter(age %in% seq(25, 80, by = 5)) %>%
dplyr::select(-age_calibrated)
)| Estimate | Est.Error | Q2.5 | Q97.5 | cohort | age |
|---|---|---|---|---|---|
| 0.1112888 | 0.0331795 | 0.0563428 | 0.1870257 | screening | 25 |
| 0.1248404 | 0.0259918 | 0.0784898 | 0.1827498 | screening | 30 |
| 0.1355415 | 0.0226227 | 0.0953201 | 0.1857181 | screening | 35 |
| 0.1430278 | 0.0203554 | 0.1074741 | 0.1871380 | screening | 40 |
| 0.1498603 | 0.0168713 | 0.1194703 | 0.1853961 | screening | 45 |
| 0.1608656 | 0.0138478 | 0.1345171 | 0.1893212 | screening | 50 |
| 0.1831263 | 0.0140521 | 0.1569415 | 0.2107198 | screening | 55 |
| 0.2239177 | 0.0154425 | 0.1947542 | 0.2538221 | screening | 60 |
| 0.2916062 | 0.0155668 | 0.2615814 | 0.3231864 | screening | 65 |
| 0.3903334 | 0.0161733 | 0.3581972 | 0.4223398 | screening | 70 |
| 0.5111682 | 0.0191886 | 0.4744400 | 0.5487202 | screening | 75 |
| 0.6332035 | 0.0246850 | 0.5849243 | 0.6808367 | screening | 80 |
| 0.1934902 | 0.0597030 | 0.0954049 | 0.3303779 | unscreened | 25 |
| 0.2176055 | 0.0461928 | 0.1364666 | 0.3204512 | unscreened | 30 |
| 0.2390414 | 0.0384463 | 0.1696089 | 0.3239135 | unscreened | 35 |
| 0.2562827 | 0.0334497 | 0.1957546 | 0.3303119 | unscreened | 40 |
| 0.2706195 | 0.0283315 | 0.2188347 | 0.3324259 | unscreened | 45 |
| 0.2883956 | 0.0241288 | 0.2423201 | 0.3389173 | unscreened | 50 |
| 0.3152409 | 0.0239258 | 0.2699744 | 0.3625329 | unscreened | 55 |
| 0.3582999 | 0.0250042 | 0.3097609 | 0.4074626 | unscreened | 60 |
| 0.4231684 | 0.0248120 | 0.3759322 | 0.4714988 | unscreened | 65 |
| 0.5112616 | 0.0235086 | 0.4645624 | 0.5572612 | unscreened | 70 |
| 0.6138257 | 0.0247458 | 0.5662041 | 0.6612114 | unscreened | 75 |
| 0.7158942 | 0.0288036 | 0.6599083 | 0.7688457 | unscreened | 80 |
| 0.1408033 | 0.0297941 | 0.0889211 | 0.2058497 | enriched | 25 |
| 0.1570217 | 0.0231484 | 0.1145168 | 0.2062429 | enriched | 30 |
| 0.1709849 | 0.0194574 | 0.1344362 | 0.2120312 | enriched | 35 |
| 0.1816984 | 0.0174470 | 0.1488574 | 0.2184145 | enriched | 40 |
| 0.1908743 | 0.0145965 | 0.1630838 | 0.2217129 | enriched | 45 |
| 0.2039107 | 0.0123814 | 0.1796095 | 0.2288899 | enriched | 50 |
| 0.2273765 | 0.0122880 | 0.2031349 | 0.2513214 | enriched | 55 |
| 0.2688574 | 0.0131060 | 0.2434327 | 0.2946194 | enriched | 60 |
| 0.3356686 | 0.0134059 | 0.3104196 | 0.3622441 | enriched | 65 |
| 0.4307300 | 0.0135733 | 0.4045868 | 0.4569232 | enriched | 70 |
| 0.5455838 | 0.0152070 | 0.5161152 | 0.5751043 | enriched | 75 |
| 0.6606967 | 0.0189969 | 0.6238763 | 0.6976367 | enriched | 80 |
5.1.4.3 Visualisation
Open code
prediction_NL %>%
dplyr::filter(cohort != 'unscreened') %>%
ggplot(
aes(
x = age,
y = Estimate,
color = cohort,
fill = cohort
)
) +
geom_line(linewidth = 1) +
geom_ribbon(
aes(
ymin = Q2.5,
ymax = Q97.5
),
alpha = 0.4,
color = NA
) +
scale_y_continuous(
limits = c(0, 1),
breaks = seq(0, 1, by = 0.2)
) +
labs(
x = "Age (years)",
y = "Estimated probability of CKD"
) +
scale_color_manual(
values = c(
"unscreened" = "#1b9e77",
"screening" = "#d95f02",
"enriched" = "skyblue3"
),
name = "Cohort"
) +
scale_fill_manual(
values = c(
"unscreened" = "#1b9e77",
"screening" = "#d95f02",
"enriched" = "skyblue3"
),
name = "Cohort"
) +
facet_grid(rows = vars(cohort)) +
theme(
axis.text = element_text(size = 10),
axis.title = element_text(size = 12),
strip.text.x = element_text(size = 12),
legend.position = "none"
)5.1.5 Risk factors model
5.1.5.1 Can age be lienarized?
Open code
m_tr <- mgcv::gam(
identified_CKD_by_lab ~
s(age, k = 5) +
transplant * consent +
FU_DM1 * consent +
FU_DM2 * consent +
FU_steatosis * consent +
FU_hypertension * consent +
FU_atherosclerosis * consent +
HF_or_AF * consent,
data = data_ckd,
family = binomial(link = 'logit')
)
summary(m_tr)
##
## Family: binomial
## Link function: logit
##
## Formula:
## identified_CKD_by_lab ~ s(age, k = 5) + transplant * consent +
## FU_DM1 * consent + FU_DM2 * consent + FU_steatosis * consent +
## FU_hypertension * consent + FU_atherosclerosis * consent +
## HF_or_AF * consent
##
## Parametric coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.95403 0.27568 -7.088 1.36e-12 ***
## transplant 1.66032 0.26738 6.209 5.32e-10 ***
## consent -0.32283 0.33126 -0.975 0.32978
## FU_DM1 0.52304 0.24475 2.137 0.03260 *
## FU_DM2 0.16727 0.16502 1.014 0.31076
## FU_steatosis -0.06618 0.18253 -0.363 0.71693
## FU_hypertension 1.16215 0.26682 4.356 1.33e-05 ***
## FU_atherosclerosis 0.47923 0.16753 2.861 0.00423 **
## HF_or_AF 0.67091 0.16742 4.007 6.14e-05 ***
## transplant:consent -0.34848 0.30972 -1.125 0.26053
## consent:FU_DM1 0.08319 0.29713 0.280 0.77950
## consent:FU_DM2 0.33983 0.20374 1.668 0.09533 .
## consent:FU_steatosis 0.25376 0.22090 1.149 0.25065
## consent:FU_hypertension -0.25566 0.32107 -0.796 0.42589
## consent:FU_atherosclerosis -0.15786 0.21300 -0.741 0.45862
## consent:HF_or_AF -0.36989 0.21452 -1.724 0.08465 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df Chi.sq p-value
## s(age) 3.033 3.53 207 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.234 Deviance explained = 19.2%
## UBRE = 0.077477 Scale est. = 1 n = 2903
plot(m_tr)5.1.5.2 Set prior and fit
Open code
mean(log2(data_ckd$FU_charlson_index + 1))
## [1] 1.643478
2*sd(log2(data_ckd$FU_charlson_index + 1))
## [1] 1.646904
sd((log2(data_ckd$FU_charlson_index + 1) - 1.64)/1.65)
## [1] 0.4990618
mean((log2(data_ckd$FU_charlson_index + 1) - 1.64)/1.65)
## [1] 0.002108032
priors <- c(
prior(student_t(3, 0, 100), class = "Intercept"),
prior(normal(0, 5), class = "b", coef = "IageM62D30"),
prior(normal(0, 5), class = "b", coef = "transplant"),
prior(normal(0, 5), class = "b", coef = "sex_female"),
prior(normal(0, 5), class = "b", coef = "FU_DM1"),
prior(normal(0, 5), class = "b", coef = "FU_DM2"),
prior(normal(0, 5), class = "b", coef = "FU_atherosclerosis"),
prior(normal(0, 5), class = "b", coef = "FU_steatosis"),
prior(normal(0, 5), class = "b", coef = "FU_hypertension"),
prior(normal(0, 5), class = "b", coef = "HF_or_AF"),
prior(normal(0, 5), class = "b", coef = "consent"),
prior(normal(0, 1), class = "b", coef = "IageM62D30:consent"),
prior(normal(0, 1), class = "b", coef = "consent:transplant"),
prior(normal(0, 1), class = "b", coef = "consent:sex_female"),
prior(normal(0, 1), class = "b", coef = "consent:FU_DM1"),
prior(normal(0, 1), class = "b", coef = "consent:FU_DM2"),
prior(normal(0, 1), class = "b", coef = "consent:FU_atherosclerosis"),
prior(normal(0, 1), class = "b", coef = "consent:FU_steatosis"),
prior(normal(0, 1), class = "b", coef = "consent:FU_hypertension"),
prior(normal(0, 1), class = "b", coef = "consent:HF_or_AF")
)
model_complex_lin <- run(
expr = brm(
identified_CKD_by_lab ~
I( (age-62) / 30) * consent +
transplant * consent +
FU_DM1 * consent +
FU_DM2 * consent +
sex_female * consent +
FU_steatosis * consent +
FU_hypertension * consent +
FU_atherosclerosis * consent +
HF_or_AF * consent,
data = data_ckd,
family = bernoulli(link = "logit"),
backend = "cmdstanr",
seed = 736,
cores = 1, chains = 2,
prior = priors,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_complex_lin",
reuse = TRUE
)
prior_summary(model_complex_lin)
## prior class coef group resp dpar
## (flat) b
## normal(0, 5) b consent
## normal(0, 1) b consent:FU_atherosclerosis
## normal(0, 1) b consent:FU_DM1
## normal(0, 1) b consent:FU_DM2
## normal(0, 1) b consent:FU_hypertension
## normal(0, 1) b consent:FU_steatosis
## normal(0, 1) b consent:HF_or_AF
## normal(0, 1) b consent:sex_female
## normal(0, 1) b consent:transplant
## normal(0, 5) b FU_atherosclerosis
## normal(0, 5) b FU_DM1
## normal(0, 5) b FU_DM2
## normal(0, 5) b FU_hypertension
## normal(0, 5) b FU_steatosis
## normal(0, 5) b HF_or_AF
## normal(0, 5) b IageM62D30
## normal(0, 1) b IageM62D30:consent
## normal(0, 5) b sex_female
## normal(0, 5) b transplant
## student_t(3, 0, 100) Intercept
## nlpar lb ub source
## default
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
summary(model_complex_lin, robust = TRUE)
## Family: bernoulli
## Links: mu = logit
## Formula: identified_CKD_by_lab ~ I((age - 62)/30) * consent + transplant * consent + FU_DM1 * consent + FU_DM2 * consent + sex_female * consent + FU_steatosis * consent + FU_hypertension * consent + FU_atherosclerosis * consent + HF_or_AF * consent
## Data: data_ckd (Number of observations: 2903)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -2.02 0.28 -2.59 -1.48 1.00 6614
## IageM62D30 1.23 0.18 0.87 1.59 1.00 9832
## consent -0.33 0.33 -0.98 0.33 1.00 5968
## transplant 1.64 0.27 1.13 2.16 1.00 9046
## FU_DM1 0.53 0.24 0.07 1.00 1.00 8245
## FU_DM2 0.18 0.16 -0.13 0.50 1.00 9477
## sex_female 0.05 0.15 -0.24 0.34 1.00 9408
## FU_steatosis -0.11 0.18 -0.46 0.22 1.00 9553
## FU_hypertension 1.18 0.25 0.69 1.69 1.00 7335
## FU_atherosclerosis 0.51 0.16 0.18 0.83 1.00 8894
## HF_or_AF 0.73 0.17 0.41 1.05 1.00 8855
## IageM62D30:consent 0.57 0.24 0.09 1.03 1.00 9615
## consent:transplant -0.24 0.30 -0.85 0.36 1.00 9232
## consent:FU_DM1 0.23 0.29 -0.34 0.79 1.00 8004
## consent:FU_DM2 0.30 0.20 -0.08 0.69 1.00 9252
## consent:sex_female -0.02 0.19 -0.38 0.34 1.00 9212
## consent:FU_steatosis 0.27 0.21 -0.13 0.68 1.00 10018
## consent:FU_hypertension -0.33 0.30 -0.95 0.25 1.00 6740
## consent:FU_atherosclerosis -0.17 0.21 -0.58 0.24 1.00 8860
## consent:HF_or_AF -0.39 0.21 -0.81 0.02 1.00 9188
## Tail_ESS
## Intercept 6959
## IageM62D30 7643
## consent 6814
## transplant 7333
## FU_DM1 7611
## FU_DM2 8024
## sex_female 7854
## FU_steatosis 7564
## FU_hypertension 7454
## FU_atherosclerosis 7888
## HF_or_AF 7672
## IageM62D30:consent 7892
## consent:transplant 7309
## consent:FU_DM1 7656
## consent:FU_DM2 7915
## consent:sex_female 7737
## consent:FU_steatosis 7137
## consent:FU_hypertension 7077
## consent:FU_atherosclerosis 7785
## consent:HF_or_AF 7832
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
exp(fixef(model_complex_lin, robust = TRUE))[,c(1, 3, 4)]
## Estimate Q2.5 Q97.5
## Intercept 0.1321186 0.07531315 0.2272904
## IageM62D30 3.4136940 2.39360261 4.8799196
## consent 0.7202265 0.37380441 1.3861457
## transplant 5.1370809 3.10361791 8.6511348
## FU_DM1 1.6962493 1.07678323 2.7087468
## FU_DM2 1.1946097 0.87771929 1.6444107
## sex_female 1.0504023 0.78722494 1.4081219
## FU_steatosis 0.8931730 0.63277368 1.2469797
## FU_hypertension 3.2584284 1.99780165 5.4431735
## FU_atherosclerosis 1.6663748 1.19820655 2.2911440
## HF_or_AF 2.0732605 1.50664259 2.8597558
## IageM62D30:consent 1.7613032 1.09685730 2.8031962
## consent:transplant 0.7905191 0.42772550 1.4301236
## consent:FU_DM1 1.2531213 0.71147601 2.2056872
## consent:FU_DM2 1.3538434 0.92090196 1.9882209
## consent:sex_female 0.9793830 0.68187323 1.4076165
## consent:FU_steatosis 1.3104211 0.87515703 1.9730822
## consent:FU_hypertension 0.7166595 0.38833755 1.2867447
## consent:FU_atherosclerosis 0.8413050 0.55789687 1.2748091
## consent:HF_or_AF 0.6744532 0.44586097 1.02225395.1.5.3 Extract posterior
Open code
consent_prop <- mean(
data_ckd$consent
)
age_scale <- 25 / 30
post <- posterior::as_draws_df(
model_complex_lin
)
b_all <- post %>%
dplyr::select(
dplyr::starts_with("b_")
)
## Warning: Dropping 'draws_df' class as required metadata was removed.
base <- b_all %>%
dplyr::transmute(
Intercept = b_Intercept,
age_25y = b_IageM62D30 * age_scale,
sex_female = b_sex_female,
transplant = b_transplant,
FU_DM1 = b_FU_DM1,
FU_DM2 = b_FU_DM2,
FU_steatosis = b_FU_steatosis,
FU_hypertension = b_FU_hypertension,
FU_atherosclerosis = b_FU_atherosclerosis,
HF_or_AF = b_HF_or_AF
)
eff_consent0 <- base
eff_consent1 <- base %>%
dplyr::mutate(
Intercept = Intercept + b_all$b_consent,
age_25y = age_25y + b_all$`b_IageM62D30:consent` * age_scale,
transplant = transplant + b_all$`b_consent:transplant`,
FU_DM1 = FU_DM1 + b_all$`b_consent:FU_DM1`,
FU_DM2 = FU_DM2 + b_all$`b_consent:FU_DM2`,
FU_steatosis = FU_steatosis + b_all$`b_consent:FU_steatosis`,
FU_hypertension = FU_hypertension + b_all$`b_consent:FU_hypertension`,
FU_atherosclerosis = FU_atherosclerosis + b_all$`b_consent:FU_atherosclerosis`,
HF_or_AF = HF_or_AF + b_all$`b_consent:HF_or_AF`,
sex_female = sex_female + b_all$`b_consent:sex_female`
)
eff_consent_mean <- base %>%
dplyr::mutate(
Intercept = Intercept + b_all$b_consent * consent_prop,
age_25y = age_25y + b_all$`b_IageM62D30:consent` * consent_prop * age_scale,
transplant = transplant + b_all$`b_consent:transplant` * consent_prop,
FU_DM1 = FU_DM1 + b_all$`b_consent:FU_DM1` * consent_prop,
FU_DM2 = FU_DM2 + b_all$`b_consent:FU_DM2` * consent_prop,
FU_steatosis = FU_steatosis + b_all$`b_consent:FU_steatosis` * consent_prop,
FU_hypertension = FU_hypertension + b_all$`b_consent:FU_hypertension` * consent_prop,
FU_atherosclerosis = FU_atherosclerosis + b_all$`b_consent:FU_atherosclerosis` * consent_prop,
HF_or_AF = HF_or_AF + b_all$`b_consent:HF_or_AF` * consent_prop,
sex_female = sex_female + b_all$`b_consent:sex_female` * consent_prop
)
calc_marg_log_or <- function(model, data, var_name, val1, val0) {
d1 <- data
d1[[var_name]] <- val1
p1 <- brms::posterior_epred(
model,
newdata = d1
)
p1_marg <- rowMeans(
p1
)
d0 <- data
d0[[var_name]] <- val0
p0 <- brms::posterior_epred(
model,
newdata = d0
)
p0_marg <- rowMeans(
p0
)
odds1 <- p1_marg / (1 - p1_marg)
odds0 <- p0_marg / (1 - p0_marg)
marg_or <- odds1 / odds0
return(log(marg_or))
}
data_dm_ref <- data_ckd %>%
dplyr::mutate(
FU_DM1 = 0,
FU_DM2 = 0
)
p0_dm <- brms::posterior_epred(
model_complex_lin,
newdata = data_dm_ref
) %>%
rowMeans()
odds0_dm <- p0_dm / (1 - p0_dm)
data_dm1 <- data_ckd %>%
dplyr::mutate(
FU_DM1 = 1,
FU_DM2 = 0
)
p1_dm1 <- brms::posterior_epred(
model_complex_lin,
newdata = data_dm1
) %>%
rowMeans()
odds1_dm1 <- p1_dm1 / (1 - p1_dm1)
data_dm2 <- data_ckd %>%
dplyr::mutate(
FU_DM1 = 0,
FU_DM2 = 1
)
p1_dm2 <- brms::posterior_epred(
model_complex_lin,
newdata = data_dm2
) %>%
rowMeans()
odds1_dm2 <- p1_dm2 / (1 - p1_dm2)
log_or_dm1_marg <- log(odds1_dm1 / odds0_dm)
log_or_dm2_marg <- log(odds1_dm2 / odds0_dm)
eff_marginal <- dplyr::tibble(
age_25y = calc_marg_log_or(
model_complex_lin,
data_ckd,
"age",
75,
50
),
sex_female = calc_marg_log_or(
model_complex_lin,
data_ckd,
"sex_female",
1,
0
),
transplant = calc_marg_log_or(
model_complex_lin,
data_ckd,
"transplant",
1,
0
),
FU_DM1 = log_or_dm1_marg,
FU_DM2 = log_or_dm2_marg,
FU_steatosis = calc_marg_log_or(
model_complex_lin,
data_ckd,
"FU_steatosis",
1,
0
),
FU_hypertension = calc_marg_log_or(
model_complex_lin,
data_ckd,
"FU_hypertension",
1,
0
),
FU_atherosclerosis = calc_marg_log_or(
model_complex_lin,
data_ckd,
"FU_atherosclerosis",
1,
0
),
HF_or_AF = calc_marg_log_or(
model_complex_lin,
data_ckd,
"HF_or_AF",
1,
0
)
)
summ <- dplyr::bind_rows(
posterior::summarise_draws(
eff_consent0,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "unscreened"
),
posterior::summarise_draws(
eff_consent1,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "screening"
),
posterior::summarise_draws(
eff_consent_mean,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "enriched_std_cond"
),
posterior::summarise_draws(
eff_marginal,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "enriched_marginal"
)
) %>%
dplyr::rename(
predictor = variable,
CI_L = `2.5%`,
CI_U = `97.5%`
) %>%
dplyr::mutate(
OR = exp(
median
),
CI_L = exp(
CI_L
),
CI_U = exp(
CI_U
)
)
data_forest <- summ %>%
dplyr::filter(
predictor != "Intercept"
) %>%
dplyr::mutate(
predictor = factor(
predictor,
levels = rev(
unique(
predictor
)
)
)
)
tab_ready <- summ %>%
dplyr::filter(
predictor != "Intercept"
) %>%
dplyr::mutate(
label = sprintf(
"%.2f [%.2f, %.2f]",
OR,
CI_L,
CI_U
)
) %>%
dplyr::select(
cohort,
predictor,
label
)
tab_wide <- tab_ready %>%
tidyr::pivot_wider(
names_from = cohort,
values_from = label
) %>%
dplyr::arrange(
predictor
)
kableExtra::kable(
tab_wide,
caption = "Associations between clinical factors and confirmed CKD from the multivariable Bayesian logistic regression model. Odds ratios (ORs) are shown with 95% credible intervals. For screened and unscreened patients, ORs are conditional estimates from the interaction model. For the Enriched cohort, two summary measures are presented: the population-average conditional OR, calculated as the weighted average of screened- and unscreened-specific log-ORs using their observed proportions in the cohort, and the marginal OR, obtained by posterior standardisation of predicted probabilities across all patients in the Enriched cohort. Age effects are expressed for a 25-year difference; the marginal age OR compares 75 versus 50 years"
)| predictor | unscreened | screening | enriched_std_cond | enriched_marginal |
|---|---|---|---|---|
| FU_DM1 | 1.70 [1.08, 2.71] | 2.11 [1.48, 2.99] | 1.97 [1.47, 2.63] | 1.68 [1.35, 2.08] |
| FU_DM2 | 1.19 [0.88, 1.64] | 1.62 [1.29, 2.05] | 1.46 [1.21, 1.77] | 1.34 [1.15, 1.55] |
| FU_atherosclerosis | 1.67 [1.20, 2.29] | 1.40 [1.08, 1.82] | 1.49 [1.20, 1.82] | 1.37 [1.16, 1.62] |
| FU_hypertension | 3.26 [2.00, 5.44] | 2.33 [1.66, 3.34] | 2.61 [1.96, 3.54] | 2.22 [1.74, 2.91] |
| FU_steatosis | 0.89 [0.63, 1.25] | 1.17 [0.92, 1.47] | 1.07 [0.88, 1.30] | 1.05 [0.90, 1.22] |
| HF_or_AF | 2.07 [1.51, 2.86] | 1.39 [1.07, 1.83] | 1.59 [1.29, 1.96] | 1.46 [1.23, 1.73] |
| age_25y | 2.78 [2.07, 3.75] | 4.46 [3.43, 5.82] | 3.81 [3.09, 4.67] | 3.14 [2.62, 3.74] |
| sex_female | 1.05 [0.79, 1.41] | 1.03 [0.83, 1.28] | 1.04 [0.87, 1.24] | 1.03 [0.90, 1.18] |
| transplant | 5.14 [3.10, 8.65] | 4.06 [2.94, 5.64] | 4.38 [3.30, 5.84] | 3.18 [2.56, 3.94] |
5.1.5.4 Visualisation, screening + conditional enriched
Open code
plotac <- "fig_3"
path <- "gitignore/figures"
fig <- data_forest %>%
dplyr::filter(
cohort != "unscreened",
cohort != "enriched_marginal"
) %>%
dplyr::mutate(
predictor = dplyr::recode(
predictor,
"age_25y" = "Age (per 25y)",
"transplant" = "Non-renal transplantation",
"FU_DM1" = "T1DM",
"FU_DM2" = "T2DM",
"FU_hypertension" = "Arterial hypertension",
"HF_or_AF" = "Heart failure or atrial fibrillation",
"FU_atherosclerosis" = "ASCVD",
"FU_steatosis" = "Liver steatosis",
"sex_female" = "Female"
),
predictor = factor(
predictor,
levels = rev(unique(predictor))
),
cohort = factor(
cohort,
levels = c(
"unscreened",
"screening",
"enriched_std_cond",
"enriched_marginal"
),
labels = c(
"Unscreened patients",
"Screening cohort",
"Enriched cohort (conditional)",
"Enriched cohort (marginal)"
)
)
) %>%
ggplot2::ggplot(
ggplot2::aes(
x = OR,
y = predictor,
color = cohort
)
) +
ggplot2::geom_point(
position = ggplot2::position_dodge(width = 0.6),
size = 2
) +
ggplot2::geom_errorbarh(
ggplot2::aes(
xmin = CI_L,
xmax = CI_U
),
position = ggplot2::position_dodge(width = 0.6),
height = 0.3
) +
ggplot2::geom_vline(
xintercept = 1,
linetype = "dashed",
color = "gray40"
) +
ggplot2::scale_x_log10(
breaks = c(1 / 4, 1 / 2, 1, 2, 4, 8),
labels = c("1/4", "1/2", "1", "2", "4", "8")
) +
ggplot2::scale_color_manual(
values = c(
"Unscreened patients" = "#1b9e77",
"Screening cohort" = "#d95f02",
"Enriched cohort (conditional)" = "skyblue3",
"Enriched cohort (marginal)" = "#984ea3"
)
) +
ggplot2::labs(
x = "Adjusted odds ratio (log scale) for confirmed CKD",
y = NULL,
color = NULL
) +
ggplot2::guides(
color = ggplot2::guide_legend(nrow = 1)
) +
ggplot2::theme_minimal(base_size = 12) +
ggplot2::theme(
legend.position = "top",
axis.text.y = ggplot2::element_text(size = 11),
legend.text = ggplot2::element_text(size = 10)
)
figOpen code
if (!dir.exists(path)) {
dir.create(path, recursive = TRUE)
}
if (!file.exists(file.path(path, paste0(plotac, ".pdf")))) {
ggplot2::ggsave(
filename = paste0(plotac, ".pdf"),
plot = fig,
path = path,
device = "pdf",
width = 6.5,
height = 5
)
}5.1.5.5 Visualisation, full
Open code
plotac <- "suppl_fig_3"
path <- "gitignore/figures"
fig <- data_forest %>%
dplyr::mutate(
predictor = dplyr::recode(
predictor,
"age_25y" = "Age (per 25y)",
"transplant" = "Non-renal transplantation",
"FU_DM1" = "T1DM",
"FU_DM2" = "T2DM",
"FU_hypertension" = "Arterial hypertension",
"HF_or_AF" = "Heart failure or atrial fibrillation",
"FU_atherosclerosis" = "ASCVD",
"FU_steatosis" = "Liver steatosis",
"sex_female" = "Female"
),
predictor = factor(
predictor,
levels = rev(unique(predictor))
),
cohort = factor(
cohort,
levels = c(
"unscreened",
"screening",
"enriched_std_cond",
"enriched_marginal"
),
labels = c(
"Unscreened patients",
"Screening cohort",
"Enriched cohort (conditional)",
"Enriched cohort (marginal)"
)
)
) %>%
ggplot2::ggplot(
ggplot2::aes(
x = OR,
y = predictor,
color = cohort
)
) +
ggplot2::geom_point(
position = ggplot2::position_dodge(width = 0.6),
size = 2
) +
ggplot2::geom_errorbarh(
ggplot2::aes(
xmin = CI_L,
xmax = CI_U
),
position = ggplot2::position_dodge(width = 0.6),
height = 0.3
) +
ggplot2::geom_vline(
xintercept = 1,
linetype = "dashed",
color = "gray40"
) +
ggplot2::scale_x_log10(
breaks = c(1 / 4, 1 / 2, 1, 2, 4, 8),
labels = c("1/4", "1/2", "1", "2", "4", "8")
) +
ggplot2::scale_color_manual(
values = c(
"Unscreened patients" = "#1b9e77",
"Screening cohort" = "#d95f02",
"Enriched cohort (conditional)" = "skyblue3",
"Enriched cohort (marginal)" = "#984ea3"
)
) +
ggplot2::labs(
x = "Adjusted odds ratio (log scale) for confirmed CKD",
y = NULL,
color = NULL
) +
ggplot2::guides(
color = ggplot2::guide_legend(nrow = 2)
) +
ggplot2::theme_minimal(base_size = 12) +
ggplot2::theme(
legend.position = "top",
axis.text.y = ggplot2::element_text(size = 11),
legend.text = ggplot2::element_text(size = 10)
)
figOpen code
if (!dir.exists(path)) {
dir.create(path, recursive = TRUE)
}
if (!file.exists(file.path(path, paste0(plotac, ".pdf")))) {
ggplot2::ggsave(
filename = paste0(plotac, ".pdf"),
plot = fig,
path = path,
device = "pdf",
width = 6.5,
height = 5
)
}5.1.5.6 Sensitivity analysis model
Fit
Open code
priors_sens <- c(
prior(student_t(3, 0, 100), class = "Intercept"),
prior(normal(0, 5), class = "b", coef = "BMI_over30"),
prior(normal(0, 5), class = "b", coef = "transplant"),
prior(normal(0, 5), class = "b", coef = "sex_female"),
prior(normal(0, 5), class = "b", coef = "FU_DM1"),
prior(normal(0, 5), class = "b", coef = "FU_DM2"),
prior(normal(0, 5), class = "b", coef = "FU_atherosclerosis"),
prior(normal(0, 5), class = "b", coef = "FU_steatosis"),
prior(normal(0, 5), class = "b", coef = "FU_hypertension"),
prior(normal(0, 5), class = "b", coef = "HF_or_AF"),
prior(normal(0, 5), class = "b", coef = "consent1"),
prior(normal(0, 1), class = "b",
coef = "transplant:consent1"),
prior(normal(0, 1), class = "b",
coef = "consent1:FU_DM1"),
prior(normal(0, 1), class = "b",
coef = "consent1:FU_DM2"),
prior(normal(0, 1), class = "b",
coef = "consent1:sex_female"),
prior(normal(0, 1), class = "b",
coef = "consent1:FU_steatosis"),
prior(normal(0, 1), class = "b",
coef = "consent1:FU_hypertension"),
prior(normal(0, 1), class = "b",
coef = "consent1:FU_atherosclerosis"),
prior(normal(0, 1), class = "b",
coef = "consent1:HF_or_AF"),
prior(normal(0, 1), class = "b",
coef = "consent1:BMI_over30")
)
model_sens_lin <- run(
expr = brm(
identified_CKD_by_lab ~
s(I( (age-62) / 30), by = consent, k = 5) +
transplant * consent +
FU_DM1 * consent +
FU_DM2 * consent +
sex_female * consent +
FU_steatosis * consent +
FU_hypertension * consent +
FU_atherosclerosis * consent +
HF_or_AF * consent +
BMI_over30 * consent,
data = data_ckd |>
dplyr::filter(!is.na(BMI_over30)) |>
dplyr::mutate(consent = factor(consent)),
family = bernoulli(link = "logit"),
backend = "cmdstanr",
seed = 736,
cores = 1, chains = 2,
prior = priors_sens,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_sens_lin",
reuse = TRUE
)
prior_summary(model_sens_lin)
## prior class coef group
## (flat) b
## normal(0, 5) b BMI_over30
## normal(0, 5) b consent1
## normal(0, 1) b consent1:BMI_over30
## normal(0, 1) b consent1:FU_atherosclerosis
## normal(0, 1) b consent1:FU_DM1
## normal(0, 1) b consent1:FU_DM2
## normal(0, 1) b consent1:FU_hypertension
## normal(0, 1) b consent1:FU_steatosis
## normal(0, 1) b consent1:HF_or_AF
## normal(0, 1) b consent1:sex_female
## normal(0, 5) b FU_atherosclerosis
## normal(0, 5) b FU_DM1
## normal(0, 5) b FU_DM2
## normal(0, 5) b FU_hypertension
## normal(0, 5) b FU_steatosis
## normal(0, 5) b HF_or_AF
## normal(0, 5) b sex_female
## (flat) b sIageM62D30:consent0_1
## (flat) b sIageM62D30:consent1_1
## normal(0, 5) b transplant
## normal(0, 1) b transplant:consent1
## student_t(3, 0, 100) Intercept
## student_t(3, 0, 2.5) sds
## student_t(3, 0, 2.5) sds s(I((age - 62)/30), by = consent, k = 5)
## resp dpar nlpar lb ub source
## default
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## (vectorized)
## (vectorized)
## user
## user
## user
## 0 default
## 0 (vectorized)
summary(model_sens_lin, robust = TRUE)
## Warning: There were 4 divergent transitions after warmup. Increasing
## adapt_delta above 0.95 may help. See
## http://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
## Family: bernoulli
## Links: mu = logit
## Formula: identified_CKD_by_lab ~ s(I((age - 62)/30), by = consent, k = 5) + transplant * consent + FU_DM1 * consent + FU_DM2 * consent + sex_female * consent + FU_steatosis * consent + FU_hypertension * consent + FU_atherosclerosis * consent + HF_or_AF * consent + BMI_over30 * consent
## Data: dplyr::mutate(dplyr::filter(data_ckd, !is.na(BMI_o (Number of observations: 2873)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Smoothing Spline Hyperparameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## sds(sIageM62D30consent0_1) 2.43 1.14 0.83 6.37 1.00 5707
## sds(sIageM62D30consent1_1) 2.57 1.10 1.17 6.50 1.00 7749
## Tail_ESS
## sds(sIageM62D30consent0_1) 4806
## sds(sIageM62D30consent1_1) 7512
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -1.95 0.29 -2.53 -1.40 1.00 7352
## transplant 1.55 0.26 1.06 2.08 1.00 9808
## consent1 -0.38 0.35 -1.05 0.30 1.00 6949
## FU_DM1 0.46 0.24 -0.03 0.94 1.00 8782
## FU_DM2 0.23 0.17 -0.10 0.56 1.00 9239
## sex_female 0.02 0.16 -0.29 0.33 1.00 9733
## FU_steatosis -0.04 0.18 -0.40 0.31 1.00 9734
## FU_hypertension 1.24 0.26 0.75 1.76 1.00 8123
## FU_atherosclerosis 0.52 0.17 0.19 0.84 1.00 10839
## HF_or_AF 0.70 0.16 0.38 1.03 1.00 10252
## BMI_over30 -0.26 0.15 -0.57 0.04 1.00 9539
## transplant:consent1 -0.12 0.30 -0.72 0.47 1.00 10011
## consent1:FU_DM1 0.25 0.29 -0.33 0.82 1.00 9232
## consent1:FU_DM2 0.23 0.21 -0.18 0.64 1.00 9347
## consent1:sex_female 0.02 0.20 -0.37 0.39 1.00 9502
## consent1:FU_steatosis 0.21 0.22 -0.22 0.64 1.00 10080
## consent1:FU_hypertension -0.37 0.32 -0.99 0.23 1.00 7854
## consent1:FU_atherosclerosis -0.23 0.21 -0.64 0.19 1.00 10307
## consent1:HF_or_AF -0.44 0.21 -0.85 -0.02 1.00 10195
## consent1:BMI_over30 0.41 0.20 0.03 0.79 1.00 10066
## sIageM62D30:consent0_1 6.10 2.68 1.43 12.17 1.00 9236
## sIageM62D30:consent1_1 6.65 2.24 2.40 11.25 1.00 9866
## Tail_ESS
## Intercept 7346
## transplant 7627
## consent1 6716
## FU_DM1 7851
## FU_DM2 7470
## sex_female 7872
## FU_steatosis 7083
## FU_hypertension 6952
## FU_atherosclerosis 7552
## HF_or_AF 7669
## BMI_over30 8057
## transplant:consent1 7125
## consent1:FU_DM1 7738
## consent1:FU_DM2 7550
## consent1:sex_female 7893
## consent1:FU_steatosis 8043
## consent1:FU_hypertension 6802
## consent1:FU_atherosclerosis 8136
## consent1:HF_or_AF 7562
## consent1:BMI_over30 7730
## sIageM62D30:consent0_1 6966
## sIageM62D30:consent1_1 7487
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
exp(fixef(model_sens_lin, robust = TRUE))[,c(1, 3, 4)]
## Estimate Q2.5 Q97.5
## Intercept 0.1426388 0.07956152 2.472177e-01
## transplant 4.7167972 2.89227315 7.986038e+00
## consent1 0.6834895 0.35053972 1.355124e+00
## FU_DM1 1.5802080 0.97293188 2.563526e+00
## FU_DM2 1.2595311 0.90637834 1.744403e+00
## sex_female 1.0206540 0.75153047 1.386077e+00
## FU_steatosis 0.9601101 0.66929522 1.361240e+00
## FU_hypertension 3.4500717 2.10830235 5.813382e+00
## FU_atherosclerosis 1.6743056 1.21155238 2.318442e+00
## HF_or_AF 2.0219442 1.45990494 2.811162e+00
## BMI_over30 0.7680811 0.56585567 1.042797e+00
## transplant:consent1 0.8833105 0.48484835 1.606781e+00
## consent1:FU_DM1 1.2784386 0.71558390 2.273610e+00
## consent1:FU_DM2 1.2607799 0.83794095 1.887524e+00
## consent1:sex_female 1.0174979 0.69288794 1.474278e+00
## consent1:FU_steatosis 1.2305928 0.80189446 1.894248e+00
## consent1:FU_hypertension 0.6926140 0.37037675 1.264403e+00
## consent1:FU_atherosclerosis 0.7957633 0.52744651 1.206034e+00
## consent1:HF_or_AF 0.6457702 0.42579278 9.819235e-01
## consent1:BMI_over30 1.5034335 1.03119315 2.193160e+00
## sIageM62D30:consent0_1 446.8129274 4.16008289 1.937488e+05
## sIageM62D30:consent1_1 772.9195746 11.00591384 7.724307e+04Extract posterior and check results
Open code
dummy_base <- data_ckd_complete[1, ] %>%
dplyr::mutate(
transplant = 0,
FU_DM1 = 0,
FU_DM2 = 0,
sex_female = 0,
FU_steatosis = 0,
FU_hypertension = 0,
FU_atherosclerosis = 0,
HF_or_AF = 0,
BMI_over30 = 0
)
d_c0_a50 <- dummy_base %>%
dplyr::mutate(
consent = factor(0, levels = c("0", "1")),
age = 50
)
d_c0_a75 <- dummy_base %>%
dplyr::mutate(
consent = factor(0, levels = c("0", "1")),
age = 75
)
lin_c0_a50 <- posterior_linpred(
model_sens_lin,
newdata = d_c0_a50
)
lin_c0_a75 <- posterior_linpred(
model_sens_lin,
newdata = d_c0_a75
)
age_25y_c0 <- as.numeric(lin_c0_a75 - lin_c0_a50)
d_c1_a50 <- dummy_base %>%
dplyr::mutate(
consent = factor(1, levels = c("0", "1")),
age = 50
)
d_c1_a75 <- dummy_base %>%
dplyr::mutate(
consent = factor(1, levels = c("0", "1")),
age = 75
)
lin_c1_a50 <- posterior_linpred(
model_sens_lin,
newdata = d_c1_a50
)
lin_c1_a75 <- posterior_linpred(
model_sens_lin,
newdata = d_c1_a75
)
age_25y_c1 <- as.numeric(lin_c1_a75 - lin_c1_a50)
post <- as_draws_df(
model_sens_lin
)
b_all <- post %>%
dplyr::select(
dplyr::starts_with("b_")
)
## Warning: Dropping 'draws_df' class as required metadata was removed.
eff_consent0 <- dplyr::tibble(
age_25y = age_25y_c0,
sex_female = b_all$b_sex_female,
transplant = b_all$b_transplant,
FU_DM1 = b_all$b_FU_DM1,
FU_DM2 = b_all$b_FU_DM2,
FU_steatosis = b_all$b_FU_steatosis,
FU_hypertension = b_all$b_FU_hypertension,
FU_atherosclerosis = b_all$b_FU_atherosclerosis,
HF_or_AF = b_all$b_HF_or_AF,
BMI_over30 = b_all$b_BMI_over30
)
eff_consent1 <- dplyr::tibble(
age_25y = age_25y_c1,
sex_female = b_all$b_sex_female + b_all$`b_consent1:sex_female`,
transplant = b_all$b_transplant + b_all$`b_transplant:consent1`,
FU_DM1 = b_all$b_FU_DM1 + b_all$`b_consent1:FU_DM1`,
FU_DM2 = b_all$b_FU_DM2 + b_all$`b_consent1:FU_DM2`,
FU_steatosis = b_all$b_FU_steatosis + b_all$`b_consent1:FU_steatosis`,
FU_hypertension = b_all$b_FU_hypertension + b_all$`b_consent1:FU_hypertension`,
FU_atherosclerosis = b_all$b_FU_atherosclerosis + b_all$`b_consent1:FU_atherosclerosis`,
HF_or_AF = b_all$b_HF_or_AF + b_all$`b_consent1:HF_or_AF`,
BMI_over30 = b_all$b_BMI_over30 + b_all$`b_consent1:BMI_over30`
)
eff_consent_mean <- dplyr::tibble(
age_25y = age_25y_c0 * (1 - consent_prop) +
age_25y_c1 * consent_prop,
sex_female = eff_consent0$sex_female * (1 - consent_prop) +
eff_consent1$sex_female * consent_prop,
transplant = eff_consent0$transplant * (1 - consent_prop) +
eff_consent1$transplant * consent_prop,
FU_DM1 = eff_consent0$FU_DM1 * (1 - consent_prop) +
eff_consent1$FU_DM1 * consent_prop,
FU_DM2 = eff_consent0$FU_DM2 * (1 - consent_prop) +
eff_consent1$FU_DM2 * consent_prop,
FU_steatosis = eff_consent0$FU_steatosis * (1 - consent_prop) +
eff_consent1$FU_steatosis * consent_prop,
FU_hypertension = eff_consent0$FU_hypertension * (1 - consent_prop) +
eff_consent1$FU_hypertension * consent_prop,
FU_atherosclerosis = eff_consent0$FU_atherosclerosis * (1 - consent_prop) +
eff_consent1$FU_atherosclerosis * consent_prop,
HF_or_AF = eff_consent0$HF_or_AF * (1 - consent_prop) +
eff_consent1$HF_or_AF * consent_prop,
BMI_over30 = eff_consent0$BMI_over30 * (1 - consent_prop) +
eff_consent1$BMI_over30 * consent_prop
)
calc_marg_log_or <- function(model, data, var_name, val1, val0) {
d1 <- data
d1[[var_name]] <- val1
p1 <- posterior_epred(
model,
newdata = d1
)
p1_marg <- rowMeans(p1)
d0 <- data
d0[[var_name]] <- val0
p0 <- posterior_epred(
model,
newdata = d0
)
p0_marg <- rowMeans(p0)
odds1 <- p1_marg / (1 - p1_marg)
odds0 <- p0_marg / (1 - p0_marg)
marg_or <- odds1 / odds0
return(log(marg_or))
}
data_dm_ref <- data_ckd_complete %>%
dplyr::mutate(
FU_DM1 = 0,
FU_DM2 = 0
)
p0_dm <- posterior_epred(
model_sens_lin,
newdata = data_dm_ref
) %>%
rowMeans()
odds0_dm <- p0_dm / (1 - p0_dm)
data_dm1 <- data_ckd_complete %>%
dplyr::mutate(
FU_DM1 = 1,
FU_DM2 = 0
)
p1_dm1 <- posterior_epred(
model_sens_lin,
newdata = data_dm1
) %>%
rowMeans()
odds1_dm1 <- p1_dm1 / (1 - p1_dm1)
data_dm2 <- data_ckd_complete %>%
dplyr::mutate(
FU_DM1 = 0,
FU_DM2 = 1
)
p1_dm2 <- posterior_epred(
model_sens_lin,
newdata = data_dm2
) %>%
rowMeans()
odds1_dm2 <- p1_dm2 / (1 - p1_dm2)
log_or_dm1_marg <- log(odds1_dm1 / odds0_dm)
log_or_dm2_marg <- log(odds1_dm2 / odds0_dm)
eff_marginal <- dplyr::tibble(
age_25y = calc_marg_log_or(
model_sens_lin,
data_ckd_complete,
"age",
75,
50
),
sex_female = calc_marg_log_or(
model_sens_lin,
data_ckd_complete,
"sex_female",
1,
0
),
transplant = calc_marg_log_or(
model_sens_lin,
data_ckd_complete,
"transplant",
1,
0
),
FU_DM1 = log_or_dm1_marg,
FU_DM2 = log_or_dm2_marg,
FU_steatosis = calc_marg_log_or(
model_sens_lin,
data_ckd_complete,
"FU_steatosis",
1,
0
),
FU_hypertension = calc_marg_log_or(
model_sens_lin,
data_ckd_complete,
"FU_hypertension",
1,
0
),
FU_atherosclerosis = calc_marg_log_or(
model_sens_lin,
data_ckd_complete,
"FU_atherosclerosis",
1,
0
),
HF_or_AF = calc_marg_log_or(
model_sens_lin,
data_ckd_complete,
"HF_or_AF",
1,
0
),
BMI_over30 = calc_marg_log_or(
model_sens_lin,
data_ckd_complete,
"BMI_over30",
1,
0
)
)
summ <- dplyr::bind_rows(
summarise_draws(
eff_consent0,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "unscreened"
),
summarise_draws(
eff_consent1,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "screening"
),
summarise_draws(
eff_consent_mean,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "enriched_std_cond"
),
summarise_draws(
eff_marginal,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "enriched_marginal"
)
) %>%
dplyr::rename(
predictor = variable,
CI_L = `2.5%`,
CI_U = `97.5%`
) %>%
dplyr::mutate(
OR = exp(median),
CI_L = exp(CI_L),
CI_U = exp(CI_U)
)
tab_ready <- summ %>%
dplyr::mutate(
label = sprintf(
"%.2f [%.2f, %.2f]",
OR,
CI_L,
CI_U
)
) %>%
dplyr::select(
cohort,
predictor,
label
)
tab_wide <- tab_ready %>%
tidyr::pivot_wider(
names_from = cohort,
values_from = label
) %>%
dplyr::arrange(
predictor
)
kableExtra::kable(
tab_wide,
caption = "Associations between clinical factors and confirmed CKD from the multivariable Bayesian logistic regression model. Odds ratios (ORs) are shown with 95% credible intervals. For screened and unscreened patients, ORs are conditional estimates from the interaction model. For the Enriched cohort, two summary measures are presented: the population-average conditional OR, calculated as the weighted average of screened- and unscreened-specific log-ORs using their observed proportions in the cohort, and the marginal OR, obtained by posterior standardisation of predicted probabilities across all patients in the Enriched cohort. Age effects are expressed for a 25-year difference comparing 75 versus 50 years."
)| predictor | unscreened | screening | enriched_std_cond | enriched_marginal |
|---|---|---|---|---|
| BMI_over30 | 0.77 [0.57, 1.04] | 1.16 [0.91, 1.47] | 1.01 [0.83, 1.22] | 1.00 [0.86, 1.16] |
| FU_DM1 | 1.58 [0.97, 2.56] | 2.02 [1.42, 2.86] | 1.86 [1.38, 2.48] | 1.59 [1.28, 1.96] |
| FU_DM2 | 1.26 [0.91, 1.74] | 1.59 [1.24, 2.03] | 1.47 [1.21, 1.78] | 1.33 [1.15, 1.55] |
| FU_atherosclerosis | 1.67 [1.21, 2.32] | 1.33 [1.02, 1.74] | 1.44 [1.17, 1.78] | 1.33 [1.13, 1.58] |
| FU_hypertension | 3.45 [2.11, 5.81] | 2.38 [1.68, 3.46] | 2.70 [2.01, 3.64] | 2.24 [1.75, 2.90] |
| FU_steatosis | 0.96 [0.67, 1.36] | 1.18 [0.92, 1.52] | 1.10 [0.90, 1.36] | 1.07 [0.92, 1.26] |
| HF_or_AF | 2.02 [1.46, 2.81] | 1.31 [0.99, 1.71] | 1.51 [1.22, 1.86] | 1.39 [1.18, 1.64] |
| age_25y | 2.90 [2.01, 4.25] | 5.11 [3.77, 7.04] | 4.24 [3.32, 5.42] | 3.43 [2.77, 4.23] |
| sex_female | 1.02 [0.75, 1.39] | 1.04 [0.82, 1.30] | 1.03 [0.85, 1.24] | 1.02 [0.89, 1.18] |
| transplant | 4.72 [2.89, 7.99] | 4.19 [3.02, 5.82] | 4.36 [3.29, 5.78] | 3.14 [2.53, 3.92] |
5.2 Identified CKD - age-calibrated
5.2.1 Unadjsuted effects
5.2.1.1 Fit models
Open code
kableExtra::kable(
cbind(
unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
sex_female = if_else(sex == "F", 1, 0),
BMI10_last = (BMI_last/10),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0)
) %>% dplyr::filter(
consent == 0
),
outcome = "identified_CKD_by_lab_AgeSpecCut",
predictors = preds,
family = "logistic",
rounding = 2
) %>% rename(
`OR [95% CI]` = `OR`
),
unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
sex_female = if_else(sex == "F", 1, 0),
BMI10_last = (BMI_last/10)
) %>% dplyr::filter(
consent == 1
),
outcome = "identified_CKD_by_lab_AgeSpecCut",
predictors = preds,
family = "logistic",
rounding = 2
) %>%
dplyr::select(OR, N) %>%
rename(
`OR [95% CI]` = `OR`
),
unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
BMI10_last = (BMI_last/10)
),
outcome = "identified_CKD_by_lab_AgeSpecCut",
predictors = preds,
family = "logistic",
rounding = 2
) %>%
dplyr::select(OR, N) %>%
rename(
`OR [95% CI]` = `OR`
)),
align = c("r", "c", "c", "c", "c", "c", "c")
) %>%
add_header_above(
c(" " = 1, "unscreened" = 2, "screening" = 2, "enriched" = 2)
) %>%
column_spec(1, width = "10em") %>%
column_spec(c(2, 4, 6), width = "8em") %>%
column_spec(c(3, 5, 7), width = "5em")| predictor | OR [95% CI] | N | OR [95% CI] | N | OR [95% CI] | N |
|---|---|---|---|---|---|---|
| age_30y | 2.61 [1.96, 3.49] | 970 | 3.38 [2.64, 4.36] | 1933 | 3.04 [2.52, 3.67] | 2903 |
| age_60plus | 2.08 [1.58, 2.75] | 970 | 2.44 [1.95, 3.05] | 1933 | 2.27 [1.91, 2.7] | 2903 |
| sex_female | 0.84 [0.65, 1.1] | 970 | 0.82 [0.67, 1] | 1933 | 0.82 [0.7, 0.96] | 2903 |
| BMI10_last | 0.92 [0.72, 1.17] | 960 | 1.21 [1, 1.46] | 1913 | 1.09 [0.94, 1.27] | 2873 |
| BMI_over30 | 0.88 [0.67, 1.16] | 960 | 1.33 [1.08, 1.63] | 1913 | 1.14 [0.97, 1.34] | 2873 |
| transplant | 4.43 [2.87, 7.01] | 970 | 3.88 [2.95, 5.1] | 1933 | 3.82 [3.04, 4.81] | 2903 |
| FU_DM1 | 0.54 [0.36, 0.78] | 970 | 0.57 [0.43, 0.75] | 1933 | 0.55 [0.44, 0.69] | 2903 |
| FU_DM2 | 1.68 [1.29, 2.18] | 970 | 2.36 [1.93, 2.89] | 1933 | 2.08 [1.77, 2.44] | 2903 |
| FU_DM | 1.22 [0.94, 1.59] | 970 | 1.75 [1.42, 2.16] | 1933 | 1.51 [1.29, 1.78] | 2903 |
| FU_atherosclerosis | 2.52 [1.92, 3.32] | 970 | 2.31 [1.85, 2.88] | 1933 | 2.5 [2.1, 2.96] | 2903 |
| FU_stroke | 1.82 [1.11, 2.99] | 970 | 1.91 [1.22, 2.97] | 1933 | 1.98 [1.42, 2.74] | 2903 |
| FU_PAD | 3.3 [2.09, 5.33] | 970 | 4.65 [3.02, 7.27] | 1933 | 4.23 [3.09, 5.85] | 2903 |
| ischemic_heart_disease | 2.53 [1.87, 3.43] | 970 | 2.7 [2.09, 3.49] | 1933 | 2.76 [2.28, 3.36] | 2903 |
| FU_hypertension | 5.37 [3.37, 9.01] | 970 | 5.58 [3.89, 8.28] | 1933 | 5.62 [4.21, 7.65] | 2903 |
| FU_atrial_fibrillation | 2.94 [2.18, 3.98] | 970 | 1.98 [1.51, 2.58] | 1933 | 2.51 [2.07, 3.05] | 2903 |
| FU_heart_failure | 3.53 [2.6, 4.81] | 970 | 1.95 [1.51, 2.51] | 1933 | 2.62 [2.16, 3.17] | 2903 |
| HF_or_AF | 3.02 [2.3, 3.99] | 970 | 2.11 [1.68, 2.64] | 1933 | 2.56 [2.16, 3.04] | 2903 |
| log2_FU_charlson_index | 2.31 [1.93, 2.79] | 970 | 2.73 [2.36, 3.18] | 1933 | 2.59 [2.31, 2.91] | 2903 |
| charlson_index_5 | 3.15 [2.26, 4.41] | 970 | 4.54 [3.49, 5.9] | 1933 | 4.02 [3.28, 4.94] | 2903 |
| FU_steatosis | 1.37 [1.03, 1.84] | 970 | 1.58 [1.28, 1.96] | 1933 | 1.47 [1.24, 1.74] | 2903 |
5.2.1.2 Visualisation
Open code
unadj_eff_con0 <- unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
BMI10_last = (BMI_last/10)
) %>% dplyr::filter(
consent == 0
),
outcome = "identified_CKD_by_lab_AgeSpecCut",
predictors = preds,
family = "logistic",
paste_CI = FALSE
)
unadj_eff_con1 <- unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
BMI10_last = (BMI_last/10)
) %>% dplyr::filter(
consent == 1
),
outcome = "identified_CKD_by_lab_AgeSpecCut",
predictors = preds,
family = "logistic",
paste_CI = FALSE
)
unadj_eff_overall <- unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
BMI10_last = (BMI_last/10)
),
outcome = "identified_CKD_by_lab_AgeSpecCut",
predictors = preds,
family = "logistic",
paste_CI = FALSE
)
df_plot <- bind_rows(
unadj_eff_con1 %>% mutate(consent = "screening"),
unadj_eff_overall %>% mutate(consent = "overall")
) %>%
mutate(
predictor = recode(
predictor,
"age_30y" = "Age (per 30y)",
"age_60plus" = "Age ≥60y",
"sex_female" = "Female sex",
"BMI10_last" = "BMI (per 10 kg/m²)",
"BMI_over30" = "BMI ≥30 kg/m²",
"transplant" = "Non-renal transplantation",
"FU_DM1" = "T1DM",
"FU_DM2" = "T2DM",
"FU_DM" = "Any diabetes",
"FU_atherosclerosis" = "ASCVD",
"FU_stroke" = "Stroke",
"FU_PAD" = "Peripheral artery disease",
"ischemic_heart_disease" = "Ischemic heart disease",
"FU_hypertension" = "Arterial hypertension",
"FU_atrial_fibrillation" = "Atrial fibrilation",
"FU_heart_failure" = "Heart failure",
"HF_or_AF" = "Heart failure or atrial fibrilation",
"log2_FU_charlson_index" = "log₂ (Charlson index +1)",
"charlson_index_5" = "Charlson index ≥5",
"FU_steatosis" = "Liver steatosis"
),
predictor = factor(predictor, levels = rev(unique(predictor))),
consent = factor(
consent,
levels = c("screening", "overall", "enriched"),
labels = c("Screening cohort", "Enriched cohort", "No consent cohort")
)
)
ggplot(df_plot, aes(x = OR, y = predictor, color = consent, group = consent)) +
geom_point(
position = position_dodge(width = 0.6),
size = 2
) +
geom_errorbarh(
aes(xmin = CI_L, xmax = CI_U),
position = position_dodge(width = 0.6),
height = 0.3
) +
geom_vline(xintercept = 1, linetype = "dashed", color = "gray40") +
scale_x_log10(
breaks = c(1 / 4, 1 / 2, 1, 2, 4, 8),
labels = c("1/4", "1/2", "1", "2", "4", "8")
) +
scale_color_manual(
values = c(
"Enriched cohort" = "skyblue3",
"Screening cohort" = "#d95f02",
"No consent cohort" = "#1b9e77"
),
breaks = c(
"Enriched cohort", "Screening cohort", "No consent cohort")
) +
labs(
x = "Unadjusted odds ratio (log2 scale) for age-calibrated CKD",
y = NULL,
color = NULL
) +
theme_minimal(base_size = 12) +
theme(
legend.position = "top",
legend.text = element_text(size = 12),
axis.text.y = element_text(size = 11)
)5.2.2 Simple prevalence model
5.2.2.1 Prior
Open code
prior_intercept <- prior_string(
paste0("student_t(3, ", out_mean, ", 100)"),
class = "Intercept"
)5.2.2.2 Fit simple mdoel
Open code
model_simple_AgeCal <- run(
expr = brm(
identified_CKD_by_lab_AgeSpecCut ~ +1,
family = bernoulli(link = "logit"),
data = data_ckd,
backend = "cmdstanr",
seed = 736,
prior = prior_intercept,
cores = 1, chains = 2,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_simple_AgeCal",
reuse = TRUE
)
prior_summary(model_simple_AgeCal)
## Intercept ~ student_t(3, -0.536815474786327, 100)
summary(model_simple_AgeCal, robust = TRUE)
## Family: bernoulli
## Links: mu = logit
## Formula: identified_CKD_by_lab_AgeSpecCut ~ +1
## Data: data_ckd (Number of observations: 2903)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## Intercept -0.76 0.04 -0.84 -0.68 1.00 3193 2905
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
kableExtra::kable(
inv_logit(fixef(model_simple_AgeCal, robust = TRUE)[, c(1, 3,4)])
)| x | |
|---|---|
| Estimate | 0.3186890 |
| Q2.5 | 0.3024696 |
| Q97.5 | 0.3360485 |
5.2.3 Consent-specific
Open code
model_consent_spec_AgeCal <- run(
expr = brm(
identified_CKD_by_lab_AgeSpecCut ~ consent,
family = bernoulli(link = "logit"),
data = data_ckd,
backend = "cmdstanr",
seed = 736,
cores = 1, chains = 2,
prior = prior_intercept,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_consent_spec_AgeCal",
reuse = TRUE
)
prior_summary(model_consent_spec_AgeCal)
## prior class coef group resp dpar nlpar
## (flat) b
## (flat) b consent
## student_t(3, -0.536815474786327, 100) Intercept
## lb ub source
## default
## (vectorized)
## user
summary(model_consent_spec_AgeCal, robust = TRUE)
## Family: bernoulli
## Links: mu = logit
## Formula: identified_CKD_by_lab_AgeSpecCut ~ consent
## Data: data_ckd (Number of observations: 2903)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## Intercept -0.41 0.07 -0.54 -0.28 1.00 7068 5645
## consent -0.54 0.08 -0.71 -0.38 1.00 6808 5634
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
posterior <- as_draws_df(model_consent_spec_AgeCal) %>%
mutate(
consent_prev = inv_logit(b_Intercept + b_consent),
enriched_prev = inv_logit(b_Intercept)
)
tr <- posterior_epred(model_consent_spec_AgeCal)
tr2 <- rowMeans(tr)
kableExtra::kable(
data.frame(
rbind(
inv_logit(fixef(model_simple_AgeCal, robust = TRUE)[, c(1, 3, 4)]),
quantile(tr2, probs = c(0.5, 0.025, 0.975)),
quantile(posterior$enriched_prev, probs = c(0.5, 0.025, 0.975)),
quantile(posterior$consent_prev, probs = c(0.5, 0.025, 0.975))
)
) %>%
dplyr::mutate(
Estimand = c(
"Marginal prevalence - simple model",
"Marginal prevalence - consent-adj. model",
"Prevalence - consent=0",
"Prevalence - consent=1"
)
) %>% dplyr::select(
Estimand, Estimate, Q2.5, Q97.5
)
)| Estimand | Estimate | Q2.5 | Q97.5 |
|---|---|---|---|
| Marginal prevalence - simple model | 0.3186890 | 0.3024696 | 0.3360485 |
| Marginal prevalence - consent-adj. model | 0.3185398 | 0.3020272 | 0.3354221 |
| Prevalence - consent=0 | 0.3987536 | 0.3681524 | 0.4304378 |
| Prevalence - consent=1 | 0.2783192 | 0.2589978 | 0.2983243 |
5.2.4 Non-linear time model
5.2.4.1 Fit model
Open code
model_time_nl_AgeCal <- run(
expr = brm(
identified_CKD_by_lab_AgeSpecCut ~
consent +
s(I( (age-62) / 30), by = consent, k = 5),
family = bernoulli(link = "logit"),
data = data_ckd %>% dplyr::mutate(consent = factor(consent)),
backend = "cmdstanr",
seed = 736,
cores = 1, chains = 2,
prior = prior_intercept,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_time_nl_AgeCal",
reuse = TRUE
)
prior_summary(model_time_nl_AgeCal)
## prior class
## (flat) b
## (flat) b
## (flat) b
## (flat) b
## student_t(3, -0.536815474786327, 100) Intercept
## student_t(3, 0, 2.5) sds
## student_t(3, 0, 2.5) sds
## coef group resp dpar nlpar lb ub
##
## consent1
## sIageM62D30:consent0_1
## sIageM62D30:consent1_1
##
## 0
## s(I((age - 62)/30), by = consent, k = 5) 0
## source
## default
## (vectorized)
## (vectorized)
## (vectorized)
## user
## default
## (vectorized)
summary(model_time_nl_AgeCal, robust = TRUE)
## Warning: There were 4 divergent transitions after warmup. Increasing
## adapt_delta above 0.95 may help. See
## http://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
## Family: bernoulli
## Links: mu = logit
## Formula: identified_CKD_by_lab_AgeSpecCut ~ consent + s(I((age - 62)/30), by = consent, k = 5)
## Data: data_ckd %>% dplyr::mutate(consent = factor(consen (Number of observations: 2903)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Smoothing Spline Hyperparameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## sds(sIageM62D30consent0_1) 1.51 1.00 0.15 4.98 1.00 3358
## sds(sIageM62D30consent1_1) 1.99 1.02 0.67 5.66 1.00 4446
## Tail_ESS
## sds(sIageM62D30consent0_1) 2665
## sds(sIageM62D30consent1_1) 5085
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -0.46 0.07 -0.59 -0.32 1.00 14238
## consent1 -0.55 0.09 -0.71 -0.37 1.00 13322
## sIageM62D30:consent0_1 4.51 1.88 1.38 9.60 1.00 5773
## sIageM62D30:consent1_1 3.41 1.80 -0.36 6.96 1.00 7057
## Tail_ESS
## Intercept 6802
## consent1 6976
## sIageM62D30:consent0_1 6287
## sIageM62D30:consent1_1 6361
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).5.2.4.2 Get posteriors
Open code
quantile(data_ckd$age, probs = c(0, 0.01, 0.05, 0.25, 0.5, 0.75, 0.95, 0.99))
## 0% 1% 5% 25% 50% 75% 95% 99%
## 19 23 35 53 64 73 82 87
age_seq <- c(
seq(min(data_ckd$age),
max(data_ckd$age),
length.out = 101
),
c(seq(25, 80, by = 5))
)
consent_prop <- mean(data_ckd$consent)
new0 <- data.frame(
age = age_seq,
consent = factor(0, levels = c(0, 1))
)
new1 <- data.frame(
age = age_seq,
consent = factor(1, levels = c(0, 1))
)
p0 <- posterior_epred(model_time_nl_AgeCal, newdata = new0)
p1 <- posterior_epred(model_time_nl_AgeCal, newdata = new1)
p_overall <- (1 - consent_prop) * p0 + consent_prop * p1
summarize_epred <- function(mat, cohort) {
posterior_summary(mat, robust = TRUE) %>%
as.data.frame() %>%
dplyr::mutate(
cohort = cohort,
age = age_seq
)
}
prediction_NL_AgeCal <- dplyr::bind_rows(
summarize_epred(p1, "screening"),
summarize_epred(p0, "unscreened"),
summarize_epred(p_overall, "enriched")
) %>%
dplyr::mutate(age_calibrated = "Age calibrated")
kableExtra::kable(
prediction_NL_AgeCal %>%
dplyr::filter(age %in% seq(25, 80, by = 5)) %>%
dplyr::select(-age_calibrated)
)| Estimate | Est.Error | Q2.5 | Q97.5 | cohort | age |
|---|---|---|---|---|---|
| 0.1395572 | 0.0372061 | 0.0787033 | 0.2234000 | screening | 25 |
| 0.1490325 | 0.0292013 | 0.0980154 | 0.2129264 | screening | 30 |
| 0.1555549 | 0.0245560 | 0.1124612 | 0.2091325 | screening | 35 |
| 0.1591623 | 0.0207793 | 0.1225937 | 0.2055222 | screening | 40 |
| 0.1630277 | 0.0165016 | 0.1324695 | 0.1992461 | screening | 45 |
| 0.1706789 | 0.0141134 | 0.1440298 | 0.1994794 | screening | 50 |
| 0.1869536 | 0.0142870 | 0.1596122 | 0.2149158 | screening | 55 |
| 0.2158182 | 0.0150205 | 0.1869773 | 0.2452668 | screening | 60 |
| 0.2609720 | 0.0145373 | 0.2327901 | 0.2893641 | screening | 65 |
| 0.3225299 | 0.0147986 | 0.2933268 | 0.3523563 | screening | 70 |
| 0.3952730 | 0.0188668 | 0.3594185 | 0.4321345 | screening | 75 |
| 0.4696880 | 0.0254185 | 0.4205924 | 0.5182456 | screening | 80 |
| 0.2014725 | 0.0557390 | 0.1109428 | 0.3362090 | unscreened | 25 |
| 0.2242215 | 0.0450263 | 0.1475100 | 0.3265947 | unscreened | 30 |
| 0.2461957 | 0.0378987 | 0.1794108 | 0.3277804 | unscreened | 35 |
| 0.2649466 | 0.0329974 | 0.2071142 | 0.3361057 | unscreened | 40 |
| 0.2822756 | 0.0281053 | 0.2317176 | 0.3420600 | unscreened | 45 |
| 0.2997286 | 0.0236088 | 0.2552014 | 0.3492743 | unscreened | 50 |
| 0.3205592 | 0.0225427 | 0.2758762 | 0.3651812 | unscreened | 55 |
| 0.3471420 | 0.0236905 | 0.2999253 | 0.3918539 | unscreened | 60 |
| 0.3835562 | 0.0237025 | 0.3373242 | 0.4278050 | unscreened | 65 |
| 0.4309792 | 0.0228225 | 0.3846516 | 0.4750795 | unscreened | 70 |
| 0.4888441 | 0.0235652 | 0.4414717 | 0.5357460 | unscreened | 75 |
| 0.5546558 | 0.0304185 | 0.4963176 | 0.6147534 | unscreened | 80 |
| 0.1623431 | 0.0309247 | 0.1097639 | 0.2321991 | enriched | 25 |
| 0.1754620 | 0.0248836 | 0.1313767 | 0.2287736 | enriched | 30 |
| 0.1865640 | 0.0206033 | 0.1492435 | 0.2301107 | enriched | 35 |
| 0.1951743 | 0.0179145 | 0.1624429 | 0.2325733 | enriched | 40 |
| 0.2032750 | 0.0145347 | 0.1756931 | 0.2335762 | enriched | 45 |
| 0.2139667 | 0.0123031 | 0.1903069 | 0.2391232 | enriched | 50 |
| 0.2314912 | 0.0120964 | 0.2074345 | 0.2556436 | enriched | 55 |
| 0.2597144 | 0.0125323 | 0.2347938 | 0.2847148 | enriched | 60 |
| 0.3018639 | 0.0123858 | 0.2773893 | 0.3262252 | enriched | 65 |
| 0.3586988 | 0.0126935 | 0.3342189 | 0.3835209 | enriched | 70 |
| 0.4263979 | 0.0147517 | 0.3974536 | 0.4560074 | enriched | 75 |
| 0.4980711 | 0.0196033 | 0.4593185 | 0.5362264 | enriched | 80 |
5.2.4.3 Visualisation
Open code
prediction_NL_AgeCal %>%
dplyr::filter(cohort != 'enriched') %>%
ggplot(
aes(
x = age,
y = Estimate,
color = cohort,
fill = cohort
)
) +
geom_line(linewidth = 1) +
geom_ribbon(
aes(
ymin = Q2.5,
ymax = Q97.5
),
alpha = 0.4,
color = NA
) +
scale_y_continuous(
limits = c(0, 1),
breaks = seq(0, 1, by = 0.2)
) +
labs(
x = "Age (years)",
y = "Estimated probability of CKD new case"
) +
scale_color_manual(
values = c(
"unscreened" = "#1b9e77",
"screening" = "#d95f02",
"enriched" = "skyblue3"
),
name = "Cohort"
) +
scale_fill_manual(
values = c(
"unscreened" = "#1b9e77",
"screening" = "#d95f02",
"enriched" = "skyblue3"
),
name = "Cohort"
) +
facet_grid(rows = vars(cohort)) +
theme(
axis.text = element_text(size = 10),
axis.title = element_text(size = 12),
strip.text.x = element_text(size = 12),
legend.position = "none"
)5.2.4.4 Joint visualisation – enriched cohort
Open code
prediction <- bind_rows(prediction_NL, prediction_NL_AgeCal)
prediction %>%
dplyr::filter(cohort == 'enriched') %>%
ggplot(
aes(
x = age,
y = Estimate,
color = age_calibrated,
fill = age_calibrated
)
) +
geom_line(linewidth = 1) +
geom_ribbon(
aes(
ymin = Q2.5,
ymax = Q97.5
),
alpha = 0.4,
color = NA
) +
scale_y_continuous(
limits = c(0, 1),
breaks = seq(0, 1, by = 0.2)
) +
labs(
x = "Age (years)",
y = "Estimated probability of confirmed CKD"
) +
scale_color_manual(
values = c(
"No calibration" = "pink3",
"Age calibrated" = "cyan3"
),
name = "Age calibration"
) +
scale_fill_manual(
values = c(
"No calibration" = "pink3",
"Age calibrated" = "cyan3"
),
name = "Age calibration"
) +
facet_grid(rows = vars(age_calibrated)) +
theme(
axis.text = element_text(size = 13),
axis.title = element_text(size = 14),
strip.text = element_text(size = 14),
legend.position = "none"
)5.2.4.5 Joint visualisation – screening cohort
Open code
plotac <- "suppl_fig_6"
path <- "gitignore/figures"
prediction <- bind_rows(
prediction_NL,
prediction_NL_AgeCal
)
fig <- prediction %>%
dplyr::filter(cohort == "screening") %>%
ggplot(
aes(
x = age,
y = Estimate,
color = age_calibrated,
fill = age_calibrated
)
) +
geom_line(linewidth = 1) +
geom_ribbon(
aes(
ymin = Q2.5,
ymax = Q97.5
),
alpha = 0.4,
color = NA
) +
scale_y_continuous(
limits = c(0, 1),
breaks = seq(0, 1, by = 0.2)
) +
labs(
x = "Age (years)",
y = "Estimated probability of confirmed CKD"
) +
scale_color_manual(
values = c(
"No calibration" = "pink3",
"Age calibrated" = "cyan3"
),
name = "Age calibration"
) +
scale_fill_manual(
values = c(
"No calibration" = "pink3",
"Age calibrated" = "cyan3"
),
name = "Age calibration"
) +
facet_grid(
rows = vars(age_calibrated)
) +
theme(
axis.text = element_text(size = 13),
axis.title = element_text(size = 14),
strip.text = element_text(size = 14),
legend.position = "none"
)
figOpen code
if (!dir.exists(path)) {
dir.create(path, recursive = TRUE)
}
if (!file.exists(file.path(path, paste0(plotac, ".pdf")))) {
ggsave(
filename = paste0(plotac, ".pdf"),
plot = fig,
path = path,
device = "pdf",
width = 5.5,
height = 7
)
}5.2.5 Risk factors model
5.2.5.1 Can age be lienarized?
Open code
m_tr <- mgcv::gam(
identified_CKD_by_lab_AgeSpecCut ~
s(age, k = 5) +
transplant * consent +
FU_DM1 * consent +
FU_DM2 * consent +
FU_steatosis * consent +
FU_hypertension * consent +
FU_atherosclerosis * consent +
HF_or_AF * consent,
data = data_ckd,
family = binomial(link = 'logit')
)
summary(m_tr)
##
## Family: binomial
## Link function: logit
##
## Formula:
## identified_CKD_by_lab_AgeSpecCut ~ s(age, k = 5) + transplant *
## consent + FU_DM1 * consent + FU_DM2 * consent + FU_steatosis *
## consent + FU_hypertension * consent + FU_atherosclerosis *
## consent + HF_or_AF * consent
##
## Parametric coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.18012 0.27855 -7.827 5.01e-15 ***
## transplant 1.66924 0.25662 6.505 7.78e-11 ***
## consent -0.62916 0.34763 -1.810 0.0703 .
## FU_DM1 0.50741 0.24133 2.103 0.0355 *
## FU_DM2 0.23057 0.16047 1.437 0.1508
## FU_steatosis 0.03710 0.17761 0.209 0.8345
## FU_hypertension 1.06272 0.26903 3.950 7.81e-05 ***
## FU_atherosclerosis 0.39530 0.16171 2.445 0.0145 *
## HF_or_AF 0.76773 0.16141 4.756 1.97e-06 ***
## transplant:consent -0.24886 0.29985 -0.830 0.4066
## consent:FU_DM1 0.15553 0.29708 0.524 0.6006
## consent:FU_DM2 0.38178 0.20174 1.892 0.0584 .
## consent:FU_steatosis 0.08842 0.21790 0.406 0.6849
## consent:FU_hypertension 0.12369 0.33550 0.369 0.7124
## consent:FU_atherosclerosis -0.06597 0.20828 -0.317 0.7514
## consent:HF_or_AF -0.45607 0.20978 -2.174 0.0297 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df Chi.sq p-value
## s(age) 2.68 3.212 71.67 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.178 Deviance explained = 15.1%
## UBRE = 0.07587 Scale est. = 1 n = 2903
plot(m_tr)5.2.5.2 Fit model
Open code
model_complex_lin_AgeCal <- run(
expr = brm(
identified_CKD_by_lab_AgeSpecCut ~
I( (age-62) / 30) * consent +
transplant * consent +
sex_female * consent +
FU_DM1 * consent +
FU_DM2 * consent +
FU_steatosis * consent +
FU_hypertension * consent +
FU_atherosclerosis * consent +
HF_or_AF * consent,
family = bernoulli(link = "logit"),
data = data_ckd,
backend = "cmdstanr",
seed = 736,
cores = 1, chains = 2,
prior = priors,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_complex_lin_AgeCal",
reuse = TRUE
)
prior_summary(model_complex_lin_AgeCal)
## prior class coef group resp dpar
## (flat) b
## normal(0, 5) b consent
## normal(0, 1) b consent:FU_atherosclerosis
## normal(0, 1) b consent:FU_DM1
## normal(0, 1) b consent:FU_DM2
## normal(0, 1) b consent:FU_hypertension
## normal(0, 1) b consent:FU_steatosis
## normal(0, 1) b consent:HF_or_AF
## normal(0, 1) b consent:sex_female
## normal(0, 1) b consent:transplant
## normal(0, 5) b FU_atherosclerosis
## normal(0, 5) b FU_DM1
## normal(0, 5) b FU_DM2
## normal(0, 5) b FU_hypertension
## normal(0, 5) b FU_steatosis
## normal(0, 5) b HF_or_AF
## normal(0, 5) b IageM62D30
## normal(0, 1) b IageM62D30:consent
## normal(0, 5) b sex_female
## normal(0, 5) b transplant
## student_t(3, 0, 100) Intercept
## nlpar lb ub source
## default
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
summary(model_complex_lin_AgeCal, robust = TRUE)
## Family: bernoulli
## Links: mu = logit
## Formula: identified_CKD_by_lab_AgeSpecCut ~ I((age - 62)/30) * consent + transplant * consent + sex_female * consent + FU_DM1 * consent + FU_DM2 * consent + FU_steatosis * consent + FU_hypertension * consent + FU_atherosclerosis * consent + HF_or_AF * consent
## Data: data_ckd (Number of observations: 2903)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -2.26 0.29 -2.83 -1.71 1.00 6546
## IageM62D30 0.58 0.18 0.24 0.93 1.00 8328
## consent -0.55 0.36 -1.24 0.15 1.00 6093
## transplant 1.64 0.25 1.15 2.13 1.00 8409
## sex_female 0.04 0.15 -0.25 0.34 1.00 8661
## FU_DM1 0.51 0.23 0.04 0.97 1.00 7353
## FU_DM2 0.25 0.16 -0.05 0.56 1.00 7796
## FU_steatosis 0.00 0.18 -0.35 0.34 1.00 8506
## FU_hypertension 1.11 0.26 0.61 1.64 1.00 7447
## FU_atherosclerosis 0.44 0.16 0.13 0.75 1.00 9188
## HF_or_AF 0.82 0.16 0.51 1.14 1.00 8722
## IageM62D30:consent 0.45 0.23 0.01 0.90 1.00 7817
## consent:transplant -0.15 0.29 -0.72 0.41 1.00 8111
## consent:sex_female -0.04 0.19 -0.40 0.33 1.00 8300
## consent:FU_DM1 0.27 0.28 -0.32 0.85 1.00 7248
## consent:FU_DM2 0.34 0.20 -0.05 0.73 1.00 7460
## consent:FU_steatosis 0.11 0.22 -0.31 0.52 1.00 8795
## consent:FU_hypertension 0.01 0.31 -0.63 0.62 1.00 7061
## consent:FU_atherosclerosis -0.11 0.20 -0.52 0.30 1.00 9312
## consent:HF_or_AF -0.49 0.21 -0.90 -0.09 1.00 9577
## Tail_ESS
## Intercept 7204
## IageM62D30 7625
## consent 6539
## transplant 7230
## sex_female 8394
## FU_DM1 7305
## FU_DM2 7176
## FU_steatosis 7613
## FU_hypertension 6952
## FU_atherosclerosis 7600
## HF_or_AF 7878
## IageM62D30:consent 6889
## consent:transplant 7534
## consent:sex_female 8146
## consent:FU_DM1 7092
## consent:FU_DM2 7566
## consent:FU_steatosis 7723
## consent:FU_hypertension 6704
## consent:FU_atherosclerosis 7261
## consent:HF_or_AF 7185
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
exp(fixef(model_complex_lin_AgeCal, robust = TRUE))[,c(1, 3, 4)]
## Estimate Q2.5 Q97.5
## Intercept 0.1046221 0.05884758 0.1808525
## IageM62D30 1.7842863 1.26520656 2.5259184
## consent 0.5742080 0.29029707 1.1669961
## transplant 5.1483949 3.17241301 8.3846781
## sex_female 1.0449983 0.77988173 1.4075970
## FU_DM1 1.6603534 1.03807725 2.6507759
## FU_DM2 1.2794650 0.94664190 1.7494563
## FU_steatosis 1.0006659 0.70747794 1.4018310
## FU_hypertension 3.0229706 1.84811925 5.1542661
## FU_atherosclerosis 1.5541861 1.13663742 2.1223572
## HF_or_AF 2.2681500 1.66059563 3.1339698
## IageM62D30:consent 1.5741021 1.00680501 2.4685574
## consent:transplant 0.8565338 0.48704229 1.5126370
## consent:sex_female 0.9595255 0.66872743 1.3858562
## consent:FU_DM1 1.3105999 0.72694889 2.3345662
## consent:FU_DM2 1.4043871 0.94795030 2.0728687
## consent:FU_steatosis 1.1118285 0.73070374 1.6792041
## consent:FU_hypertension 1.0141283 0.53358412 1.8654935
## consent:FU_atherosclerosis 0.8947468 0.59599703 1.3475747
## consent:HF_or_AF 0.6141396 0.40830692 0.91140405.2.5.3 Extract posterior
Open code
consent_prop <- mean(data_ckd$consent)
age_scale <- 25 / 30
post <- posterior::as_draws_df(
model_complex_lin_AgeCal
)
b_all <- post %>%
dplyr::select(
dplyr::starts_with("b_")
)
## Warning: Dropping 'draws_df' class as required metadata was removed.
base <- b_all %>%
dplyr::transmute(
Intercept = b_Intercept,
age_25y = b_IageM62D30 * age_scale,
sex_female = b_sex_female,
transplant = b_transplant,
FU_DM1 = b_FU_DM1,
FU_DM2 = b_FU_DM2,
FU_steatosis = b_FU_steatosis,
FU_hypertension = b_FU_hypertension,
FU_atherosclerosis = b_FU_atherosclerosis,
HF_or_AF = b_HF_or_AF
)
eff_consent0 <- base
eff_consent1 <- base %>%
dplyr::mutate(
Intercept = Intercept + b_all$b_consent,
age_25y = age_25y + b_all$`b_IageM62D30:consent` * age_scale,
transplant = transplant + b_all$`b_consent:transplant`,
FU_DM1 = FU_DM1 + b_all$`b_consent:FU_DM1`,
FU_DM2 = FU_DM2 + b_all$`b_consent:FU_DM2`,
FU_steatosis = FU_steatosis + b_all$`b_consent:FU_steatosis`,
FU_hypertension = FU_hypertension + b_all$`b_consent:FU_hypertension`,
FU_atherosclerosis = FU_atherosclerosis + b_all$`b_consent:FU_atherosclerosis`,
HF_or_AF = HF_or_AF + b_all$`b_consent:HF_or_AF`,
sex_female = sex_female + b_all$`b_consent:sex_female`
)
eff_consent_mean <- base %>%
dplyr::mutate(
Intercept = Intercept + b_all$b_consent * consent_prop,
age_25y = age_25y + b_all$`b_IageM62D30:consent` * consent_prop * age_scale,
transplant = transplant + b_all$`b_consent:transplant` * consent_prop,
FU_DM1 = FU_DM1 + b_all$`b_consent:FU_DM1` * consent_prop,
FU_DM2 = FU_DM2 + b_all$`b_consent:FU_DM2` * consent_prop,
FU_steatosis = FU_steatosis + b_all$`b_consent:FU_steatosis` * consent_prop,
FU_hypertension = FU_hypertension + b_all$`b_consent:FU_hypertension` * consent_prop,
FU_atherosclerosis = FU_atherosclerosis + b_all$`b_consent:FU_atherosclerosis` * consent_prop,
HF_or_AF = HF_or_AF + b_all$`b_consent:HF_or_AF` * consent_prop,
sex_female = sex_female + b_all$`b_consent:sex_female` * consent_prop
)
data_dm_ref <- data_ckd %>%
dplyr::mutate(
FU_DM1 = 0,
FU_DM2 = 0
)
p0_dm <- brms::posterior_epred(
model_complex_lin_AgeCal,
newdata = data_dm_ref
) %>%
rowMeans()
odds0_dm <- p0_dm / (1 - p0_dm)
data_dm1 <- data_ckd %>%
dplyr::mutate(
FU_DM1 = 1,
FU_DM2 = 0
)
p1_dm1 <- brms::posterior_epred(
model_complex_lin_AgeCal,
newdata = data_dm1
) %>%
rowMeans()
odds1_dm1 <- p1_dm1 / (1 - p1_dm1)
data_dm2 <- data_ckd %>%
dplyr::mutate(
FU_DM1 = 0,
FU_DM2 = 1
)
p1_dm2 <- brms::posterior_epred(
model_complex_lin_AgeCal,
newdata = data_dm2
) %>%
rowMeans()
odds1_dm2 <- p1_dm2 / (1 - p1_dm2)
log_or_dm1_marg <- log(odds1_dm1 / odds0_dm)
log_or_dm2_marg <- log(odds1_dm2 / odds0_dm)
eff_marginal <- dplyr::tibble(
age_25y = calc_marg_log_or(
model_complex_lin_AgeCal,
data_ckd,
"age",
75,
50
),
sex_female = calc_marg_log_or(
model_complex_lin_AgeCal,
data_ckd,
"sex_female",
1,
0
),
transplant = calc_marg_log_or(
model_complex_lin_AgeCal,
data_ckd,
"transplant",
1,
0
),
FU_DM1 = log_or_dm1_marg,
FU_DM2 = log_or_dm2_marg,
FU_steatosis = calc_marg_log_or(
model_complex_lin_AgeCal,
data_ckd,
"FU_steatosis",
1,
0
),
FU_hypertension = calc_marg_log_or(
model_complex_lin_AgeCal,
data_ckd,
"FU_hypertension",
1,
0
),
FU_atherosclerosis = calc_marg_log_or(
model_complex_lin_AgeCal,
data_ckd,
"FU_atherosclerosis",
1,
0
),
HF_or_AF = calc_marg_log_or(
model_complex_lin_AgeCal,
data_ckd,
"HF_or_AF",
1,
0
)
)
summ <- dplyr::bind_rows(
posterior::summarise_draws(
eff_consent0,
median,
~ quantile(.x, c(0.025, 0.975))
) %>%
dplyr::mutate(
cohort = "unscreened"
),
posterior::summarise_draws(
eff_consent1,
median,
~ quantile(.x, c(0.025, 0.975))
) %>%
dplyr::mutate(
cohort = "screening"
),
posterior::summarise_draws(
eff_consent_mean,
median,
~ quantile(.x, c(0.025, 0.975))
) %>%
dplyr::mutate(
cohort = "enriched_std_cond"
),
posterior::summarise_draws(
eff_marginal,
median,
~ quantile(.x, c(0.025, 0.975))
) %>%
dplyr::mutate(
cohort = "enriched_marginal"
)
) %>%
dplyr::rename(
predictor = variable,
CI_L = `2.5%`,
CI_U = `97.5%`
) %>%
dplyr::mutate(
OR = exp(median),
CI_L = exp(CI_L),
CI_U = exp(CI_U)
)
data_forest <- summ %>%
dplyr::filter(
predictor != "Intercept"
) %>%
dplyr::mutate(
predictor = factor(
predictor,
levels = rev(
unique(
predictor
)
)
)
)
tab_ready <- summ %>%
dplyr::filter(
predictor != "Intercept"
) %>%
dplyr::mutate(
label = sprintf(
"%.2f [%.2f, %.2f]",
OR,
CI_L,
CI_U
)
) %>%
dplyr::select(
cohort,
predictor,
label
)
tab_wide <- tab_ready %>%
tidyr::pivot_wider(
names_from = cohort,
values_from = label
) %>%
dplyr::arrange(
predictor
)
kableExtra::kable(tab_wide, caption = "Associations between clinical factors and age-calibrated CKD from the multivariable Bayesian logistic regression model. Odds ratios (ORs) are shown with 95% credible intervals. For screened and unscreened patients, ORs are conditional estimates from the interaction model. For the Enriched cohort, two summary measures are presented: the population-average conditional OR, calculated as the weighted average of screened- and unscreened-specific log-ORs using their observed proportions in the cohort, and the marginal OR, obtained by posterior standardisation of predicted probabilities across all patients in the Enriched cohort. Age effects are expressed for a 25-year difference; the marginal age OR compares 75 versus 50 years.")| predictor | unscreened | screening | enriched_std_cond | enriched_marginal |
|---|---|---|---|---|
| FU_DM1 | 1.66 [1.04, 2.65] | 2.17 [1.52, 3.08] | 1.98 [1.49, 2.66] | 1.74 [1.38, 2.19] |
| FU_DM2 | 1.28 [0.95, 1.75] | 1.80 [1.41, 2.30] | 1.61 [1.32, 1.95] | 1.46 [1.24, 1.72] |
| FU_atherosclerosis | 1.55 [1.14, 2.12] | 1.39 [1.06, 1.81] | 1.44 [1.17, 1.78] | 1.36 [1.14, 1.63] |
| FU_hypertension | 3.02 [1.85, 5.15] | 3.06 [2.11, 4.59] | 3.06 [2.26, 4.26] | 2.63 [2.01, 3.54] |
| FU_steatosis | 1.00 [0.71, 1.40] | 1.11 [0.87, 1.41] | 1.07 [0.87, 1.31] | 1.06 [0.89, 1.24] |
| HF_or_AF | 2.27 [1.66, 3.13] | 1.39 [1.07, 1.82] | 1.64 [1.33, 2.02] | 1.54 [1.30, 1.84] |
| age_25y | 1.62 [1.22, 2.16] | 2.37 [1.83, 3.05] | 2.09 [1.72, 2.54] | 1.85 [1.57, 2.19] |
| sex_female | 1.04 [0.78, 1.41] | 1.00 [0.80, 1.26] | 1.02 [0.85, 1.22] | 1.02 [0.88, 1.18] |
| transplant | 5.15 [3.17, 8.38] | 4.41 [3.23, 6.04] | 4.65 [3.56, 6.13] | 3.64 [2.92, 4.56] |
5.2.5.4 Visualisation, screening + enriched (conditional)
Open code
data_forest %>%
dplyr::filter(
cohort != "unscreened",
cohort != "enriched_marginal"
) %>%
dplyr::mutate(
predictor = dplyr::recode(
predictor,
"age_25y" = "Age (per 25y)",
"transplant" = "Non-renal transplantation",
"FU_DM1" = "T1DM",
"FU_DM2" = "T2DM",
"FU_hypertension" = "Arterial hypertension",
"HF_or_AF" = "Heart failure or atrial fibrillation",
"FU_atherosclerosis" = "ASCVD",
"FU_steatosis" = "Liver steatosis",
"sex_female" = "Female"
),
predictor = factor(
predictor,
levels = rev(
unique(
predictor
)
)
),
cohort = factor(
cohort,
levels = c(
"unscreened",
"screening",
"enriched_std_cond",
"enriched_marginal"
),
labels = c(
"Unscreened patients",
"Screening cohort",
"Enriched cohort (conditional)",
"Enriched cohort (marginal)"
)
)
) %>%
ggplot2::ggplot(
ggplot2::aes(
x = OR,
y = predictor,
color = cohort
)
) +
ggplot2::geom_point(
position = ggplot2::position_dodge(width = 0.6),
size = 2
) +
ggplot2::geom_errorbarh(
ggplot2::aes(
xmin = CI_L,
xmax = CI_U
),
position = ggplot2::position_dodge(width = 0.6),
height = 0.3
) +
ggplot2::geom_vline(
xintercept = 1,
linetype = "dashed",
color = "gray40"
) +
ggplot2::scale_x_log10(
breaks = c(1 / 4, 1 / 2, 1, 2, 4, 8),
labels = c("1/4", "1/2", "1", "2", "4", "8")
) +
ggplot2::scale_color_manual(
values = c(
"Unscreened patients" = "#1b9e77",
"Screening cohort" = "#d95f02",
"Enriched cohort (conditional)" = "skyblue3",
"Enriched cohort (marginal)" = "#984ea3"
)
) +
ggplot2::labs(
x = "Adjusted odds ratio (log scale) for age-calibrated CKD",
y = NULL,
color = NULL
) +
ggplot2::guides(
color = ggplot2::guide_legend(
nrow = 1
)
) +
ggplot2::theme_minimal(
base_size = 12
) +
ggplot2::theme(
legend.position = "top",
axis.text.y = ggplot2::element_text(size = 11),
legend.text = ggplot2::element_text(size = 10)
)5.2.5.5 Visualisation, all
Open code
plotac <- "suppl_fig_7"
path <- "gitignore/figures"
fig <- data_forest %>%
dplyr::mutate(
predictor = dplyr::recode(
predictor,
"age_25y" = "Age (per 25y)",
"transplant" = "Non-renal transplantation",
"FU_DM1" = "T1DM",
"FU_DM2" = "T2DM",
"FU_hypertension" = "Arterial hypertension",
"HF_or_AF" = "Heart failure or atrial fibrillation",
"FU_atherosclerosis" = "ASCVD",
"FU_steatosis" = "Liver steatosis",
"sex_female" = "Female"
),
predictor = factor(
predictor,
levels = rev(
unique(
predictor
)
)
),
cohort = factor(
cohort,
levels = c(
"unscreened",
"screening",
"enriched_std_cond",
"enriched_marginal"
),
labels = c(
"Unscreened patients",
"Screening cohort",
"Enriched cohort (conditional)",
"Enriched cohort (marginal)"
)
)
) %>%
ggplot2::ggplot(
ggplot2::aes(
x = OR,
y = predictor,
color = cohort
)
) +
ggplot2::geom_point(
position = ggplot2::position_dodge(width = 0.6),
size = 2
) +
ggplot2::geom_errorbarh(
ggplot2::aes(
xmin = CI_L,
xmax = CI_U
),
position = ggplot2::position_dodge(width = 0.6),
height = 0.3
) +
ggplot2::geom_vline(
xintercept = 1,
linetype = "dashed",
color = "gray40"
) +
ggplot2::scale_x_log10(
breaks = c(1 / 4, 1 / 2, 1, 2, 4, 8),
labels = c("1/4", "1/2", "1", "2", "4", "8")
) +
ggplot2::scale_color_manual(
values = c(
"Unscreened patients" = "#1b9e77",
"Screening cohort" = "#d95f02",
"Enriched cohort (conditional)" = "skyblue3",
"Enriched cohort (marginal)" = "#984ea3"
)
) +
ggplot2::labs(
x = "Adjusted odds ratio (log scale) for age-calibrated CKD",
y = NULL,
color = NULL
) +
ggplot2::guides(
color = ggplot2::guide_legend(
nrow = 2
)
) +
ggplot2::theme_minimal(
base_size = 12
) +
ggplot2::theme(
legend.position = "top",
axis.text.y = ggplot2::element_text(size = 11),
legend.text = ggplot2::element_text(size = 10)
)
figOpen code
if (!dir.exists(path)) {
dir.create(path, recursive = TRUE)
}
if (!file.exists(file.path(path, paste0(plotac, ".pdf")))) {
ggplot2::ggsave(
filename = paste0(plotac, ".pdf"),
plot = fig,
path = path,
device = "pdf",
width = 6.5,
height = 5
)
}5.2.5.6 Sensitivity analysis
Fit model
Open code
model_sens_lin_AgeCal <- run(
expr = brm(
identified_CKD_by_lab_AgeSpecCut ~
s(I( (age-62) / 30), by = consent, k = 5) +
transplant * consent +
FU_DM1 * consent +
FU_DM2 * consent +
sex_female * consent +
FU_steatosis * consent +
FU_hypertension * consent +
FU_atherosclerosis * consent +
HF_or_AF * consent +
BMI_over30 * consent,
data = data_ckd |>
dplyr::filter(!is.na(BMI_over30)) |>
dplyr::mutate(consent = factor(consent)),
family = bernoulli(link = "logit"),
backend = "cmdstanr",
seed = 736,
cores = 1, chains = 2,
prior = priors_sens,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_sens_lin_AgeCal",
reuse = TRUE
)
prior_summary(model_sens_lin_AgeCal)
## prior class coef group
## (flat) b
## normal(0, 5) b BMI_over30
## normal(0, 5) b consent1
## normal(0, 1) b consent1:BMI_over30
## normal(0, 1) b consent1:FU_atherosclerosis
## normal(0, 1) b consent1:FU_DM1
## normal(0, 1) b consent1:FU_DM2
## normal(0, 1) b consent1:FU_hypertension
## normal(0, 1) b consent1:FU_steatosis
## normal(0, 1) b consent1:HF_or_AF
## normal(0, 1) b consent1:sex_female
## normal(0, 5) b FU_atherosclerosis
## normal(0, 5) b FU_DM1
## normal(0, 5) b FU_DM2
## normal(0, 5) b FU_hypertension
## normal(0, 5) b FU_steatosis
## normal(0, 5) b HF_or_AF
## normal(0, 5) b sex_female
## (flat) b sIageM62D30:consent0_1
## (flat) b sIageM62D30:consent1_1
## normal(0, 5) b transplant
## normal(0, 1) b transplant:consent1
## student_t(3, 0, 100) Intercept
## student_t(3, 0, 2.5) sds
## student_t(3, 0, 2.5) sds s(I((age - 62)/30), by = consent, k = 5)
## resp dpar nlpar lb ub source
## default
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## (vectorized)
## (vectorized)
## user
## user
## user
## 0 default
## 0 (vectorized)
summary(model_sens_lin_AgeCal, robust = TRUE)
## Warning: There were 2 divergent transitions after warmup. Increasing
## adapt_delta above 0.95 may help. See
## http://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
## Family: bernoulli
## Links: mu = logit
## Formula: identified_CKD_by_lab_AgeSpecCut ~ s(I((age - 62)/30), by = consent, k = 5) + transplant * consent + FU_DM1 * consent + FU_DM2 * consent + sex_female * consent + FU_steatosis * consent + FU_hypertension * consent + FU_atherosclerosis * consent + HF_or_AF * consent + BMI_over30 * consent
## Data: dplyr::mutate(dplyr::filter(data_ckd, !is.na(BMI_o (Number of observations: 2873)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Smoothing Spline Hyperparameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## sds(sIageM62D30consent0_1) 1.72 1.12 0.22 5.72 1.00 4028
## sds(sIageM62D30consent1_1) 2.01 0.97 0.74 5.41 1.00 6920
## Tail_ESS
## sds(sIageM62D30consent0_1) 3930
## sds(sIageM62D30consent1_1) 6860
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -2.22 0.29 -2.81 -1.66 1.00 7342
## transplant 1.60 0.25 1.12 2.10 1.00 8411
## consent1 -0.61 0.35 -1.30 0.09 1.00 7266
## FU_DM1 0.47 0.24 0.00 0.93 1.00 8870
## FU_DM2 0.29 0.16 -0.02 0.60 1.00 10157
## sex_female 0.02 0.15 -0.27 0.32 1.00 10413
## FU_steatosis 0.06 0.18 -0.30 0.41 1.00 10046
## FU_hypertension 1.17 0.27 0.66 1.71 1.00 8362
## FU_atherosclerosis 0.44 0.16 0.12 0.76 1.00 11004
## HF_or_AF 0.82 0.16 0.50 1.12 1.00 9142
## BMI_over30 -0.26 0.16 -0.57 0.05 1.00 9077
## transplant:consent1 -0.06 0.29 -0.64 0.51 1.00 8697
## consent1:FU_DM1 0.27 0.29 -0.30 0.85 1.00 8463
## consent1:FU_DM2 0.26 0.20 -0.14 0.66 1.00 10326
## consent1:sex_female -0.01 0.19 -0.38 0.36 1.00 10122
## consent1:FU_steatosis 0.05 0.21 -0.38 0.48 1.00 9694
## consent1:FU_hypertension -0.04 0.32 -0.68 0.58 1.00 8106
## consent1:FU_atherosclerosis -0.16 0.21 -0.56 0.26 1.00 10879
## consent1:HF_or_AF -0.54 0.20 -0.95 -0.13 1.00 8528
## consent1:BMI_over30 0.46 0.19 0.08 0.84 1.00 9409
## sIageM62D30:consent0_1 3.67 2.33 0.09 9.58 1.00 7295
## sIageM62D30:consent1_1 3.38 1.84 -0.46 7.31 1.00 9010
## Tail_ESS
## Intercept 5457
## transplant 6861
## consent1 7315
## FU_DM1 6625
## FU_DM2 7738
## sex_female 7565
## FU_steatosis 7511
## FU_hypertension 7239
## FU_atherosclerosis 7729
## HF_or_AF 6631
## BMI_over30 7271
## transplant:consent1 7542
## consent1:FU_DM1 6049
## consent1:FU_DM2 7285
## consent1:sex_female 7724
## consent1:FU_steatosis 7269
## consent1:FU_hypertension 7538
## consent1:FU_atherosclerosis 7400
## consent1:HF_or_AF 7019
## consent1:BMI_over30 7774
## sIageM62D30:consent0_1 7436
## sIageM62D30:consent1_1 7363
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
exp(fixef(model_sens_lin_AgeCal, robust = TRUE))[,c(1, 3, 4)]
## Estimate Q2.5 Q97.5
## Intercept 0.1085098 0.06008741 1.892046e-01
## transplant 4.9586325 3.05319627 8.175125e+00
## consent1 0.5411455 0.27177147 1.088731e+00
## FU_DM1 1.5999822 1.00476387 2.545337e+00
## FU_DM2 1.3389142 0.97733778 1.824451e+00
## sex_female 1.0251265 0.76373209 1.378429e+00
## FU_steatosis 1.0568991 0.74397515 1.506831e+00
## FU_hypertension 3.2181768 1.94188888 5.549069e+00
## FU_atherosclerosis 1.5519893 1.13221940 2.135438e+00
## HF_or_AF 2.2637665 1.64220520 3.070724e+00
## BMI_over30 0.7691279 0.56653392 1.047691e+00
## transplant:consent1 0.9383298 0.52945438 1.668379e+00
## consent1:FU_DM1 1.3161832 0.74064722 2.337859e+00
## consent1:FU_DM2 1.2964490 0.86668395 1.925835e+00
## consent1:sex_female 0.9908674 0.68570450 1.436114e+00
## consent1:FU_steatosis 1.0555579 0.68366276 1.615401e+00
## consent1:FU_hypertension 0.9566515 0.50570973 1.789043e+00
## consent1:FU_atherosclerosis 0.8555280 0.56992121 1.291229e+00
## consent1:HF_or_AF 0.5805145 0.38729380 8.769471e-01
## consent1:BMI_over30 1.5804348 1.07932713 2.320356e+00
## sIageM62D30:consent0_1 39.4017409 1.09834783 1.445962e+04
## sIageM62D30:consent1_1 29.4621091 0.63290324 1.497270e+03Extract posteriors and show results
Open code
dummy_base <- data_ckd_complete[1, ] %>%
dplyr::mutate(
transplant = 0,
FU_DM1 = 0,
FU_DM2 = 0,
sex_female = 0,
FU_steatosis = 0,
FU_hypertension = 0,
FU_atherosclerosis = 0,
HF_or_AF = 0,
BMI_over30 = 0
)
d_c0_a50 <- dummy_base %>%
dplyr::mutate(
consent = factor(0, levels = c("0", "1")),
age = 50
)
d_c0_a75 <- dummy_base %>%
dplyr::mutate(
consent = factor(0, levels = c("0", "1")),
age = 75
)
lin_c0_a50 <- posterior_linpred(
model_sens_lin_AgeCal,
newdata = d_c0_a50
)
lin_c0_a75 <- posterior_linpred(
model_sens_lin_AgeCal,
newdata = d_c0_a75
)
age_25y_c0 <- as.numeric(lin_c0_a75 - lin_c0_a50)
d_c1_a50 <- dummy_base %>%
dplyr::mutate(
consent = factor(1, levels = c("0", "1")),
age = 50
)
d_c1_a75 <- dummy_base %>%
dplyr::mutate(
consent = factor(1, levels = c("0", "1")),
age = 75
)
lin_c1_a50 <- posterior_linpred(
model_sens_lin_AgeCal,
newdata = d_c1_a50
)
lin_c1_a75 <- posterior_linpred(
model_sens_lin_AgeCal,
newdata = d_c1_a75
)
age_25y_c1 <- as.numeric(lin_c1_a75 - lin_c1_a50)
post <- as_draws_df(
model_sens_lin_AgeCal
)
b_all <- post %>%
dplyr::select(
dplyr::starts_with("b_")
)
## Warning: Dropping 'draws_df' class as required metadata was removed.
eff_consent0 <- dplyr::tibble(
age_25y = age_25y_c0,
sex_female = b_all$b_sex_female,
transplant = b_all$b_transplant,
FU_DM1 = b_all$b_FU_DM1,
FU_DM2 = b_all$b_FU_DM2,
FU_steatosis = b_all$b_FU_steatosis,
FU_hypertension = b_all$b_FU_hypertension,
FU_atherosclerosis = b_all$b_FU_atherosclerosis,
HF_or_AF = b_all$b_HF_or_AF,
BMI_over30 = b_all$b_BMI_over30
)
eff_consent1 <- dplyr::tibble(
age_25y = age_25y_c1,
sex_female = b_all$b_sex_female + b_all$`b_consent1:sex_female`,
transplant = b_all$b_transplant + b_all$`b_transplant:consent1`,
FU_DM1 = b_all$b_FU_DM1 + b_all$`b_consent1:FU_DM1`,
FU_DM2 = b_all$b_FU_DM2 + b_all$`b_consent1:FU_DM2`,
FU_steatosis = b_all$b_FU_steatosis + b_all$`b_consent1:FU_steatosis`,
FU_hypertension = b_all$b_FU_hypertension + b_all$`b_consent1:FU_hypertension`,
FU_atherosclerosis = b_all$b_FU_atherosclerosis + b_all$`b_consent1:FU_atherosclerosis`,
HF_or_AF = b_all$b_HF_or_AF + b_all$`b_consent1:HF_or_AF`,
BMI_over30 = b_all$b_BMI_over30 + b_all$`b_consent1:BMI_over30`
)
eff_consent_mean <- dplyr::tibble(
age_25y = age_25y_c0 * (1 - consent_prop) +
age_25y_c1 * consent_prop,
sex_female = eff_consent0$sex_female * (1 - consent_prop) +
eff_consent1$sex_female * consent_prop,
transplant = eff_consent0$transplant * (1 - consent_prop) +
eff_consent1$transplant * consent_prop,
FU_DM1 = eff_consent0$FU_DM1 * (1 - consent_prop) +
eff_consent1$FU_DM1 * consent_prop,
FU_DM2 = eff_consent0$FU_DM2 * (1 - consent_prop) +
eff_consent1$FU_DM2 * consent_prop,
FU_steatosis = eff_consent0$FU_steatosis * (1 - consent_prop) +
eff_consent1$FU_steatosis * consent_prop,
FU_hypertension = eff_consent0$FU_hypertension * (1 - consent_prop) +
eff_consent1$FU_hypertension * consent_prop,
FU_atherosclerosis = eff_consent0$FU_atherosclerosis * (1 - consent_prop) +
eff_consent1$FU_atherosclerosis * consent_prop,
HF_or_AF = eff_consent0$HF_or_AF * (1 - consent_prop) +
eff_consent1$HF_or_AF * consent_prop,
BMI_over30 = eff_consent0$BMI_over30 * (1 - consent_prop) +
eff_consent1$BMI_over30 * consent_prop
)
calc_marg_log_or <- function(model, data, var_name, val1, val0) {
d1 <- data
d1[[var_name]] <- val1
p1 <- posterior_epred(
model,
newdata = d1
)
p1_marg <- rowMeans(p1)
d0 <- data
d0[[var_name]] <- val0
p0 <- posterior_epred(
model,
newdata = d0
)
p0_marg <- rowMeans(p0)
odds1 <- p1_marg / (1 - p1_marg)
odds0 <- p0_marg / (1 - p0_marg)
marg_or <- odds1 / odds0
return(log(marg_or))
}
data_dm_ref <- data_ckd_complete %>%
dplyr::mutate(
FU_DM1 = 0,
FU_DM2 = 0
)
p0_dm <- posterior_epred(
model_sens_lin_AgeCal,
newdata = data_dm_ref
) %>%
rowMeans()
odds0_dm <- p0_dm / (1 - p0_dm)
data_dm1 <- data_ckd_complete %>%
dplyr::mutate(
FU_DM1 = 1,
FU_DM2 = 0
)
p1_dm1 <- posterior_epred(
model_sens_lin_AgeCal,
newdata = data_dm1
) %>%
rowMeans()
odds1_dm1 <- p1_dm1 / (1 - p1_dm1)
data_dm2 <- data_ckd_complete %>%
dplyr::mutate(
FU_DM1 = 0,
FU_DM2 = 1
)
p1_dm2 <- posterior_epred(
model_sens_lin_AgeCal,
newdata = data_dm2
) %>%
rowMeans()
odds1_dm2 <- p1_dm2 / (1 - p1_dm2)
log_or_dm1_marg <- log(odds1_dm1 / odds0_dm)
log_or_dm2_marg <- log(odds1_dm2 / odds0_dm)
eff_marginal <- dplyr::tibble(
age_25y = calc_marg_log_or(
model_sens_lin_AgeCal,
data_ckd_complete,
"age",
75,
50
),
sex_female = calc_marg_log_or(
model_sens_lin_AgeCal,
data_ckd_complete,
"sex_female",
1,
0
),
transplant = calc_marg_log_or(
model_sens_lin_AgeCal,
data_ckd_complete,
"transplant",
1,
0
),
FU_DM1 = log_or_dm1_marg,
FU_DM2 = log_or_dm2_marg,
FU_steatosis = calc_marg_log_or(
model_sens_lin_AgeCal,
data_ckd_complete,
"FU_steatosis",
1,
0
),
FU_hypertension = calc_marg_log_or(
model_sens_lin_AgeCal,
data_ckd_complete,
"FU_hypertension",
1,
0
),
FU_atherosclerosis = calc_marg_log_or(
model_sens_lin_AgeCal,
data_ckd_complete,
"FU_atherosclerosis",
1,
0
),
HF_or_AF = calc_marg_log_or(
model_sens_lin_AgeCal,
data_ckd_complete,
"HF_or_AF",
1,
0
),
BMI_over30 = calc_marg_log_or(
model_sens_lin_AgeCal,
data_ckd_complete,
"BMI_over30",
1,
0
)
)
summ <- dplyr::bind_rows(
summarise_draws(
eff_consent0,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "unscreened"
),
summarise_draws(
eff_consent1,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "screening"
),
summarise_draws(
eff_consent_mean,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "enriched_std_cond"
),
summarise_draws(
eff_marginal,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "enriched_marginal"
)
) %>%
dplyr::rename(
predictor = variable,
CI_L = `2.5%`,
CI_U = `97.5%`
) %>%
dplyr::mutate(
OR = exp(median),
CI_L = exp(CI_L),
CI_U = exp(CI_U)
)
tab_ready <- summ %>%
dplyr::mutate(
label = sprintf(
"%.2f [%.2f, %.2f]",
OR,
CI_L,
CI_U
)
) %>%
dplyr::select(
cohort,
predictor,
label
)
tab_wide <- tab_ready %>%
tidyr::pivot_wider(
names_from = cohort,
values_from = label
) %>%
dplyr::arrange(
predictor
)
kableExtra::kable(
tab_wide,
caption = "Associations between clinical factors and confirmed CKD (defined by an age-specific eGFR threshold) from the multivariable Bayesian logistic regression model. Odds ratios (ORs) are shown with 95% credible intervals. For screened and unscreened patients, ORs are conditional estimates from the interaction model. For the Enriched cohort, two summary measures are presented: the population-average conditional OR, calculated as the weighted average of screened- and unscreened-specific log-ORs using their observed proportions in the cohort, and the marginal OR, obtained by posterior standardisation of predicted probabilities across all patients in the Enriched cohort. Age effects are expressed for a 25-year difference comparing 75 versus 50 years."
)| predictor | unscreened | screening | enriched_std_cond | enriched_marginal |
|---|---|---|---|---|
| BMI_over30 | 0.77 [0.57, 1.05] | 1.22 [0.96, 1.53] | 1.04 [0.87, 1.26] | 1.02 [0.88, 1.19] |
| FU_DM1 | 1.60 [1.00, 2.55] | 2.10 [1.47, 3.01] | 1.92 [1.43, 2.58] | 1.68 [1.33, 2.13] |
| FU_DM2 | 1.34 [0.98, 1.82] | 1.74 [1.35, 2.22] | 1.59 [1.30, 1.94] | 1.45 [1.23, 1.71] |
| FU_atherosclerosis | 1.55 [1.13, 2.14] | 1.33 [1.02, 1.72] | 1.40 [1.14, 1.72] | 1.33 [1.12, 1.58] |
| FU_hypertension | 3.22 [1.94, 5.55] | 3.06 [2.07, 4.66] | 3.12 [2.26, 4.39] | 2.66 [2.01, 3.62] |
| FU_steatosis | 1.06 [0.74, 1.51] | 1.12 [0.86, 1.43] | 1.09 [0.89, 1.34] | 1.07 [0.91, 1.27] |
| HF_or_AF | 2.26 [1.64, 3.07] | 1.31 [1.00, 1.71] | 1.57 [1.27, 1.94] | 1.48 [1.25, 1.77] |
| age_25y | 1.54 [1.06, 2.17] | 2.77 [2.03, 3.82] | 2.28 [1.79, 2.90] | 1.97 [1.61, 2.42] |
| sex_female | 1.03 [0.76, 1.38] | 1.02 [0.81, 1.28] | 1.02 [0.85, 1.22] | 1.02 [0.88, 1.18] |
| transplant | 4.96 [3.05, 8.18] | 4.66 [3.37, 6.47] | 4.76 [3.60, 6.28] | 3.68 [2.93, 4.62] |
5.3 New CKD cases
5.3.1 Unadjsuted effects
5.3.1.1 Fit models
Open code
kableExtra::kable(
cbind(
unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
sex_female = if_else(sex == "F", 1, 0),
BMI10_last = (BMI_last/10)
) %>% dplyr::filter(
consent == 0
),
outcome = "new_cases",
predictors = preds,
family = "logistic",
rounding = 2
) %>% rename(
`OR [95% CI]` = `OR`
),
unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
sex_female = if_else(sex == "F", 1, 0),
BMI10_last = (BMI_last/10)
) %>% dplyr::filter(
consent == 1
),
outcome = "new_cases",
predictors = preds,
family = "logistic",
rounding = 2
) %>%
dplyr::select(OR, N) %>%
rename(
`OR [95% CI]` = `OR`
),
unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
BMI10_last = (BMI_last/10)
),
outcome = "new_cases",
predictors = preds,
family = "logistic",
rounding = 2
) %>%
dplyr::select(OR, N) %>%
rename(
`OR [95% CI]` = `OR`
)),
align = c("r", "c", "c", "c", "c", "c", "c")
) %>%
add_header_above(
c(" " = 1, "unscreened" = 2, "screening" = 2, "enriched" = 2)
) %>%
column_spec(1, width = "10em") %>%
column_spec(c(2, 4, 6), width = "8em") %>%
column_spec(c(3, 5, 7), width = "5em")| predictor | OR [95% CI] | N | OR [95% CI] | N | OR [95% CI] | N |
|---|---|---|---|---|---|---|
| age_30y | 3.16 [1.97, 5.22] | 970 | 5.6 [3.99, 7.98] | 1933 | 4.49 [3.41, 5.95] | 2903 |
| age_60plus | 2.78 [1.71, 4.73] | 970 | 3.23 [2.39, 4.44] | 1933 | 3.08 [2.38, 4.04] | 2903 |
| sex_female | 1.03 [0.68, 1.54] | 970 | 1.24 [0.97, 1.58] | 1933 | 1.19 [0.96, 1.47] | 2903 |
| BMI10_last | 0.64 [0.42, 0.95] | 960 | 1.05 [0.83, 1.32] | 1913 | 0.92 [0.75, 1.12] | 2873 |
| BMI_over30 | 0.57 [0.35, 0.9] | 960 | 1.17 [0.91, 1.51] | 1913 | 0.98 [0.78, 1.22] | 2873 |
| transplant | 2.71 [1.59, 4.49] | 970 | 2.83 [2.08, 3.83] | 1933 | 2.83 [2.17, 3.67] | 2903 |
| FU_DM1 | 0.54 [0.26, 1.01] | 970 | 0.19 [0.1, 0.31] | 1933 | 0.26 [0.17, 0.39] | 2903 |
| FU_DM2 | 1.14 [0.76, 1.72] | 970 | 1.4 [1.09, 1.79] | 1933 | 1.31 [1.06, 1.62] | 2903 |
| FU_DM | 0.86 [0.57, 1.3] | 970 | 0.72 [0.56, 0.92] | 1933 | 0.76 [0.61, 0.94] | 2903 |
| FU_atherosclerosis | 1.54 [1.02, 2.33] | 970 | 1.92 [1.47, 2.5] | 1933 | 1.7 [1.36, 2.13] | 2903 |
| FU_stroke | 1.65 [0.8, 3.14] | 970 | 1.88 [1.11, 3.09] | 1933 | 1.7 [1.11, 2.51] | 2903 |
| FU_PAD | 1.25 [0.61, 2.34] | 970 | 1.19 [0.66, 2.02] | 1933 | 1.13 [0.73, 1.7] | 2903 |
| ischemic_heart_disease | 1.22 [0.76, 1.91] | 970 | 2.38 [1.76, 3.19] | 1933 | 1.81 [1.41, 2.31] | 2903 |
| FU_hypertension | 1.64 [0.89, 3.33] | 970 | 2.22 [1.54, 3.28] | 1933 | 2 [1.46, 2.81] | 2903 |
| FU_atrial_fibrillation | 0.97 [0.59, 1.54] | 970 | 2.26 [1.66, 3.05] | 1933 | 1.6 [1.24, 2.05] | 2903 |
| FU_heart_failure | 1.24 [0.77, 1.94] | 970 | 1.76 [1.29, 2.38] | 1933 | 1.48 [1.15, 1.9] | 2903 |
| HF_or_AF | 1.13 [0.73, 1.71] | 970 | 2.15 [1.65, 2.8] | 1933 | 1.67 [1.34, 2.09] | 2903 |
| log2_FU_charlson_index | 1.57 [1.21, 2.06] | 970 | 1.66 [1.42, 1.96] | 1933 | 1.6 [1.4, 1.84] | 2903 |
| charlson_index_5 | 1.49 [0.91, 2.38] | 970 | 2.63 [1.96, 3.53] | 1933 | 2.15 [1.67, 2.75] | 2903 |
| FU_steatosis | 1.54 [0.99, 2.36] | 970 | 1.71 [1.32, 2.21] | 1933 | 1.68 [1.35, 2.1] | 2903 |
5.3.1.2 Visualisation
Open code
unadj_eff_con0 <- unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
BMI10_last = (BMI_last/10)
) %>% dplyr::filter(
consent == 0
),
outcome = "new_cases",
predictors = preds,
family = "logistic",
paste_CI = FALSE
)
unadj_eff_con1 <- unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
BMI10_last = (BMI_last/10)
) %>% dplyr::filter(
consent == 1
),
outcome = "new_cases",
predictors = preds,
family = "logistic",
paste_CI = FALSE
)
unadj_eff_overall <- unadj_effect(
dat = data_ckd %>%
dplyr::mutate(
age_30y = (age/30),
log2_FU_charlson_index = log2(FU_charlson_index + 1),
age_60plus = if_else(age >= 60, 1, 0),
charlson_index_5 = if_else(FU_charlson_index >= 5, 1, 0),
BMI10_last = (BMI_last/10)
),
outcome = "new_cases",
predictors = preds,
family = "logistic",
paste_CI = FALSE
)
df_plot <- bind_rows(
unadj_eff_con1 %>% mutate(consent = "screening"),
unadj_eff_overall %>% mutate(consent = "enriched")
) %>%
mutate(
predictor = recode(
predictor,
"age_30y" = "Age (per 30y)",
"age_60plus" = "Age ≥60y",
"sex_female" = "Female sex",
"BMI10_last" = "BMI (per 10 kg/m²)",
"BMI_over30" = "BMI ≥30 kg/m²",
"transplant" = "Non-renal transplantation",
"FU_DM1" = "T1DM",
"FU_DM2" = "T2DM",
"FU_DM" = "Any diabetes",
"FU_atherosclerosis" = "ASCVD",
"FU_stroke" = "Stroke",
"FU_PAD" = "Peripheral artery disease",
"ischemic_heart_disease" = "Ischemic heart disease",
"FU_hypertension" = "Arterial hypertension",
"FU_atrial_fibrillation" = "Atrial fibrilation",
"FU_heart_failure" = "Heart failure",
"HF_or_AF" = "Heart failure or atrial fibrilation",
"log2_FU_charlson_index" = "log₂ (Charlson index +1)",
"charlson_index_5" = "Charlson index ≥5",
"FU_steatosis" = "Liver steatosis"
),
predictor = factor(predictor, levels = rev(unique(predictor))),
consent = factor(
consent,
levels = c("screening", "enriched", "unscreened"),
labels = c("Screening cohort", "Enriched cohort", "No consent cohort")
)
)
ggplot(df_plot, aes(x = OR, y = predictor, color = consent, group = consent)) +
geom_point(
position = position_dodge(width = 0.6),
size = 2
) +
geom_errorbarh(
aes(xmin = CI_L, xmax = CI_U),
position = position_dodge(width = 0.6),
height = 0.3
) +
geom_vline(xintercept = 1, linetype = "dashed", color = "gray40") +
scale_x_log10(
breaks = c(1 / 4, 1 / 2, 1, 2, 4, 8),
labels = c("1/4", "1/2", "1", "2", "4", "8")
) +
scale_color_manual(
values = c(
"Enriched cohort" = "skyblue3",
"Screening cohort" = "#d95f02",
"No consent cohort" = "#1b9e77"
),
breaks = c(
"Enriched cohort", "Screening cohort", "No consent cohort")
) +
labs(
x = "Unadjusted odds ratio (log2 scale) for new CKD cases",
y = NULL,
color = NULL
) +
theme_minimal(base_size = 12) +
theme(
legend.position = "top",
legend.text = element_text(size = 12),
axis.text.y = element_text(size = 11)
)5.3.2 Simple prevalence model
5.3.2.1 Prior
Open code
prior_intercept <- prior_string(
paste0("student_t(3, ", out_mean, ", 100)"),
class = "Intercept"
)5.3.2.2 Fit simple mdoel
Open code
model_simple_NewCases <- run(
expr = brm(
new_cases ~ +1,
family = bernoulli(link = "logit"),
data = data_ckd,
backend = "cmdstanr",
seed = 736,
prior = prior_intercept,
cores = 1, chains = 2,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_simple_NewCases",
reuse = TRUE
)
prior_summary(model_simple_NewCases)
## Intercept ~ student_t(3, -0.536815474786327, 100)
summary(model_simple_NewCases, robust = TRUE)
## Family: bernoulli
## Links: mu = logit
## Formula: new_cases ~ +1
## Data: data_ckd (Number of observations: 2903)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## Intercept -1.83 0.05 -1.94 -1.72 1.00 2954 2672
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
kableExtra::kable(
inv_logit(fixef(model_simple_NewCases, robust = TRUE)[, c(1, 3,4)])
)| x | |
|---|---|
| Estimate | 0.1387645 |
| Q2.5 | 0.1259105 |
| Q97.5 | 0.1521472 |
5.3.3 Consent-specific
Open code
model_consent_spec_NewCases <- run(
expr = brm(
new_cases ~ consent,
family = bernoulli(link = "logit"),
data = data_ckd,
backend = "cmdstanr",
seed = 736,
cores = 1, chains = 2,
prior = prior_intercept,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_consent_spec_NewCases",
reuse = TRUE
)
prior_summary(model_consent_spec_NewCases)
## prior class coef group resp dpar nlpar
## (flat) b
## (flat) b consent
## student_t(3, -0.536815474786327, 100) Intercept
## lb ub source
## default
## (vectorized)
## user
summary(model_consent_spec_NewCases, robust = TRUE)
## Family: bernoulli
## Links: mu = logit
## Formula: new_cases ~ consent
## Data: data_ckd (Number of observations: 2903)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## Intercept -2.12 0.10 -2.33 -1.93 1.00 6261 5643
## consent 0.42 0.12 0.19 0.66 1.00 6585 5985
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
posterior <- as_draws_df(model_consent_spec_NewCases) %>%
mutate(
consent_prev = inv_logit(b_Intercept + b_consent),
enriched_prev = inv_logit(b_Intercept)
)
tr <- posterior_epred(model_consent_spec_NewCases)
tr2 <- rowMeans(tr)
kableExtra::kable(
data.frame(
rbind(
inv_logit(fixef(model_simple_NewCases, robust = TRUE)[, c(1, 3, 4)]),
quantile(tr2, probs = c(0.5, 0.025, 0.975)),
quantile(posterior$enriched_prev, probs = c(0.5, 0.025, 0.975)),
quantile(posterior$consent_prev, probs = c(0.5, 0.025, 0.975))
)
) %>%
dplyr::mutate(
Estimand = c(
"Marginal prevalence - simple model",
"Marginal prevalence - consent-adj. model",
"Prevalence - consent=0",
"Prevalence - consent=1"
)
) %>% dplyr::select(
Estimand, Estimate, Q2.5, Q97.5
)
)| Estimand | Estimate | Q2.5 | Q97.5 |
|---|---|---|---|
| Marginal prevalence - simple model | 0.1387645 | 0.1259105 | 0.1521472 |
| Marginal prevalence - consent-adj. model | 0.1386792 | 0.1262778 | 0.1515453 |
| Prevalence - consent=0 | 0.1071159 | 0.0889372 | 0.1271120 |
| Prevalence - consent=1 | 0.1543011 | 0.1386203 | 0.1706979 |
5.3.4 Non-linear time model
5.3.4.1 Fit model
Open code
model_time_nl_NewCases <- run(
expr = brm(
new_cases ~
consent +
s(I( (age-62) / 30), by = consent, k = 5),
family = bernoulli(link = "logit"),
data = data_ckd %>% dplyr::mutate(consent = factor(consent)),
backend = "cmdstanr",
seed = 736,
cores = 1, chains = 2,
prior = prior_intercept,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_time_nl_NewCases",
reuse = TRUE
)
prior_summary(model_time_nl_NewCases)
## prior class
## (flat) b
## (flat) b
## (flat) b
## (flat) b
## student_t(3, -0.536815474786327, 100) Intercept
## student_t(3, 0, 2.5) sds
## student_t(3, 0, 2.5) sds
## coef group resp dpar nlpar lb ub
##
## consent1
## sIageM62D30:consent0_1
## sIageM62D30:consent1_1
##
## 0
## s(I((age - 62)/30), by = consent, k = 5) 0
## source
## default
## (vectorized)
## (vectorized)
## (vectorized)
## user
## default
## (vectorized)
summary(model_time_nl_NewCases, robust = TRUE)
## Warning: There were 6 divergent transitions after warmup. Increasing
## adapt_delta above 0.95 may help. See
## http://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
## Family: bernoulli
## Links: mu = logit
## Formula: new_cases ~ consent + s(I((age - 62)/30), by = consent, k = 5)
## Data: data_ckd %>% dplyr::mutate(consent = factor(consen (Number of observations: 2903)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Smoothing Spline Hyperparameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## sds(sIageM62D30consent0_1) 2.51 1.71 0.21 7.92 1.00 3215
## sds(sIageM62D30consent1_1) 0.86 0.82 0.04 4.05 1.00 3566
## Tail_ESS
## sds(sIageM62D30consent0_1) 2927
## sds(sIageM62D30consent1_1) 3709
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -2.33 0.14 -2.63 -2.08 1.00 6120
## consent1 0.45 0.16 0.15 0.78 1.00 6406
## sIageM62D30:consent0_1 6.42 3.89 0.27 20.01 1.00 3636
## sIageM62D30:consent1_1 5.96 1.37 1.73 9.21 1.00 5087
## Tail_ESS
## Intercept 5096
## consent1 5258
## sIageM62D30:consent0_1 3696
## sIageM62D30:consent1_1 5286
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).5.3.4.2 Get posteriors
Open code
quantile(data_ckd$age, probs = c(0, 0.01, 0.05, 0.25, 0.5, 0.75, 0.95, 0.99))
## 0% 1% 5% 25% 50% 75% 95% 99%
## 19 23 35 53 64 73 82 87
age_seq <- c(
seq(min(data_ckd$age),
max(data_ckd$age),
length.out = 101
),
c(seq(25, 80, by = 5))
)
consent_prop <- mean(data_ckd$consent)
new0 <- data.frame(
age = age_seq,
consent = factor(0, levels = c(0, 1))
)
new1 <- data.frame(
age = age_seq,
consent = factor(1, levels = c(0, 1))
)
p0 <- posterior_epred(model_time_nl_NewCases, newdata = new0)
p1 <- posterior_epred(model_time_nl_NewCases, newdata = new1)
p_overall <- (1 - consent_prop) * p0 + consent_prop * p1
summarize_epred <- function(mat, cohort) {
posterior_summary(mat, robust = TRUE) %>%
as.data.frame() %>%
dplyr::mutate(
cohort = cohort,
age = age_seq
)
}
prediction <- dplyr::bind_rows(
summarize_epred(p1, "screening"),
summarize_epred(p0, "unscreened"),
summarize_epred(p_overall, "enriched")
)
kableExtra::kable(
prediction %>%
dplyr::filter(age %in% seq(25, 80, by = 5))
)| Estimate | Est.Error | Q2.5 | Q97.5 | cohort | age |
|---|---|---|---|---|---|
| 0.0202419 | 0.0082909 | 0.0085697 | 0.0524856 | screening | 25 |
| 0.0257347 | 0.0084732 | 0.0129039 | 0.0512074 | screening | 30 |
| 0.0326906 | 0.0084420 | 0.0190156 | 0.0548281 | screening | 35 |
| 0.0418494 | 0.0085544 | 0.0270657 | 0.0618659 | screening | 40 |
| 0.0537291 | 0.0086050 | 0.0384009 | 0.0729317 | screening | 45 |
| 0.0694402 | 0.0087379 | 0.0535872 | 0.0878294 | screening | 50 |
| 0.0899914 | 0.0089968 | 0.0734910 | 0.1089792 | screening | 55 |
| 0.1164288 | 0.0094851 | 0.0985712 | 0.1359617 | screening | 60 |
| 0.1496520 | 0.0100097 | 0.1305322 | 0.1703984 | screening | 65 |
| 0.1906415 | 0.0113194 | 0.1688876 | 0.2144589 | screening | 70 |
| 0.2405097 | 0.0142195 | 0.2126926 | 0.2704252 | screening | 75 |
| 0.2994392 | 0.0209316 | 0.2589380 | 0.3431461 | screening | 80 |
| 0.0065577 | 0.0075411 | 0.0001499 | 0.0370707 | unscreened | 25 |
| 0.0101339 | 0.0097013 | 0.0006326 | 0.0408013 | unscreened | 30 |
| 0.0160762 | 0.0116434 | 0.0024005 | 0.0464902 | unscreened | 35 |
| 0.0255727 | 0.0129298 | 0.0073067 | 0.0548719 | unscreened | 40 |
| 0.0396887 | 0.0128253 | 0.0185459 | 0.0674184 | unscreened | 45 |
| 0.0586042 | 0.0123144 | 0.0366144 | 0.0861822 | unscreened | 50 |
| 0.0803619 | 0.0138040 | 0.0569201 | 0.1121487 | unscreened | 55 |
| 0.1017884 | 0.0162932 | 0.0749387 | 0.1389018 | unscreened | 60 |
| 0.1191256 | 0.0161941 | 0.0915295 | 0.1543487 | unscreened | 65 |
| 0.1324441 | 0.0154002 | 0.1056547 | 0.1647870 | unscreened | 70 |
| 0.1444904 | 0.0170372 | 0.1124006 | 0.1793657 | unscreened | 75 |
| 0.1574028 | 0.0217559 | 0.1169558 | 0.2029435 | unscreened | 80 |
| 0.0167898 | 0.0067675 | 0.0075203 | 0.0395816 | enriched | 25 |
| 0.0214828 | 0.0068819 | 0.0112098 | 0.0398854 | enriched | 30 |
| 0.0278649 | 0.0069765 | 0.0166355 | 0.0441684 | enriched | 35 |
| 0.0367707 | 0.0071335 | 0.0245917 | 0.0524793 | enriched | 40 |
| 0.0492582 | 0.0071184 | 0.0365372 | 0.0644342 | enriched | 45 |
| 0.0660810 | 0.0072141 | 0.0529447 | 0.0809977 | enriched | 50 |
| 0.0871356 | 0.0075631 | 0.0730905 | 0.1030805 | enriched | 55 |
| 0.1118559 | 0.0083228 | 0.0962999 | 0.1288570 | enriched | 60 |
| 0.1396911 | 0.0086741 | 0.1233808 | 0.1575977 | enriched | 65 |
| 0.1713035 | 0.0092133 | 0.1540076 | 0.1900802 | enriched | 70 |
| 0.2085587 | 0.0112963 | 0.1869058 | 0.2316577 | enriched | 75 |
| 0.2522978 | 0.0160150 | 0.2221104 | 0.2846668 | enriched | 80 |
5.3.4.3 Visualisation
Open code
prediction %>%
dplyr::filter(cohort != 'unscreened') %>%
ggplot(
aes(
x = age,
y = Estimate,
color = cohort,
fill = cohort
)
) +
geom_line(linewidth = 1) +
geom_ribbon(
aes(
ymin = Q2.5,
ymax = Q97.5
),
alpha = 0.4,
color = NA
) +
scale_y_continuous(
limits = c(0, 1),
breaks = seq(0, 1, by = 0.2)
) +
labs(
x = "Age (years)",
y = "Estimated probability of new CKD case"
) +
scale_color_manual(
values = c(
"unscreened" = "#1b9e77",
"screening" = "#d95f02",
"enriched" = "skyblue3"
),
name = "Cohort"
) +
scale_fill_manual(
values = c(
"unscreened" = "#1b9e77",
"screening" = "#d95f02",
"enriched" = "skyblue3"
),
name = "Cohort"
) +
facet_grid(rows = vars(cohort)) +
theme(
axis.text = element_text(size = 10),
axis.title = element_text(size = 12),
strip.text.x = element_text(size = 12),
legend.position = "none"
)5.3.5 Risk factors model
5.3.5.1 Can age be lienarized?
Open code
m_tr <- mgcv::gam(
new_cases ~
s(age, k = 5) +
transplant * consent +
FU_DM1 * consent +
FU_DM2 * consent +
FU_steatosis * consent +
FU_hypertension * consent +
FU_atherosclerosis * consent +
sex_female* consent +
HF_or_AF * consent,
data = data_ckd,
family = binomial(link = 'logit')
)
summary(m_tr)
##
## Family: binomial
## Link function: logit
##
## Formula:
## new_cases ~ s(age, k = 5) + transplant * consent + FU_DM1 * consent +
## FU_DM2 * consent + FU_steatosis * consent + FU_hypertension *
## consent + FU_atherosclerosis * consent + sex_female * consent +
## HF_or_AF * consent
##
## Parametric coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.21495 0.37850 -5.852 4.86e-09 ***
## transplant 1.08583 0.29608 3.667 0.000245 ***
## consent -0.04562 0.43773 -0.104 0.917004
## FU_DM1 -0.07752 0.38809 -0.200 0.841688
## FU_DM2 -0.20136 0.22988 -0.876 0.381069
## FU_steatosis 0.20524 0.25092 0.818 0.413394
## FU_hypertension -0.18653 0.35870 -0.520 0.603056
## FU_atherosclerosis 0.19519 0.23498 0.831 0.406162
## sex_female -0.07515 0.22407 -0.335 0.737337
## HF_or_AF -0.31088 0.24172 -1.286 0.198399
## transplant:consent 0.01221 0.34328 0.036 0.971623
## consent:FU_DM1 -0.76589 0.48793 -1.570 0.116491
## consent:FU_DM2 -0.05474 0.26966 -0.203 0.839126
## consent:FU_steatosis 0.05080 0.29078 0.175 0.861319
## consent:FU_hypertension 0.29801 0.41365 0.720 0.471255
## consent:FU_atherosclerosis -0.03702 0.28254 -0.131 0.895747
## consent:sex_female 0.30052 0.26251 1.145 0.252303
## consent:HF_or_AF 0.60680 0.28595 2.122 0.033837 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df Chi.sq p-value
## s(age) 1.001 1.002 83.15 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.09 Deviance explained = 10.6%
## UBRE = -0.26701 Scale est. = 1 n = 2903
plot(m_tr)5.3.5.2 Fit
Open code
model_complex_lin_NewCases <- run(
expr = brm(
new_cases ~
I( (age-62) / 30) * consent +
transplant * consent +
FU_DM1 * consent +
FU_DM2 * consent +
FU_steatosis * consent +
FU_hypertension * consent +
FU_atherosclerosis * consent +
HF_or_AF * consent +
sex_female * consent,
family = bernoulli(link = "logit"),
data = data_ckd,
backend = "cmdstanr",
seed = 736,
cores = 1, chains = 2,
prior = priors,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_complex_lin_NewCases",
reuse = TRUE
)
prior_summary(model_complex_lin_NewCases)
## prior class coef group resp dpar
## (flat) b
## normal(0, 5) b consent
## normal(0, 1) b consent:FU_atherosclerosis
## normal(0, 1) b consent:FU_DM1
## normal(0, 1) b consent:FU_DM2
## normal(0, 1) b consent:FU_hypertension
## normal(0, 1) b consent:FU_steatosis
## normal(0, 1) b consent:HF_or_AF
## normal(0, 1) b consent:sex_female
## normal(0, 1) b consent:transplant
## normal(0, 5) b FU_atherosclerosis
## normal(0, 5) b FU_DM1
## normal(0, 5) b FU_DM2
## normal(0, 5) b FU_hypertension
## normal(0, 5) b FU_steatosis
## normal(0, 5) b HF_or_AF
## normal(0, 5) b IageM62D30
## normal(0, 1) b IageM62D30:consent
## normal(0, 5) b sex_female
## normal(0, 5) b transplant
## student_t(3, 0, 100) Intercept
## nlpar lb ub source
## default
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
summary(model_complex_lin_NewCases, robust = TRUE)
## Family: bernoulli
## Links: mu = logit
## Formula: new_cases ~ I((age - 62)/30) * consent + transplant * consent + FU_DM1 * consent + FU_DM2 * consent + FU_steatosis * consent + FU_hypertension * consent + FU_atherosclerosis * consent + HF_or_AF * consent + sex_female * consent
## Data: data_ckd (Number of observations: 2903)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -2.30 0.36 -3.03 -1.62 1.00 7252
## IageM62D30 1.35 0.28 0.80 1.91 1.00 9408
## consent 0.01 0.40 -0.77 0.85 1.00 6970
## transplant 1.06 0.29 0.50 1.60 1.00 8667
## FU_DM1 -0.20 0.38 -1.00 0.47 1.00 8853
## FU_DM2 -0.21 0.23 -0.65 0.22 1.00 8380
## FU_steatosis 0.20 0.24 -0.29 0.66 1.00 7931
## FU_hypertension -0.11 0.34 -0.76 0.59 1.00 7624
## FU_atherosclerosis 0.22 0.23 -0.23 0.67 1.00 9132
## HF_or_AF -0.27 0.23 -0.73 0.19 1.00 8765
## sex_female -0.04 0.22 -0.48 0.38 1.00 10174
## IageM62D30:consent 0.30 0.33 -0.36 0.96 1.00 9674
## consent:transplant 0.06 0.33 -0.56 0.71 1.00 8654
## consent:FU_DM1 -0.59 0.44 -1.44 0.32 1.00 9057
## consent:FU_DM2 -0.05 0.26 -0.55 0.45 1.00 8875
## consent:FU_steatosis 0.06 0.27 -0.48 0.62 1.00 8019
## consent:FU_hypertension 0.20 0.39 -0.55 0.95 1.00 7380
## consent:FU_atherosclerosis -0.07 0.27 -0.62 0.46 1.00 8771
## consent:HF_or_AF 0.55 0.28 0.00 1.07 1.00 8996
## consent:sex_female 0.26 0.25 -0.23 0.75 1.00 9967
## Tail_ESS
## Intercept 7628
## IageM62D30 7627
## consent 7127
## transplant 7193
## FU_DM1 6177
## FU_DM2 7492
## FU_steatosis 7478
## FU_hypertension 7394
## FU_atherosclerosis 7505
## HF_or_AF 7525
## sex_female 7562
## IageM62D30:consent 7476
## consent:transplant 7023
## consent:FU_DM1 7324
## consent:FU_DM2 7760
## consent:FU_steatosis 7134
## consent:FU_hypertension 6785
## consent:FU_atherosclerosis 7711
## consent:HF_or_AF 7746
## consent:sex_female 6898
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
exp(fixef(model_complex_lin_NewCases, robust = TRUE))[,c(1, 3, 4)]
## Estimate Q2.5 Q97.5
## Intercept 0.1002002 0.04837004 0.1977952
## IageM62D30 3.8515282 2.22429175 6.7373741
## consent 1.0125783 0.46202380 2.3319069
## transplant 2.8910218 1.65245407 4.9687038
## FU_DM1 0.8160664 0.36895151 1.5985133
## FU_DM2 0.8119784 0.52192525 1.2460778
## FU_steatosis 1.2169144 0.75120440 1.9371695
## FU_hypertension 0.9002579 0.46689408 1.8096271
## FU_atherosclerosis 1.2442426 0.79520682 1.9449195
## HF_or_AF 0.7643572 0.48157314 1.2032922
## sex_female 0.9572437 0.62141756 1.4619454
## IageM62D30:consent 1.3477459 0.69521012 2.6128383
## consent:transplant 1.0647797 0.57081681 2.0393157
## consent:FU_DM1 0.5518459 0.23738927 1.3750468
## consent:FU_DM2 0.9488961 0.57420774 1.5646814
## consent:FU_steatosis 1.0597135 0.62046217 1.8581415
## consent:FU_hypertension 1.2250014 0.57447104 2.5969659
## consent:FU_atherosclerosis 0.9359431 0.54003504 1.5776886
## consent:HF_or_AF 1.7250577 1.00371212 2.9204603
## consent:sex_female 1.2924485 0.79375598 2.12312565.3.5.3 Extract posterior
Open code
consent_prop <- mean(data_ckd$consent)
age_scale <- 25 / 30
post <- posterior::as_draws_df(
model_complex_lin_NewCases
)
b_all <- post %>%
dplyr::select(
dplyr::starts_with("b_")
)
## Warning: Dropping 'draws_df' class as required metadata was removed.
base <- b_all %>%
dplyr::transmute(
Intercept = b_Intercept,
age_25y = b_IageM62D30 * age_scale,
sex_female = b_sex_female,
transplant = b_transplant,
FU_DM1 = b_FU_DM1,
FU_DM2 = b_FU_DM2,
FU_steatosis = b_FU_steatosis,
FU_hypertension = b_FU_hypertension,
FU_atherosclerosis = b_FU_atherosclerosis,
HF_or_AF = b_HF_or_AF
)
eff_consent0 <- base
eff_consent1 <- base %>%
dplyr::mutate(
Intercept = Intercept + b_all$b_consent,
age_25y = age_25y + b_all$`b_IageM62D30:consent` * age_scale,
transplant = transplant + b_all$`b_consent:transplant`,
FU_DM1 = FU_DM1 + b_all$`b_consent:FU_DM1`,
FU_DM2 = FU_DM2 + b_all$`b_consent:FU_DM2`,
FU_steatosis = FU_steatosis + b_all$`b_consent:FU_steatosis`,
FU_hypertension = FU_hypertension + b_all$`b_consent:FU_hypertension`,
FU_atherosclerosis = FU_atherosclerosis + b_all$`b_consent:FU_atherosclerosis`,
HF_or_AF = HF_or_AF + b_all$`b_consent:HF_or_AF`,
sex_female = sex_female + b_all$`b_consent:sex_female`
)
eff_consent_mean <- base %>%
dplyr::mutate(
Intercept = Intercept + b_all$b_consent * consent_prop,
age_25y = age_25y + b_all$`b_IageM62D30:consent` * consent_prop * age_scale,
transplant = transplant + b_all$`b_consent:transplant` * consent_prop,
FU_DM1 = FU_DM1 + b_all$`b_consent:FU_DM1` * consent_prop,
FU_DM2 = FU_DM2 + b_all$`b_consent:FU_DM2` * consent_prop,
FU_steatosis = FU_steatosis + b_all$`b_consent:FU_steatosis` * consent_prop,
FU_hypertension = FU_hypertension + b_all$`b_consent:FU_hypertension` * consent_prop,
FU_atherosclerosis = FU_atherosclerosis + b_all$`b_consent:FU_atherosclerosis` * consent_prop,
HF_or_AF = HF_or_AF + b_all$`b_consent:HF_or_AF` * consent_prop,
sex_female = sex_female + b_all$`b_consent:sex_female` * consent_prop
)
data_dm_ref <- data_ckd %>%
dplyr::mutate(
FU_DM1 = 0,
FU_DM2 = 0
)
p0_dm <- brms::posterior_epred(
model_complex_lin_NewCases,
newdata = data_dm_ref
) %>%
rowMeans()
odds0_dm <- p0_dm / (1 - p0_dm)
data_dm1 <- data_ckd %>%
dplyr::mutate(
FU_DM1 = 1,
FU_DM2 = 0
)
p1_dm1 <- brms::posterior_epred(
model_complex_lin_NewCases,
newdata = data_dm1
) %>%
rowMeans()
odds1_dm1 <- p1_dm1 / (1 - p1_dm1)
data_dm2 <- data_ckd %>%
dplyr::mutate(
FU_DM1 = 0,
FU_DM2 = 1
)
p1_dm2 <- brms::posterior_epred(
model_complex_lin_NewCases,
newdata = data_dm2
) %>%
rowMeans()
odds1_dm2 <- p1_dm2 / (1 - p1_dm2)
log_or_dm1_marg <- log(odds1_dm1 / odds0_dm)
log_or_dm2_marg <- log(odds1_dm2 / odds0_dm)
eff_marginal <- dplyr::tibble(
age_25y = calc_marg_log_or(
model_complex_lin_NewCases,
data_ckd,
"age",
75,
50
),
sex_female = calc_marg_log_or(
model_complex_lin_NewCases,
data_ckd,
"sex_female",
1,
0
),
transplant = calc_marg_log_or(
model_complex_lin_NewCases,
data_ckd,
"transplant",
1,
0
),
FU_DM1 = log_or_dm1_marg,
FU_DM2 = log_or_dm2_marg,
FU_steatosis = calc_marg_log_or(
model_complex_lin_NewCases,
data_ckd,
"FU_steatosis",
1,
0
),
FU_hypertension = calc_marg_log_or(
model_complex_lin_NewCases,
data_ckd,
"FU_hypertension",
1,
0
),
FU_atherosclerosis = calc_marg_log_or(
model_complex_lin_NewCases,
data_ckd,
"FU_atherosclerosis",
1,
0
),
HF_or_AF = calc_marg_log_or(
model_complex_lin_NewCases,
data_ckd,
"HF_or_AF",
1,
0
)
)
summ <- dplyr::bind_rows(
posterior::summarise_draws(
eff_consent0,
median,
~ quantile(.x, c(0.025, 0.975))
) %>%
dplyr::mutate(
cohort = "unscreened"
),
posterior::summarise_draws(
eff_consent1,
median,
~ quantile(.x, c(0.025, 0.975))
) %>%
dplyr::mutate(
cohort = "screening"
),
posterior::summarise_draws(
eff_consent_mean,
median,
~ quantile(.x, c(0.025, 0.975))
) %>%
dplyr::mutate(
cohort = "enriched_std_cond"
),
posterior::summarise_draws(
eff_marginal,
median,
~ quantile(.x, c(0.025, 0.975))
) %>%
dplyr::mutate(
cohort = "enriched_marginal"
)
) %>%
dplyr::rename(
predictor = variable,
CI_L = `2.5%`,
CI_U = `97.5%`
) %>%
dplyr::mutate(
OR = exp(median),
CI_L = exp(CI_L),
CI_U = exp(CI_U)
)
data_forest <- summ %>%
dplyr::filter(
predictor != "Intercept"
) %>%
dplyr::mutate(
predictor = factor(
predictor,
levels = rev(
unique(
predictor
)
)
)
)
tab_ready <- summ %>%
dplyr::filter(
predictor != "Intercept"
) %>%
dplyr::mutate(
label = sprintf(
"%.2f [%.2f, %.2f]",
OR,
CI_L,
CI_U
)
) %>%
dplyr::select(
cohort,
predictor,
label
)
tab_wide <- tab_ready %>%
tidyr::pivot_wider(
names_from = cohort,
values_from = label
) %>%
dplyr::arrange(
predictor
)
kableExtra::kable(tab_wide, caption = "Associations between clinical factors and newly diagnosed CKD from the multivariable Bayesian logistic regression model. Odds ratios (ORs) are shown with 95% credible intervals. For screened and unscreened patients, ORs are conditional estimates from the interaction model. For the Enriched cohort, two summary measures are presented: the population-average conditional OR, calculated as the weighted average of screened- and unscreened-specific log-ORs using their observed proportions in the cohort, and the marginal OR, obtained by posterior standardisation of predicted probabilities across all patients in the Enriched cohort. Age effects are expressed for a 25-year difference; the marginal age OR compares 75 versus 50 years.")| predictor | unscreened | screening | enriched_std_cond | enriched_marginal |
|---|---|---|---|---|
| FU_DM1 | 0.82 [0.37, 1.60] | 0.45 [0.25, 0.77] | 0.55 [0.34, 0.86] | 0.57 [0.36, 0.87] |
| FU_DM2 | 0.81 [0.52, 1.25] | 0.77 [0.58, 1.02] | 0.78 [0.61, 1.00] | 0.80 [0.64, 0.99] |
| FU_atherosclerosis | 1.24 [0.80, 1.94] | 1.16 [0.84, 1.58] | 1.18 [0.91, 1.55] | 1.16 [0.92, 1.48] |
| FU_hypertension | 0.90 [0.47, 1.81] | 1.10 [0.74, 1.67] | 1.03 [0.72, 1.50] | 1.03 [0.75, 1.44] |
| FU_steatosis | 1.22 [0.75, 1.94] | 1.30 [0.97, 1.71] | 1.27 [0.99, 1.62] | 1.25 [1.00, 1.55] |
| HF_or_AF | 0.76 [0.48, 1.20] | 1.32 [0.97, 1.77] | 1.10 [0.85, 1.41] | 1.12 [0.89, 1.41] |
| age_25y | 3.08 [1.95, 4.90] | 3.94 [2.85, 5.55] | 3.63 [2.76, 4.82] | 3.43 [2.64, 4.49] |
| sex_female | 0.96 [0.62, 1.46] | 1.24 [0.95, 1.63] | 1.14 [0.90, 1.43] | 1.14 [0.92, 1.40] |
| transplant | 2.89 [1.65, 4.97] | 3.08 [2.18, 4.33] | 3.01 [2.23, 4.05] | 2.73 [2.09, 3.53] |
5.3.5.4 Visualisation, screening + enriched conditional
Open code
data_forest %>%
dplyr::filter(
cohort != "unscreened",
cohort != "enriched_marginal"
) %>%
dplyr::mutate(
predictor = dplyr::recode(
predictor,
"age_25y" = "Age (per 25y)",
"transplant" = "Non-renal transplantation",
"FU_DM1" = "T1DM",
"FU_DM2" = "T2DM",
"FU_hypertension" = "Arterial hypertension",
"HF_or_AF" = "Heart failure or atrial fibrillation",
"FU_atherosclerosis" = "ASCVD",
"FU_steatosis" = "Liver steatosis",
"sex_female" = "Female"
),
predictor = factor(
predictor,
levels = rev(
unique(
predictor
)
)
),
cohort = factor(
cohort,
levels = c(
"unscreened",
"screening",
"enriched_std_cond",
"enriched_marginal"
),
labels = c(
"Unscreened patients",
"Screening cohort",
"Enriched cohort (conditional)",
"Enriched cohort (marginal)"
)
)
) %>%
ggplot2::ggplot(
ggplot2::aes(
x = OR,
y = predictor,
color = cohort
)
) +
ggplot2::geom_point(
position = ggplot2::position_dodge(width = 0.6),
size = 2
) +
ggplot2::geom_errorbarh(
ggplot2::aes(
xmin = CI_L,
xmax = CI_U
),
position = ggplot2::position_dodge(width = 0.6),
height = 0.3
) +
ggplot2::geom_vline(
xintercept = 1,
linetype = "dashed",
color = "gray40"
) +
ggplot2::scale_x_log10(
breaks = c(1 / 4, 1 / 2, 1, 2, 4, 8),
labels = c("1/4", "1/2", "1", "2", "4", "8")
) +
ggplot2::scale_color_manual(
values = c(
"Unscreened patients" = "#1b9e77",
"Screening cohort" = "#d95f02",
"Enriched cohort (conditional)" = "skyblue3",
"Enriched cohort (marginal)" = "#984ea3"
)
) +
ggplot2::labs(
x = "Adjusted odds ratio (log scale) for newly diagnosed CKD",
y = NULL,
color = NULL
) +
ggplot2::guides(
color = ggplot2::guide_legend(
nrow = 1
)
) +
ggplot2::theme_minimal(
base_size = 12
) +
ggplot2::theme(
legend.position = "top",
axis.text.y = ggplot2::element_text(size = 11),
legend.text = ggplot2::element_text(size = 10)
)5.3.5.5 Visualisation, all
Open code
plotac <- "suppl_fig_5"
path <- "gitignore/figures"
fig <- data_forest %>%
dplyr::mutate(
predictor = dplyr::recode(
predictor,
"age_25y" = "Age (per 25y)",
"transplant" = "Non-renal transplantation",
"FU_DM1" = "T1DM",
"FU_DM2" = "T2DM",
"FU_hypertension" = "Arterial hypertension",
"HF_or_AF" = "Heart failure or atrial fibrillation",
"FU_atherosclerosis" = "ASCVD",
"FU_steatosis" = "Liver steatosis",
"sex_female" = "Female"
),
predictor = factor(
predictor,
levels = rev(
unique(
predictor
)
)
),
cohort = factor(
cohort,
levels = c(
"unscreened",
"screening",
"enriched_std_cond",
"enriched_marginal"
),
labels = c(
"Unscreened patients",
"Screening cohort",
"Enriched cohort (conditional)",
"Enriched cohort (marginal)"
)
)
) %>%
ggplot2::ggplot(
ggplot2::aes(
x = OR,
y = predictor,
color = cohort
)
) +
ggplot2::geom_point(
position = ggplot2::position_dodge(width = 0.6),
size = 2
) +
ggplot2::geom_errorbarh(
ggplot2::aes(
xmin = CI_L,
xmax = CI_U
),
position = ggplot2::position_dodge(width = 0.6),
height = 0.3
) +
ggplot2::geom_vline(
xintercept = 1,
linetype = "dashed",
color = "gray40"
) +
ggplot2::scale_x_log10(
breaks = c(1 / 4, 1 / 2, 1, 2, 4, 8),
labels = c("1/4", "1/2", "1", "2", "4", "8")
) +
ggplot2::scale_color_manual(
values = c(
"Unscreened patients" = "#1b9e77",
"Screening cohort" = "#d95f02",
"Enriched cohort (conditional)" = "skyblue3",
"Enriched cohort (marginal)" = "#984ea3"
)
) +
ggplot2::labs(
x = "Adjusted odds ratio (log scale) for newly diagnosed CKD",
y = NULL,
color = NULL
) +
ggplot2::guides(
color = ggplot2::guide_legend(
nrow = 2
)
) +
ggplot2::theme_minimal(
base_size = 12
) +
ggplot2::theme(
legend.position = "top",
axis.text.y = ggplot2::element_text(size = 11),
legend.text = ggplot2::element_text(size = 10)
)
figOpen code
if (!dir.exists(path)) {
dir.create(path, recursive = TRUE)
}
if (!file.exists(file.path(path, paste0(plotac, ".pdf")))) {
ggplot2::ggsave(
filename = paste0(plotac, ".pdf"),
plot = fig,
path = path,
device = "pdf",
width = 6.5,
height = 5
)
}5.3.5.6 Sensitivity analysis
Fit model
Open code
model_sens_lin_NewCases <- run(
expr = brm(
new_cases ~
s(I( (age-62) / 30), by = consent, k = 5) +
transplant * consent +
FU_DM1 * consent +
FU_DM2 * consent +
sex_female * consent +
FU_steatosis * consent +
FU_hypertension * consent +
FU_atherosclerosis * consent +
HF_or_AF * consent +
BMI_over30 * consent,
data = data_ckd |>
dplyr::filter(!is.na(BMI_over30)) |>
dplyr::mutate(consent = factor(consent)),
family = bernoulli(link = "logit"),
backend = "cmdstanr",
seed = 736,
cores = 1, chains = 2,
prior = priors_sens,
iter = 7000, warmup = 2000,
control = list(adapt_delta = 0.95)
),
path = "gitignore/run/model_sens_lin_NewCases",
reuse = TRUE
)
prior_summary(model_sens_lin_NewCases )
## prior class coef group
## (flat) b
## normal(0, 5) b BMI_over30
## normal(0, 5) b consent1
## normal(0, 1) b consent1:BMI_over30
## normal(0, 1) b consent1:FU_atherosclerosis
## normal(0, 1) b consent1:FU_DM1
## normal(0, 1) b consent1:FU_DM2
## normal(0, 1) b consent1:FU_hypertension
## normal(0, 1) b consent1:FU_steatosis
## normal(0, 1) b consent1:HF_or_AF
## normal(0, 1) b consent1:sex_female
## normal(0, 5) b FU_atherosclerosis
## normal(0, 5) b FU_DM1
## normal(0, 5) b FU_DM2
## normal(0, 5) b FU_hypertension
## normal(0, 5) b FU_steatosis
## normal(0, 5) b HF_or_AF
## normal(0, 5) b sex_female
## (flat) b sIageM62D30:consent0_1
## (flat) b sIageM62D30:consent1_1
## normal(0, 5) b transplant
## normal(0, 1) b transplant:consent1
## student_t(3, 0, 100) Intercept
## student_t(3, 0, 2.5) sds
## student_t(3, 0, 2.5) sds s(I((age - 62)/30), by = consent, k = 5)
## resp dpar nlpar lb ub source
## default
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## user
## (vectorized)
## (vectorized)
## user
## user
## user
## 0 default
## 0 (vectorized)
summary(model_sens_lin_NewCases , robust = TRUE)
## Warning: There were 30 divergent transitions after warmup. Increasing
## adapt_delta above 0.95 may help. See
## http://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
## Family: bernoulli
## Links: mu = logit
## Formula: new_cases ~ s(I((age - 62)/30), by = consent, k = 5) + transplant * consent + FU_DM1 * consent + FU_DM2 * consent + sex_female * consent + FU_steatosis * consent + FU_hypertension * consent + FU_atherosclerosis * consent + HF_or_AF * consent + BMI_over30 * consent
## Data: dplyr::mutate(dplyr::filter(data_ckd, !is.na(BMI_o (Number of observations: 2873)
## Draws: 2 chains, each with iter = 7000; warmup = 2000; thin = 1;
## total post-warmup draws = 10000
##
## Smoothing Spline Hyperparameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## sds(sIageM62D30consent0_1) 2.56 1.73 0.19 8.11 1.00 3910
## sds(sIageM62D30consent1_1) 1.13 0.96 0.06 4.61 1.00 5531
## Tail_ESS
## sds(sIageM62D30consent0_1) 3672
## sds(sIageM62D30consent1_1) 5325
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -2.28 0.38 -3.04 -1.58 1.00 6944
## transplant 0.99 0.29 0.42 1.55 1.00 9247
## consent1 -0.02 0.42 -0.82 0.84 1.00 6869
## FU_DM1 -0.20 0.37 -0.97 0.50 1.00 8782
## FU_DM2 -0.15 0.23 -0.60 0.30 1.00 8054
## sex_female -0.03 0.22 -0.46 0.40 1.00 9261
## FU_steatosis 0.23 0.25 -0.25 0.72 1.00 8911
## FU_hypertension -0.04 0.35 -0.68 0.68 1.00 7731
## FU_atherosclerosis 0.22 0.23 -0.23 0.67 1.00 9619
## HF_or_AF -0.23 0.24 -0.70 0.23 1.00 7812
## BMI_over30 -0.55 0.25 -1.05 -0.07 1.00 8330
## transplant:consent1 0.20 0.34 -0.45 0.86 1.00 9247
## consent1:FU_DM1 -0.59 0.44 -1.45 0.30 1.00 9712
## consent1:FU_DM2 -0.14 0.27 -0.67 0.36 1.00 8840
## consent1:sex_female 0.27 0.26 -0.23 0.77 1.00 8904
## consent1:FU_steatosis 0.01 0.28 -0.54 0.57 1.00 8984
## consent1:FU_hypertension 0.07 0.38 -0.73 0.82 1.00 7591
## consent1:FU_atherosclerosis -0.10 0.28 -0.63 0.44 1.00 8901
## consent1:HF_or_AF 0.48 0.28 -0.06 1.03 1.00 8606
## consent1:BMI_over30 0.79 0.28 0.25 1.35 1.00 8488
## sIageM62D30:consent0_1 7.19 4.18 0.92 21.89 1.00 3713
## sIageM62D30:consent1_1 6.11 1.59 1.97 10.33 1.00 7268
## Tail_ESS
## Intercept 5889
## transplant 7628
## consent1 6521
## FU_DM1 6547
## FU_DM2 5780
## sex_female 7595
## FU_steatosis 7526
## FU_hypertension 7163
## FU_atherosclerosis 8358
## HF_or_AF 7840
## BMI_over30 6919
## transplant:consent1 6664
## consent1:FU_DM1 7787
## consent1:FU_DM2 5177
## consent1:sex_female 7468
## consent1:FU_steatosis 7555
## consent1:FU_hypertension 6825
## consent1:FU_atherosclerosis 8005
## consent1:HF_or_AF 7619
## consent1:BMI_over30 5355
## sIageM62D30:consent0_1 3016
## sIageM62D30:consent1_1 6177
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
exp(fixef(model_sens_lin_NewCases , robust = TRUE))[,c(1, 3, 4)]
## Estimate Q2.5 Q97.5
## Intercept 0.1021815 0.04766881 2.067733e-01
## transplant 2.7003827 1.51934189 4.721650e+00
## consent1 0.9848707 0.43875387 2.315468e+00
## FU_DM1 0.8207670 0.37787457 1.656605e+00
## FU_DM2 0.8617751 0.55022324 1.346547e+00
## sex_female 0.9719163 0.62936703 1.495453e+00
## FU_steatosis 1.2603305 0.77728380 2.052013e+00
## FU_hypertension 0.9612028 0.50715580 1.964319e+00
## FU_atherosclerosis 1.2428784 0.79211074 1.953862e+00
## HF_or_AF 0.7950196 0.49535078 1.254376e+00
## BMI_over30 0.5746156 0.34983637 9.283251e-01
## transplant:consent1 1.2252955 0.63472187 2.357283e+00
## consent1:FU_DM1 0.5565048 0.23439079 1.346881e+00
## consent1:FU_DM2 0.8665417 0.51278223 1.434691e+00
## consent1:sex_female 1.3103536 0.79720059 2.164454e+00
## consent1:FU_steatosis 1.0064251 0.58472010 1.762228e+00
## consent1:FU_hypertension 1.0679727 0.48151029 2.273091e+00
## consent1:FU_atherosclerosis 0.9038241 0.53071627 1.558670e+00
## consent1:HF_or_AF 1.6228015 0.93986613 2.795205e+00
## consent1:BMI_over30 2.1996208 1.28632147 3.856951e+00
## sIageM62D30:consent0_1 1331.0321861 2.51058338 3.220862e+09
## sIageM62D30:consent1_1 451.8431020 7.18955659 3.057697e+04Extract posteriors and show results
Open code
dummy_base <- data_ckd_complete[1, ] %>%
dplyr::mutate(
transplant = 0,
FU_DM1 = 0,
FU_DM2 = 0,
sex_female = 0,
FU_steatosis = 0,
FU_hypertension = 0,
FU_atherosclerosis = 0,
HF_or_AF = 0,
BMI_over30 = 0
)
d_c0_a50 <- dummy_base %>%
dplyr::mutate(
consent = factor(0, levels = c("0", "1")),
age = 50
)
d_c0_a75 <- dummy_base %>%
dplyr::mutate(
consent = factor(0, levels = c("0", "1")),
age = 75
)
lin_c0_a50 <- posterior_linpred(
model_sens_lin_NewCases,
newdata = d_c0_a50
)
lin_c0_a75 <- posterior_linpred(
model_sens_lin_NewCases,
newdata = d_c0_a75
)
age_25y_c0 <- as.numeric(lin_c0_a75 - lin_c0_a50)
d_c1_a50 <- dummy_base %>%
dplyr::mutate(
consent = factor(1, levels = c("0", "1")),
age = 50
)
d_c1_a75 <- dummy_base %>%
dplyr::mutate(
consent = factor(1, levels = c("0", "1")),
age = 75
)
lin_c1_a50 <- posterior_linpred(
model_sens_lin_NewCases,
newdata = d_c1_a50
)
lin_c1_a75 <- posterior_linpred(
model_sens_lin_NewCases,
newdata = d_c1_a75
)
age_25y_c1 <- as.numeric(lin_c1_a75 - lin_c1_a50)
post <- as_draws_df(
model_sens_lin_NewCases
)
b_all <- post %>%
dplyr::select(
dplyr::starts_with("b_")
)
## Warning: Dropping 'draws_df' class as required metadata was removed.
eff_consent0 <- dplyr::tibble(
age_25y = age_25y_c0,
sex_female = b_all$b_sex_female,
transplant = b_all$b_transplant,
FU_DM1 = b_all$b_FU_DM1,
FU_DM2 = b_all$b_FU_DM2,
FU_steatosis = b_all$b_FU_steatosis,
FU_hypertension = b_all$b_FU_hypertension,
FU_atherosclerosis = b_all$b_FU_atherosclerosis,
HF_or_AF = b_all$b_HF_or_AF,
BMI_over30 = b_all$b_BMI_over30
)
eff_consent1 <- dplyr::tibble(
age_25y = age_25y_c1,
sex_female = b_all$b_sex_female + b_all$`b_consent1:sex_female`,
transplant = b_all$b_transplant + b_all$`b_transplant:consent1`,
FU_DM1 = b_all$b_FU_DM1 + b_all$`b_consent1:FU_DM1`,
FU_DM2 = b_all$b_FU_DM2 + b_all$`b_consent1:FU_DM2`,
FU_steatosis = b_all$b_FU_steatosis + b_all$`b_consent1:FU_steatosis`,
FU_hypertension = b_all$b_FU_hypertension + b_all$`b_consent1:FU_hypertension`,
FU_atherosclerosis = b_all$b_FU_atherosclerosis + b_all$`b_consent1:FU_atherosclerosis`,
HF_or_AF = b_all$b_HF_or_AF + b_all$`b_consent1:HF_or_AF`,
BMI_over30 = b_all$b_BMI_over30 + b_all$`b_consent1:BMI_over30`
)
eff_consent_mean <- dplyr::tibble(
age_25y = age_25y_c0 * (1 - consent_prop) +
age_25y_c1 * consent_prop,
sex_female = eff_consent0$sex_female * (1 - consent_prop) +
eff_consent1$sex_female * consent_prop,
transplant = eff_consent0$transplant * (1 - consent_prop) +
eff_consent1$transplant * consent_prop,
FU_DM1 = eff_consent0$FU_DM1 * (1 - consent_prop) +
eff_consent1$FU_DM1 * consent_prop,
FU_DM2 = eff_consent0$FU_DM2 * (1 - consent_prop) +
eff_consent1$FU_DM2 * consent_prop,
FU_steatosis = eff_consent0$FU_steatosis * (1 - consent_prop) +
eff_consent1$FU_steatosis * consent_prop,
FU_hypertension = eff_consent0$FU_hypertension * (1 - consent_prop) +
eff_consent1$FU_hypertension * consent_prop,
FU_atherosclerosis = eff_consent0$FU_atherosclerosis * (1 - consent_prop) +
eff_consent1$FU_atherosclerosis * consent_prop,
HF_or_AF = eff_consent0$HF_or_AF * (1 - consent_prop) +
eff_consent1$HF_or_AF * consent_prop,
BMI_over30 = eff_consent0$BMI_over30 * (1 - consent_prop) +
eff_consent1$BMI_over30 * consent_prop
)
calc_marg_log_or <- function(model, data, var_name, val1, val0) {
d1 <- data
d1[[var_name]] <- val1
p1 <- posterior_epred(
model,
newdata = d1
)
p1_marg <- rowMeans(p1)
d0 <- data
d0[[var_name]] <- val0
p0 <- posterior_epred(
model,
newdata = d0
)
p0_marg <- rowMeans(p0)
odds1 <- p1_marg / (1 - p1_marg)
odds0 <- p0_marg / (1 - p0_marg)
marg_or <- odds1 / odds0
return(log(marg_or))
}
data_dm_ref <- data_ckd_complete %>%
dplyr::mutate(
FU_DM1 = 0,
FU_DM2 = 0
)
p0_dm <- posterior_epred(
model_sens_lin_NewCases,
newdata = data_dm_ref
) %>%
rowMeans()
odds0_dm <- p0_dm / (1 - p0_dm)
data_dm1 <- data_ckd_complete %>%
dplyr::mutate(
FU_DM1 = 1,
FU_DM2 = 0
)
p1_dm1 <- posterior_epred(
model_sens_lin_NewCases,
newdata = data_dm1
) %>%
rowMeans()
odds1_dm1 <- p1_dm1 / (1 - p1_dm1)
data_dm2 <- data_ckd_complete %>%
dplyr::mutate(
FU_DM1 = 0,
FU_DM2 = 1
)
p1_dm2 <- posterior_epred(
model_sens_lin_NewCases,
newdata = data_dm2
) %>%
rowMeans()
odds1_dm2 <- p1_dm2 / (1 - p1_dm2)
log_or_dm1_marg <- log(odds1_dm1 / odds0_dm)
log_or_dm2_marg <- log(odds1_dm2 / odds0_dm)
eff_marginal <- dplyr::tibble(
age_25y = calc_marg_log_or(
model_sens_lin_NewCases,
data_ckd_complete,
"age",
75,
50
),
sex_female = calc_marg_log_or(
model_sens_lin_NewCases,
data_ckd_complete,
"sex_female",
1,
0
),
transplant = calc_marg_log_or(
model_sens_lin_NewCases,
data_ckd_complete,
"transplant",
1,
0
),
FU_DM1 = log_or_dm1_marg,
FU_DM2 = log_or_dm2_marg,
FU_steatosis = calc_marg_log_or(
model_sens_lin_NewCases,
data_ckd_complete,
"FU_steatosis",
1,
0
),
FU_hypertension = calc_marg_log_or(
model_sens_lin_NewCases,
data_ckd_complete,
"FU_hypertension",
1,
0
),
FU_atherosclerosis = calc_marg_log_or(
model_sens_lin_NewCases,
data_ckd_complete,
"FU_atherosclerosis",
1,
0
),
HF_or_AF = calc_marg_log_or(
model_sens_lin_NewCases,
data_ckd_complete,
"HF_or_AF",
1,
0
),
BMI_over30 = calc_marg_log_or(
model_sens_lin_NewCases,
data_ckd_complete,
"BMI_over30",
1,
0
)
)
summ <- dplyr::bind_rows(
summarise_draws(
eff_consent0,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "unscreened"
),
summarise_draws(
eff_consent1,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "screening"
),
summarise_draws(
eff_consent_mean,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "enriched_std_cond"
),
summarise_draws(
eff_marginal,
median,
~ quantile(
.x,
c(0.025, 0.975)
)
) %>%
dplyr::mutate(
cohort = "enriched_marginal"
)
) %>%
dplyr::rename(
predictor = variable,
CI_L = `2.5%`,
CI_U = `97.5%`
) %>%
dplyr::mutate(
OR = exp(median),
CI_L = exp(CI_L),
CI_U = exp(CI_U)
)
tab_ready <- summ %>%
dplyr::mutate(
label = sprintf(
"%.2f [%.2f, %.2f]",
OR,
CI_L,
CI_U
)
) %>%
dplyr::select(
cohort,
predictor,
label
)
tab_wide <- tab_ready %>%
tidyr::pivot_wider(
names_from = cohort,
values_from = label
) %>%
dplyr::arrange(
predictor
)
kableExtra::kable(
tab_wide,
caption = "Associations between clinical factors and newly diagnosed CKD cases from the multivariable Bayesian logistic regression model. Odds ratios (ORs) are shown with 95% credible intervals. For screened and unscreened patients, ORs are conditional estimates from the interaction model. For the Enriched cohort, two summary measures are presented: the population-average conditional OR, calculated as the weighted average of screened- and unscreened-specific log-ORs using their observed proportions in the cohort, and the marginal OR, obtained by posterior standardisation of predicted probabilities across all patients in the Enriched cohort. Age effects are expressed for a 25-year difference comparing 75 versus 50 years."
)| predictor | unscreened | screening | enriched_std_cond | enriched_marginal |
|---|---|---|---|---|
| BMI_over30 | 0.57 [0.35, 0.93] | 1.26 [0.95, 1.69] | 0.97 [0.75, 1.25] | 1.03 [0.82, 1.28] |
| FU_DM1 | 0.82 [0.38, 1.66] | 0.46 [0.25, 0.78] | 0.55 [0.33, 0.88] | 0.58 [0.36, 0.88] |
| FU_DM2 | 0.86 [0.55, 1.35] | 0.75 [0.56, 0.99] | 0.78 [0.61, 1.00] | 0.80 [0.64, 0.99] |
| FU_atherosclerosis | 1.24 [0.79, 1.95] | 1.12 [0.82, 1.55] | 1.16 [0.89, 1.51] | 1.14 [0.89, 1.45] |
| FU_hypertension | 0.96 [0.51, 1.96] | 1.03 [0.68, 1.59] | 1.01 [0.70, 1.48] | 1.01 [0.73, 1.42] |
| FU_steatosis | 1.26 [0.78, 2.05] | 1.27 [0.95, 1.70] | 1.26 [0.97, 1.64] | 1.24 [0.98, 1.56] |
| HF_or_AF | 0.80 [0.50, 1.25] | 1.29 [0.95, 1.75] | 1.10 [0.84, 1.41] | 1.12 [0.88, 1.41] |
| age_25y | 2.87 [1.62, 5.16] | 4.19 [2.89, 6.13] | 3.70 [2.71, 5.08] | 3.49 [2.60, 4.71] |
| sex_female | 0.97 [0.63, 1.50] | 1.28 [0.97, 1.68] | 1.16 [0.92, 1.48] | 1.16 [0.94, 1.44] |
| transplant | 2.70 [1.52, 4.72] | 3.29 [2.29, 4.73] | 3.08 [2.24, 4.23] | 2.78 [2.11, 3.64] |
6 Model-projected gain in dialysis-free time
6.1 Propotion of patients taking given drugs from those egligable
Open code
## RAASi
data_ckd %>% filter(FU_RAASi == 1, elig_RAASi_all == 1) %>% nrow() /
data_ckd %>% filter(elig_RAASi_all == 1) %>% nrow()
## [1] 0.7684407
## SGLT2
data_ckd %>% filter(FU_SGLT2 == 1, elig_SGLT2i_total == 1) %>% nrow() /
data_ckd %>% filter(elig_SGLT2i_total == 1) %>% nrow()
## [1] 0.3841121
## Finerenone
data_ckd %>% filter(FU_finerenone == 1, elig_finerenone == 1) %>% nrow() /
data_ckd %>% filter(elig_finerenone == 1) %>% nrow()
## [1] 0.066666676.2 Who are the eligible CKD patients not receiving treatment?
6.2.1 RAASi
Open code
data_ckd %>%
dplyr::filter(
elig_RAASi_all == 1,
identified_CKD_by_lab == 1
) %>%
dplyr::mutate(FU_RAASi = if_else(FU_RAASi == 1, 'user', 'non-user')) %>%
dplyr::select(age, consent, sex, transplant:FU_finerenone,
uACR_value:eGFR_text, CKD_record:new_cases,
elig_RAASi_all:elig_finerenone
) %>%
gtsummary::tbl_summary(by = FU_RAASi) %>%
add_p()
## The following errors were returned during `add_p()`:
## ✖ For variable `elig_RAASi_all` (`FU_RAASi`) and "statistic", "p.value", and
## "parameter" statistics: 'x' and 'y' must have at least 2 levels| Characteristic | non-user N = 2481 |
user N = 8231 |
p-value2 |
|---|---|---|---|
| age | 70 (59, 77) | 72 (62, 77) | 0.13 |
| consent | 155 (63%) | 474 (58%) | 0.2 |
| sex | 0.002 | ||
| F | 125 (50%) | 322 (39%) | |
| M | 123 (50%) | 501 (61%) | |
| transplant | 74 (30%) | 142 (17%) | <0.001 |
| BMI_last | 26.3 (23.4, 29.7) | 29.0 (25.9, 32.3) | <0.001 |
| Unknown | 1 | 5 | |
| FU_stroke | 11 (4.4%) | 73 (8.9%) | 0.023 |
| FU_PAD | 17 (6.9%) | 107 (13%) | 0.008 |
| FU_DM | 129 (52%) | 554 (67%) | <0.001 |
| FU_DM1 | 21 (8.5%) | 99 (12%) | 0.12 |
| FU_DM2 | 108 (44%) | 455 (55%) | 0.001 |
| FU_atherosclerosis | 75 (30%) | 357 (43%) | <0.001 |
| ischemic_heart_disease | 47 (19%) | 264 (32%) | <0.001 |
| FU_steatosis | 91 (37%) | 252 (31%) | 0.072 |
| FU_hypertension | 192 (77%) | 813 (99%) | <0.001 |
| FU_atrial_fibrillation | 54 (22%) | 241 (29%) | 0.020 |
| FU_heart_failure | 48 (19%) | 258 (31%) | <0.001 |
| FU_charlson_index | 3.00 (2.00, 5.00) | 3.00 (2.00, 5.00) | 0.065 |
| FU_GLP1 | 15 (6.0%) | 146 (18%) | <0.001 |
| FU_SGLT2 | 51 (21%) | 335 (41%) | <0.001 |
| FU_finerenone | 1 (0.4%) | 8 (1.0%) | 0.7 |
| uACR_value | 3 (1, 7) | 4 (1, 12) | 0.011 |
| ACR_text | 0.13 | ||
| altered | 127 (51%) | 466 (57%) | |
| normal | 121 (49%) | 357 (43%) | |
| eGFR_value | 0.90 (0.74, 1.11) | 0.86 (0.63, 1.07) | 0.049 |
| eGFR_text | 0.5 | ||
| altered | 172 (69%) | 591 (72%) | |
| normal | 76 (31%) | 232 (28%) | |
| CKD_record | 80 (32%) | 395 (48%) | <0.001 |
| new_cases | 129 (52%) | 274 (33%) | <0.001 |
| elig_RAASi_all | |||
| 1 | 248 (100%) | 823 (100%) | |
| elig_SGLT2i_total | 124 (50%) | 549 (67%) | <0.001 |
| elig_GLP1_RA | 34 (14%) | 230 (28%) | <0.001 |
| elig_finerenone | 2 (0.8%) | 28 (3.4%) | 0.030 |
| 1 Median (Q1, Q3); n (%) | |||
| 2 Wilcoxon rank sum test; Pearson’s Chi-squared test; Fisher’s exact test; NA | |||
6.2.2 SGLT2
Open code
data_ckd %>%
dplyr::filter(
elig_SGLT2i_total == 1,
identified_CKD_by_lab == 1
) %>%
dplyr::mutate(FU_SGLT2 = if_else(FU_SGLT2 == 1, 'user', 'non-user')) %>%
dplyr::select(age, consent, sex, transplant:FU_finerenone,
uACR_value:eGFR_text, CKD_record:new_cases,
elig_RAASi_all:elig_finerenone
) %>%
gtsummary::tbl_summary(by = FU_SGLT2) %>%
add_p()
## The following errors were returned during `add_p()`:
## ✖ For variable `elig_RAASi_all` (`FU_SGLT2`) and "statistic", "p.value", and
## "parameter" statistics: 'x' and 'y' must have at least 2 levels
## ✖ For variable `elig_SGLT2i_total` (`FU_SGLT2`) and "statistic", "p.value", and
## "parameter" statistics: 'x' and 'y' must have at least 2 levels| Characteristic | non-user N = 3561 |
user N = 3171 |
p-value2 |
|---|---|---|---|
| age | 74 (67, 79) | 73 (65, 78) | 0.035 |
| consent | 231 (65%) | 138 (44%) | <0.001 |
| sex | <0.001 | ||
| F | 165 (46%) | 92 (29%) | |
| M | 191 (54%) | 225 (71%) | |
| transplant | 109 (31%) | 44 (14%) | <0.001 |
| BMI_last | 28.4 (25.2, 31.7) | 29.4 (26.2, 33.6) | 0.008 |
| Unknown | 2 | 1 | |
| FU_stroke | 33 (9.3%) | 34 (11%) | 0.5 |
| FU_PAD | 42 (12%) | 60 (19%) | 0.010 |
| FU_DM | 230 (65%) | 255 (80%) | <0.001 |
| FU_DM1 | 4 (1.1%) | 10 (3.2%) | 0.065 |
| FU_DM2 | 226 (63%) | 245 (77%) | <0.001 |
| FU_atherosclerosis | 160 (45%) | 188 (59%) | <0.001 |
| ischemic_heart_disease | 109 (31%) | 152 (48%) | <0.001 |
| FU_steatosis | 137 (38%) | 97 (31%) | 0.032 |
| FU_hypertension | 341 (96%) | 314 (99%) | 0.009 |
| FU_atrial_fibrillation | 102 (29%) | 151 (48%) | <0.001 |
| FU_heart_failure | 132 (37%) | 174 (55%) | <0.001 |
| FU_charlson_index | 4.00 (2.00, 5.50) | 4.00 (3.00, 5.00) | >0.9 |
| FU_GLP1 | 40 (11%) | 76 (24%) | <0.001 |
| FU_RAASi | 271 (76%) | 278 (88%) | <0.001 |
| FU_finerenone | 3 (0.8%) | 5 (1.6%) | 0.5 |
| uACR_value | 2 (0, 7) | 4 (1, 14) | <0.001 |
| ACR_text | 0.002 | ||
| altered | 156 (44%) | 177 (56%) | |
| normal | 200 (56%) | 140 (44%) | |
| eGFR_value | 0.80 (0.63, 0.95) | 0.72 (0.51, 0.95) | 0.064 |
| eGFR_text | 0.055 | ||
| altered | 306 (86%) | 255 (80%) | |
| normal | 50 (14%) | 62 (20%) | |
| CKD_record | 142 (40%) | 195 (62%) | <0.001 |
| new_cases | 151 (42%) | 63 (20%) | <0.001 |
| elig_RAASi_all | |||
| 1 | 356 (100%) | 317 (100%) | |
| elig_SGLT2i_total | |||
| 1 | 356 (100%) | 317 (100%) | |
| elig_GLP1_RA | 94 (26%) | 123 (39%) | <0.001 |
| elig_finerenone | 8 (2.2%) | 22 (6.9%) | 0.003 |
| 1 Median (Q1, Q3); n (%) | |||
| 2 Wilcoxon rank sum test; Pearson’s Chi-squared test; Fisher’s exact test; NA | |||
6.2.3 GLP1_RA
Open code
data_ckd %>%
dplyr::filter(
elig_GLP1_RA == 1,
identified_CKD_by_lab == 1
) %>%
dplyr::mutate(FU_GLP1 = if_else(FU_GLP1 == 1, 'user', 'non-user')) %>%
dplyr::select(age, consent, sex, transplant:FU_finerenone,
uACR_value:eGFR_text, CKD_record:new_cases,
elig_RAASi_all:elig_finerenone
) %>%
gtsummary::tbl_summary(by = FU_GLP1) %>%
add_p()
## The following errors were returned during `add_p()`:
## ✖ For variable `FU_DM` (`FU_GLP1`) and "statistic", "p.value", and "parameter"
## statistics: 'x' and 'y' must have at least 2 levels
## ✖ For variable `FU_DM1` (`FU_GLP1`) and "statistic", "p.value", and "parameter"
## statistics: 'x' and 'y' must have at least 2 levels
## ✖ For variable `FU_DM2` (`FU_GLP1`) and "statistic", "p.value", and "parameter"
## statistics: 'x' and 'y' must have at least 2 levels
## ✖ For variable `elig_GLP1_RA` (`FU_GLP1`) and "statistic", "p.value", and
## "parameter" statistics: 'x' and 'y' must have at least 2 levels
## ✖ For variable `elig_RAASi_all` (`FU_GLP1`) and "statistic", "p.value", and
## "parameter" statistics: 'x' and 'y' must have at least 2 levels| Characteristic | non-user N = 1541 |
user N = 1101 |
p-value2 |
|---|---|---|---|
| age | 73 (67, 78) | 67 (60, 73) | <0.001 |
| consent | 90 (58%) | 69 (63%) | 0.5 |
| sex | 0.3 | ||
| F | 61 (40%) | 36 (33%) | |
| M | 93 (60%) | 74 (67%) | |
| transplant | 31 (20%) | 11 (10%) | 0.027 |
| BMI_last | 33.0 (31.4, 35.0) | 34.9 (32.0, 37.3) | <0.001 |
| FU_stroke | 17 (11%) | 5 (4.5%) | 0.060 |
| FU_PAD | 19 (12%) | 22 (20%) | 0.090 |
| FU_DM | |||
| 1 | 154 (100%) | 110 (100%) | |
| FU_DM1 | |||
| 0 | 154 (100%) | 110 (100%) | |
| FU_DM2 | |||
| 1 | 154 (100%) | 110 (100%) | |
| FU_atherosclerosis | 80 (52%) | 55 (50%) | 0.8 |
| ischemic_heart_disease | 64 (42%) | 46 (42%) | >0.9 |
| FU_steatosis | 53 (34%) | 40 (36%) | 0.7 |
| FU_hypertension | 151 (98%) | 107 (97%) | 0.7 |
| FU_atrial_fibrillation | 60 (39%) | 30 (27%) | 0.048 |
| FU_heart_failure | 57 (37%) | 29 (26%) | 0.069 |
| FU_charlson_index | 4.00 (3.00, 5.00) | 4.00 (3.00, 6.00) | 0.9 |
| FU_SGLT2 | 72 (47%) | 73 (66%) | 0.002 |
| FU_RAASi | 130 (84%) | 100 (91%) | 0.12 |
| FU_finerenone | 5 (3.2%) | 2 (1.8%) | 0.7 |
| uACR_value | 3 (1, 10) | 6 (2, 20) | 0.003 |
| ACR_text | 0.003 | ||
| altered | 78 (51%) | 76 (69%) | |
| normal | 76 (49%) | 34 (31%) | |
| eGFR_value | 0.82 (0.59, 0.99) | 0.92 (0.64, 1.37) | 0.010 |
| eGFR_text | <0.001 | ||
| altered | 118 (77%) | 63 (57%) | |
| normal | 36 (23%) | 47 (43%) | |
| CKD_record | 71 (46%) | 44 (40%) | 0.3 |
| new_cases | 53 (34%) | 24 (22%) | 0.026 |
| elig_RAASi_all | |||
| 1 | 154 (100%) | 110 (100%) | |
| elig_SGLT2i_total | 137 (89%) | 80 (73%) | <0.001 |
| elig_GLP1_RA | |||
| 1 | 154 (100%) | 110 (100%) | |
| elig_finerenone | 8 (5.2%) | 7 (6.4%) | 0.7 |
| 1 Median (Q1, Q3); n (%) | |||
| 2 Wilcoxon rank sum test; Pearson’s Chi-squared test; NA; Fisher’s exact test | |||
6.2.4 Finerenone
Open code
data_ckd %>%
dplyr::filter(
elig_finerenone == 1,
identified_CKD_by_lab == 1
) %>%
dplyr::mutate(FU_finerenone = if_else(FU_finerenone == 1, 'user', 'non-user')) %>%
dplyr::select(age, consent, sex, transplant:FU_finerenone,
uACR_value:eGFR_text, CKD_record:new_cases,
elig_RAASi_all:elig_finerenone
) %>%
gtsummary::tbl_summary(by = FU_finerenone) %>%
add_p()
## The following errors were returned during `add_p()`:
## ✖ For variable `FU_DM` (`FU_finerenone`) and "estimate", "p.value", "conf.low",
## and "conf.high" statistics: 'x' and 'y' must have at least 2 levels
## ✖ For variable `FU_DM1` (`FU_finerenone`) and "estimate", "p.value",
## "conf.low", and "conf.high" statistics: 'x' and 'y' must have at least 2
## levels
## ✖ For variable `FU_DM2` (`FU_finerenone`) and "estimate", "p.value",
## "conf.low", and "conf.high" statistics: 'x' and 'y' must have at least 2
## levels
## ✖ For variable `FU_hypertension` (`FU_finerenone`) and "estimate", "p.value",
## "conf.low", and "conf.high" statistics: 'x' and 'y' must have at least 2
## levels
## ✖ For variable `elig_RAASi_all` (`FU_finerenone`) and "estimate", "p.value",
## "conf.low", and "conf.high" statistics: 'x' and 'y' must have at least 2
## levels
## ✖ For variable `elig_SGLT2i_total` (`FU_finerenone`) and "estimate", "p.value",
## "conf.low", and "conf.high" statistics: 'x' and 'y' must have at least 2
## levels
## ✖ For variable `elig_finerenone` (`FU_finerenone`) and "estimate", "p.value",
## "conf.low", and "conf.high" statistics: 'x' and 'y' must have at least 2
## levels
## The following warnings were returned during `add_p()`:
## ! For variable `BMI_last` (`FU_finerenone`) and "estimate", "statistic",
## "p.value", "conf.low", and "conf.high" statistics: cannot compute exact
## p-value with ties
## ! For variable `BMI_last` (`FU_finerenone`) and "estimate", "statistic",
## "p.value", "conf.low", and "conf.high" statistics: cannot compute exact
## confidence intervals with ties
## ! For variable `age` (`FU_finerenone`) and "estimate", "statistic", "p.value",
## "conf.low", and "conf.high" statistics: cannot compute exact p-value with
## ties
## ! For variable `age` (`FU_finerenone`) and "estimate", "statistic", "p.value",
## "conf.low", and "conf.high" statistics: cannot compute exact confidence
## intervals with ties
## ! For variable `eGFR_value` (`FU_finerenone`) and "estimate", "statistic",
## "p.value", "conf.low", and "conf.high" statistics: cannot compute exact
## p-value with ties
## ! For variable `eGFR_value` (`FU_finerenone`) and "estimate", "statistic",
## "p.value", "conf.low", and "conf.high" statistics: cannot compute exact
## confidence intervals with ties| Characteristic | non-user N = 281 |
user N = 21 |
p-value2 |
|---|---|---|---|
| age | 72 (68, 76) | 62 (51, 72) | 0.3 |
| consent | 17 (61%) | 2 (100%) | 0.5 |
| sex | 0.5 | ||
| F | 8 (29%) | 1 (50%) | |
| M | 20 (71%) | 1 (50%) | |
| transplant | 4 (14%) | 1 (50%) | 0.3 |
| BMI_last | 29.7 (26.4, 34.5) | 34.0 (33.1, 34.9) | 0.3 |
| Unknown | 2 | 0 | |
| FU_stroke | 2 (7.1%) | 0 (0%) | >0.9 |
| FU_PAD | 9 (32%) | 0 (0%) | >0.9 |
| FU_DM | |||
| 1 | 28 (100%) | 2 (100%) | |
| FU_DM1 | |||
| 0 | 28 (100%) | 2 (100%) | |
| FU_DM2 | |||
| 1 | 28 (100%) | 2 (100%) | |
| FU_atherosclerosis | 18 (64%) | 1 (50%) | >0.9 |
| ischemic_heart_disease | 14 (50%) | 1 (50%) | >0.9 |
| FU_steatosis | 13 (46%) | 1 (50%) | >0.9 |
| FU_hypertension | |||
| 1 | 28 (100%) | 2 (100%) | |
| FU_atrial_fibrillation | 12 (43%) | 0 (0%) | 0.5 |
| FU_heart_failure | 13 (46%) | 1 (50%) | >0.9 |
| FU_charlson_index | 0.2 | ||
| 2 | 3 (11%) | 1 (50%) | |
| 3 | 5 (18%) | 0 (0%) | |
| 4 | 7 (25%) | 0 (0%) | |
| 5 | 4 (14%) | 0 (0%) | |
| 6 | 3 (11%) | 1 (50%) | |
| 7 | 6 (21%) | 0 (0%) | |
| FU_GLP1 | 8 (29%) | 0 (0%) | >0.9 |
| FU_SGLT2 | 20 (71%) | 2 (100%) | >0.9 |
| FU_RAASi | 26 (93%) | 2 (100%) | >0.9 |
| uACR_value | 71 (49, 157) | 378 (73, 684) | 0.3 |
| ACR_text | >0.9 | ||
| altered | 28 (100%) | 2 (100%) | |
| normal | 0 (0%) | 0 (0%) | |
| eGFR_value | 0.69 (0.51, 0.83) | 0.46 (0.45, 0.46) | 0.027 |
| eGFR_text | >0.9 | ||
| altered | 27 (96%) | 2 (100%) | |
| normal | 1 (3.6%) | 0 (0%) | |
| CKD_record | 19 (68%) | 2 (100%) | >0.9 |
| new_cases | 3 (11%) | 0 (0%) | >0.9 |
| elig_RAASi_all | |||
| 1 | 28 (100%) | 2 (100%) | |
| elig_SGLT2i_total | |||
| 1 | 28 (100%) | 2 (100%) | |
| elig_GLP1_RA | 13 (46%) | 2 (100%) | 0.5 |
| elig_finerenone | |||
| 1 | 28 (100%) | 2 (100%) | |
| 1 Median (Q1, Q3); n (%) | |||
| 2 Wilcoxon rank sum test; Fisher’s exact test; NA; Wilcoxon rank sum exact test | |||
6.3 EGFR slopes across treatments
Open code
egfr_slope_plcb <- -3.59
egfr_slope_GLP1 <- egfr_slope_plcb + 1.16
egfr_slope_sglt2 <- -1.67
egfr_slope_finerenone <- -2.66
egfr_slope_sglt2_finerenone <- egfr_slope_plcb -
(egfr_slope_plcb - egfr_slope_sglt2) -
(egfr_slope_plcb - egfr_slope_finerenone)
egfr_slope_plcb
## [1] -3.59
egfr_slope_GLP1
## [1] -2.43
egfr_slope_sglt2
## [1] -1.67
egfr_slope_finerenone
## [1] -2.66
egfr_slope_sglt2_finerenone
## [1] -0.74
sglt2_add <- egfr_slope_sglt2 - egfr_slope_plcb
finerenone_add <- egfr_slope_finerenone - egfr_slope_plcb
GLP1_add <- egfr_slope_GLP1 - egfr_slope_plcb
sglt2_add
## [1] 1.92
finerenone_add
## [1] 0.93
GLP1_add
## [1] 1.166.4 Survival
Impute data with a single stochastic imputation
Open code
if (!file.exists('data/data_survival_imp.rds')) {
vars_no_impute <- c(
"EntryDate", "Sex", "time", "event"
)
bin_vars <- c(
"FU_DM", "FU_hypertension", "FU_steatosis",
"FU_atrial_fibrillation", "FU_heart_failure",
"ischemic_heart_disease", "FU_atherosclerosis_PAD",
"FU_stroke"
)
data_survival[bin_vars] <- lapply(
data_survival[bin_vars],
function(x) factor(x, levels = c(0, 1))
)
meth <- make.method(data_survival)
pred <- make.predictorMatrix(data_survival)
meth[vars_no_impute] <- ""
pred[vars_no_impute, ] <- 0
pred[, vars_no_impute] <- 0
meth[bin_vars] <- "logreg"
imp <- mice(
data_survival,
m = 1,
method = meth,
predictorMatrix = pred,
print = FALSE,
seed = seeding
)
data_survival_imp <- complete(imp, 1)
data_survival_imp[bin_vars] <- lapply(
data_survival_imp[bin_vars],
function(x) as.numeric(as.character(x))
)
saveRDS(data_survival_imp, "data/data_survival_imp.rds")
}
data_survival <- readRDS("data/data_survival_imp.rds")6.4.1 Fit model
Open code
model_surv <- coxph(
Surv(time, event) ~
transplant +
FU_DM +
FU_hypertension +
sex_female +
HF_or_AF +
CKD_record +
FU_atherosclerosis +
FU_steatosis +
pspline(age, df = 5),
data = data_survival
)
anova(model_surv)
## Analysis of Deviance Table
## Cox model: response is Surv(time, event)
## Terms added sequentially (first to last)
##
## loglik Chisq Df Pr(>|Chi|)
## NULL -6871.6
## transplant -6863.6 16.1459 1.0000 5.865e-05 ***
## FU_DM -6855.9 15.4006 1.0000 8.696e-05 ***
## FU_hypertension -6834.8 42.2098 1.0000 8.199e-11 ***
## sex_female -6822.6 24.2626 1.0000 8.406e-07 ***
## HF_or_AF -6784.6 76.0891 1.0000 < 2.2e-16 ***
## CKD_record -6760.8 47.5974 1.0000 5.234e-12 ***
## FU_atherosclerosis -6732.3 56.9068 1.0000 4.570e-14 ***
## FU_steatosis -6730.7 3.2748 1.0000 0.07035 .
## pspline(age, df = 5) -6493.9 473.6501 5.0541 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
sf <- survfit(model_surv, newdata = data_ckd)
pred_cox <- sapply(
1:ncol(sf$surv),
function(i) {
t <- sf$time
s <- sf$surv[, i]
sum(diff(t) * (head(s, -1) + tail(s, -1)) / 2)
}
)
summary(pred_cox)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.719 10.538 17.818 17.846 25.087 34.8236.4.2 Visualise cox
Open code
newdat <- tibble::tibble(
age = c(20, 80, 20, 80),
transplant = c(0, 0, 1, 1),
FU_DM = 0,
FU_hypertension = 0,
sex_female = 0,
HF_or_AF = 0,
CKD_record = 1,
FU_atherosclerosis = 0,
FU_steatosis = 0
)
sf <- survfit(model_surv, newdata = newdat)
plot(sf, col = c("skyblue1", "seagreen3", "pink2", "hotpink2"), lwd = 2,
xlab = "time", ylab = "survival")
legend(
"bottomleft",
legend = c("age 20 noTX", "age 80 no TX", "age 20 TX", "age 80 TX"),
col = c("skyblue1", "seagreen3", "pink2", "hotpink2"),
lwd = 2
)6.4.3 Function to get dialysis-free survival prediction
Open code
sf_patient <- survival::survfit(
model_surv,
newdata = data_ckd
)
surv_horizon <- max(
sf_patient$time,
na.rm = TRUE
)
surv_horizon
## [1] 38.41205
stopifnot(
ncol(sf_patient$surv) == nrow(data_ckd)
)
calc_expected_dialysis_free <- function(sf_object, time_to_RF, horizon) {
tau_all <- pmin(pmax(time_to_RF, 0), horizon)
purrr::map_dbl(seq_along(tau_all), function(i) {
tau <- tau_all[i]
if (is.na(tau)) {
return(NA_real_)
}
idx <- sf_object$time < tau
time_points <- c(0, sf_object$time[idx], tau)
survival_prob <- c(1, sf_object$surv[idx, i])
sum(diff(time_points) * survival_prob)
})
}6.5 Individual eGFR slopes and individual years on dialysis saved
Open code
smallest_possible_egfr <- -0.5
data_ckd <- data_ckd %>%
dplyr::mutate(
eGFR_min_to10 = dplyr::if_else(
eGFR_min > 10,
eGFR_min - 10,
0
)
) %>%
dplyr::mutate(
egfr_slope = pmin(
smallest_possible_egfr,
egfr_slope_plcb +
sglt2_add * FU_SGLT2 +
finerenone_add * FU_finerenone +
GLP1_add * FU_GLP1
),
egfr_slope_potential = pmin(
smallest_possible_egfr,
egfr_slope_plcb +
sglt2_add * pmax(FU_SGLT2, elig_SGLT2i_total) +
finerenone_add * pmax(FU_finerenone, elig_finerenone) +
GLP1_add * pmax(FU_GLP1, elig_GLP1_RA)
),
egfr_slope_pot_SGLT = pmin(
smallest_possible_egfr,
egfr_slope_plcb +
sglt2_add * pmax(FU_SGLT2, elig_SGLT2i_total) +
finerenone_add * FU_finerenone +
GLP1_add * FU_GLP1
),
egfr_slope_pot_GLP = pmin(
smallest_possible_egfr,
egfr_slope_plcb +
sglt2_add * FU_SGLT2 +
finerenone_add * FU_finerenone +
GLP1_add * pmax(FU_GLP1, elig_GLP1_RA)
),
egfr_slope_pot_finerenone = pmin(
smallest_possible_egfr,
egfr_slope_plcb +
sglt2_add * FU_SGLT2 +
finerenone_add * pmax(FU_finerenone, elig_finerenone) +
GLP1_add * FU_GLP1
)
) %>%
dplyr::mutate(
new_SGLT = pmax(elig_SGLT2i_total - FU_SGLT2, 0),
new_GLP = pmax(elig_GLP1_RA - FU_GLP1, 0),
new_Fin = pmax(elig_finerenone - FU_finerenone, 0),
add_new_SGLT = sglt2_add * new_SGLT,
add_new_GLP = GLP1_add * new_GLP,
add_new_Fin = finerenone_add * new_Fin,
max_new_eff = pmax(add_new_SGLT, add_new_GLP, add_new_Fin),
egfr_slope_partialAdd = pmin(
smallest_possible_egfr,
egfr_slope +
if_else(
add_new_SGLT == max_new_eff,
add_new_SGLT,
0.5 * add_new_SGLT
) +
if_else(
add_new_GLP == max_new_eff,
add_new_GLP,
0.5 * add_new_GLP
) +
if_else(
add_new_Fin == max_new_eff,
add_new_Fin,
0.5 * add_new_Fin
)
)
) %>%
dplyr::mutate(
years_to_RF_curr =
eGFR_min_to10 / (-egfr_slope),
years_to_RF_pot =
eGFR_min_to10 / (-egfr_slope_potential),
years_to_RF_partial =
eGFR_min_to10 / (-egfr_slope_partialAdd),
years_to_RF_pot_SGLT =
eGFR_min_to10 / (-egfr_slope_pot_SGLT),
years_to_RF_pot_GLP =
eGFR_min_to10 / (-egfr_slope_pot_GLP),
years_to_RF_pot_fin =
eGFR_min_to10 / (-egfr_slope_pot_finerenone)
) %>%
dplyr::mutate(
years_to_RF_curr =
pmax(years_to_RF_curr, 0),
years_to_RF_pot =
pmax(years_to_RF_pot, 0),
years_to_RF_partial =
pmax(years_to_RF_partial, 0),
years_to_RF_pot_SGLT =
pmax(years_to_RF_pot_SGLT, 0),
years_to_RF_pot_GLP =
pmax(years_to_RF_pot_GLP, 0),
years_to_RF_pot_fin =
pmax(years_to_RF_pot_fin, 0)
) %>%
dplyr::mutate(
DialysisMonthsSaved_byTreat =
(years_to_RF_pot - years_to_RF_curr) * 12,
DialysisMonthsSaved_byTreatPartial =
(years_to_RF_partial - years_to_RF_curr) * 12,
DialysisMonthsSaved_bySGLT =
(years_to_RF_pot_SGLT - years_to_RF_curr) * 12,
DialysisMonthsSaved_byGLP =
(years_to_RF_pot_GLP - years_to_RF_curr) * 12,
DialysisMonthsSaved_byFin =
(years_to_RF_pot_fin - years_to_RF_curr) * 12
)
data_ckd <- data_ckd %>%
dplyr::mutate(
years_to_RF_curr_SurvCorr =
calc_expected_dialysis_free(
sf_patient,
years_to_RF_curr,
surv_horizon
),
years_to_RF_pot_SurvCorr =
calc_expected_dialysis_free(
sf_patient,
years_to_RF_pot,
surv_horizon
),
years_to_RF_partial_SurvCorr =
calc_expected_dialysis_free(
sf_patient,
years_to_RF_partial,
surv_horizon
),
years_to_RF_pot_SGLT_SurvCorr =
calc_expected_dialysis_free(
sf_patient,
years_to_RF_pot_SGLT,
surv_horizon
),
years_to_RF_pot_GLP_SurvCorr =
calc_expected_dialysis_free(
sf_patient,
years_to_RF_pot_GLP,
surv_horizon
),
years_to_RF_pot_fin_SurvCorr =
calc_expected_dialysis_free(
sf_patient,
years_to_RF_pot_fin,
surv_horizon
)
) %>%
dplyr::mutate(
DialysisMonthsSaved_byTreat_SurvCorr =
(years_to_RF_pot_SurvCorr -
years_to_RF_curr_SurvCorr) * 12,
DialysisMonthsSaved_byTreatPartial_SurvCorr =
(years_to_RF_partial_SurvCorr -
years_to_RF_curr_SurvCorr) * 12,
DialysisMonthsSaved_bySGLT_SurvCorr =
(years_to_RF_pot_SGLT_SurvCorr -
years_to_RF_curr_SurvCorr) * 12,
DialysisMonthsSaved_byGLP_SurvCorr =
(years_to_RF_pot_GLP_SurvCorr -
years_to_RF_curr_SurvCorr) * 12,
DialysisMonthsSaved_byFin_SurvCorr =
(years_to_RF_pot_fin_SurvCorr -
years_to_RF_curr_SurvCorr) * 12
)
summary(
data_ckd %>%
dplyr::select(
years_to_RF_curr_SurvCorr,
years_to_RF_pot_SurvCorr,
years_to_RF_partial_SurvCorr,
DialysisMonthsSaved_byTreat_SurvCorr,
DialysisMonthsSaved_byTreatPartial_SurvCorr,
DialysisMonthsSaved_bySGLT_SurvCorr,
DialysisMonthsSaved_byGLP_SurvCorr,
DialysisMonthsSaved_byFin_SurvCorr
)
)
## years_to_RF_curr_SurvCorr years_to_RF_pot_SurvCorr
## Min. : 0.000 Min. : 0.000
## 1st Qu.: 9.151 1st Qu.: 9.718
## Median :13.813 Median :14.519
## Mean :13.952 Mean :14.622
## 3rd Qu.:18.473 3rd Qu.:19.001
## Max. :34.007 Max. :34.007
## years_to_RF_partial_SurvCorr DialysisMonthsSaved_byTreat_SurvCorr
## Min. : 0.000 Min. : 0.00000
## 1st Qu.: 9.707 1st Qu.: 0.00000
## Median :14.518 Median : 0.00000
## Mean :14.620 Mean : 8.04623
## 3rd Qu.:19.001 3rd Qu.: 0.01761
## Max. :34.007 Max. :187.26755
## DialysisMonthsSaved_byTreatPartial_SurvCorr
## Min. : 0.00000
## 1st Qu.: 0.00000
## Median : 0.00000
## Mean : 8.01673
## 3rd Qu.: 0.01761
## Max. :174.97067
## DialysisMonthsSaved_bySGLT_SurvCorr DialysisMonthsSaved_byGLP_SurvCorr
## Min. : 0.000 Min. : 0.0000
## 1st Qu.: 0.000 1st Qu.: 0.0000
## Median : 0.000 Median : 0.0000
## Mean : 7.425 Mean : 0.8018
## 3rd Qu.: 0.000 3rd Qu.: 0.0000
## Max. :158.936 Max. :88.5372
## DialysisMonthsSaved_byFin_SurvCorr
## Min. : 0.00000
## 1st Qu.: 0.00000
## Median : 0.00000
## Mean : 0.07274
## 3rd Qu.: 0.00000
## Max. :49.333266.6 Tabular results
6.6.1 All CKD population
Open code
data_ckd %>%
filter(identified_CKD_by_lab == 1) %>%
select(
sex, age,
FU_RAASi, FU_SGLT2, FU_finerenone, FU_GLP1,
elig_RAASi_all, elig_SGLT2i_total, elig_finerenone, elig_GLP1_RA,
DialysisMonthsSaved_byTreat_SurvCorr,
DialysisMonthsSaved_byTreatPartial_SurvCorr,
DialysisMonthsSaved_bySGLT_SurvCorr,
DialysisMonthsSaved_byGLP_SurvCorr,
DialysisMonthsSaved_byFin_SurvCorr
) %>%
mutate(
across(
where(~ all(na.omit(.) %in% c(0, 1))),
~ factor(., levels = c(0, 1))
)
) %>%
tbl_summary(
type = list(
everything() ~ "continuous",
where(is.factor) ~ "categorical"
),
statistic = list(
all_continuous() ~ "{mean}, [{min}, {max}]",
all_categorical() ~ "{n} ({p}%)"
),
digits = all_continuous() ~ c(2, 2, 2)
) %>%
modify_caption(
'*CKD population identified by laboratory measurements in IKEM. Includes
treatment used ("FU_[...]"), treatment eligibility ("elig_[...]"), and
average [range] dialysis-free months with or without survival correction.*'
)| Characteristic | N = 1,0711 |
|---|---|
| sex | |
| F | 447 (42%) |
| M | 624 (58%) |
| age | 68.35, [22.00, 97.00] |
| FU_RAASi | |
| 0 | 248 (23%) |
| 1 | 823 (77%) |
| FU_SGLT2 | |
| 0 | 685 (64%) |
| 1 | 386 (36%) |
| FU_finerenone | |
| 0 | 1,062 (99%) |
| 1 | 9 (0.8%) |
| FU_GLP1 | |
| 0 | 910 (85%) |
| 1 | 161 (15%) |
| elig_RAASi_all | |
| 0 | 0 (0%) |
| 1 | 1,071 (100%) |
| elig_SGLT2i_total | |
| 0 | 398 (37%) |
| 1 | 673 (63%) |
| elig_finerenone | |
| 0 | 1,041 (97%) |
| 1 | 30 (2.8%) |
| elig_GLP1_RA | |
| 0 | 807 (75%) |
| 1 | 264 (25%) |
| DialysisMonthsSaved_byTreat_SurvCorr | 11.13, [0.00, 187.27] |
| DialysisMonthsSaved_byTreatPartial_SurvCorr | 11.05, [0.00, 174.97] |
| DialysisMonthsSaved_bySGLT_SurvCorr | 9.45, [0.00, 128.93] |
| DialysisMonthsSaved_byGLP_SurvCorr | 2.17, [0.00, 88.54] |
| DialysisMonthsSaved_byFin_SurvCorr | 0.20, [0.00, 49.33] |
| 1 n (%); Mean, [Min, Max] | |
6.6.2 SGLT2-egligable
Open code
data_ckd %>% dplyr::filter(
identified_CKD_by_lab == 1, elig_SGLT2i_total == 1
) %>% select(
sex, age,
FU_RAASi, FU_SGLT2, FU_finerenone, FU_GLP1,
elig_RAASi_all, elig_SGLT2i_total, elig_finerenone, elig_GLP1_RA,
DialysisMonthsSaved_byTreat_SurvCorr,
DialysisMonthsSaved_byTreatPartial_SurvCorr,
DialysisMonthsSaved_bySGLT_SurvCorr
) %>%
mutate(
across(
where(~ all(na.omit(.) %in% c(0, 1))),
~ factor(., levels = c(0, 1))
)
) %>%
tbl_summary(
type = list(
everything() ~ "continuous",
where(is.factor) ~ "categorical"
),
statistic = list(
all_continuous() ~ "{mean}, [{min}, {max}]",
all_categorical() ~ "{n} ({p}%)"
),
digits = all_continuous() ~ c(2, 2, 2)
) %>%
modify_caption('*CKD population **egigable for SGLT2i**. \
Includes treatment used (\"FU_[...]\"), treatment eligibility (\"elig_[...]\"), \
and average [range] dialysis-free months with or without survival correction.*')| Characteristic | N = 6731 |
|---|---|
| sex | |
| F | 257 (38%) |
| M | 416 (62%) |
| age | 71.54, [25.00, 97.00] |
| FU_RAASi | |
| 0 | 124 (18%) |
| 1 | 549 (82%) |
| FU_SGLT2 | |
| 0 | 356 (53%) |
| 1 | 317 (47%) |
| FU_finerenone | |
| 0 | 665 (99%) |
| 1 | 8 (1.2%) |
| FU_GLP1 | |
| 0 | 557 (83%) |
| 1 | 116 (17%) |
| elig_RAASi_all | |
| 0 | 0 (0%) |
| 1 | 673 (100%) |
| elig_SGLT2i_total | |
| 0 | 0 (0%) |
| 1 | 673 (100%) |
| elig_finerenone | |
| 0 | 643 (96%) |
| 1 | 30 (4.5%) |
| elig_GLP1_RA | |
| 0 | 456 (68%) |
| 1 | 217 (32%) |
| DialysisMonthsSaved_byTreat_SurvCorr | 16.94, [0.00, 187.27] |
| DialysisMonthsSaved_byTreatPartial_SurvCorr | 16.81, [0.00, 174.97] |
| DialysisMonthsSaved_bySGLT_SurvCorr | 15.03, [0.00, 128.93] |
| 1 n (%); Mean, [Min, Max] | |
6.6.3 Finerone-egligable
Open code
data_ckd %>% dplyr::filter(
identified_CKD_by_lab == 1, elig_finerenone == 1
) %>% select(
sex, age,
FU_RAASi, FU_SGLT2, FU_finerenone, FU_GLP1,
elig_RAASi_all, elig_SGLT2i_total, elig_finerenone, elig_GLP1_RA,
DialysisMonthsSaved_byTreat_SurvCorr,
DialysisMonthsSaved_byTreatPartial_SurvCorr,
DialysisMonthsSaved_byFin_SurvCorr
) %>%
mutate(
across(
where(~ all(na.omit(.) %in% c(0, 1))),
~ factor(., levels = c(0, 1))
)
) %>%
tbl_summary(
type = list(
everything() ~ "continuous",
where(is.factor) ~ "categorical"
),
statistic = list(
all_continuous() ~ "{mean}, [{min}, {max}]",
all_categorical() ~ "{n} ({p}%)"
),
digits = all_continuous() ~ c(2, 2, 2)
) %>%
modify_caption('*CKD population **eligable for fineranone**. \
Includes treatment used (\"FU_[...]\"), treatment eligibility (\"elig_[...]\"), \
and average [range] dialysis-free months with or without survival correction.*')| Characteristic | N = 301 |
|---|---|
| sex | |
| F | 9 (30%) |
| M | 21 (70%) |
| age | 70.80, [51.00, 87.00] |
| FU_RAASi | |
| 0 | 2 (6.7%) |
| 1 | 28 (93%) |
| FU_SGLT2 | |
| 0 | 8 (27%) |
| 1 | 22 (73%) |
| FU_finerenone | |
| 0 | 28 (93%) |
| 1 | 2 (6.7%) |
| FU_GLP1 | |
| 0 | 22 (73%) |
| 1 | 8 (27%) |
| elig_RAASi_all | |
| 0 | 0 (0%) |
| 1 | 30 (100%) |
| elig_SGLT2i_total | |
| 0 | 0 (0%) |
| 1 | 30 (100%) |
| elig_finerenone | |
| 0 | 0 (0%) |
| 1 | 30 (100%) |
| elig_GLP1_RA | |
| 0 | 15 (50%) |
| 1 | 15 (50%) |
| DialysisMonthsSaved_byTreat_SurvCorr | 11.70, [0.00, 79.89] |
| DialysisMonthsSaved_byTreatPartial_SurvCorr | 11.12, [0.00, 63.64] |
| DialysisMonthsSaved_byFin_SurvCorr | 7.04, [0.00, 49.33] |
| 1 n (%); Mean, [Min, Max] | |
6.6.4 GLP1-RA
Open code
data_ckd %>% dplyr::filter(
identified_CKD_by_lab == 1, elig_GLP1_RA == 1
) %>% select(
sex, age,
FU_RAASi, FU_SGLT2, FU_finerenone, FU_GLP1,
elig_RAASi_all, elig_SGLT2i_total, elig_finerenone, elig_GLP1_RA,
DialysisMonthsSaved_byTreat_SurvCorr,
DialysisMonthsSaved_byTreatPartial_SurvCorr,
DialysisMonthsSaved_byGLP_SurvCorr
) %>%
mutate(
across(
where(~ all(na.omit(.) %in% c(0, 1))),
~ factor(., levels = c(0, 1))
)
) %>%
tbl_summary(
type = list(
everything() ~ "continuous",
where(is.factor) ~ "categorical"
),
statistic = list(
all_continuous() ~ "{mean}, [{min}, {max}]",
all_categorical() ~ "{n} ({p}%)"
),
digits = all_continuous() ~ c(2, 2, 2)
) %>%
modify_caption('*CKD population **eligable for GLP1-RA**. \
Includes treatment used (\"FU_[...]\"), treatment eligibility (\"elig_[...]\"), \
and average [range] dialysis-free months with or without survival correction.*')| Characteristic | N = 2641 |
|---|---|
| sex | |
| F | 97 (37%) |
| M | 167 (63%) |
| age | 68.95, [24.00, 87.00] |
| FU_RAASi | |
| 0 | 34 (13%) |
| 1 | 230 (87%) |
| FU_SGLT2 | |
| 0 | 119 (45%) |
| 1 | 145 (55%) |
| FU_finerenone | |
| 0 | 257 (97%) |
| 1 | 7 (2.7%) |
| FU_GLP1 | |
| 0 | 154 (58%) |
| 1 | 110 (42%) |
| elig_RAASi_all | |
| 0 | 0 (0%) |
| 1 | 264 (100%) |
| elig_SGLT2i_total | |
| 0 | 47 (18%) |
| 1 | 217 (82%) |
| elig_finerenone | |
| 0 | 249 (94%) |
| 1 | 15 (5.7%) |
| elig_GLP1_RA | |
| 0 | 0 (0%) |
| 1 | 264 (100%) |
| DialysisMonthsSaved_byTreat_SurvCorr | 15.50, [0.00, 187.27] |
| DialysisMonthsSaved_byTreatPartial_SurvCorr | 15.24, [0.00, 174.97] |
| DialysisMonthsSaved_byGLP_SurvCorr | 8.82, [0.00, 88.54] |
| 1 n (%); Mean, [Min, Max] | |
6.6.5 Sums
Open code
## all CKD, all treatment together
data_ckd %>%
dplyr::filter(identified_CKD_by_lab == 1) %>%
dplyr::summarise(suma = sum(DialysisMonthsSaved_byTreat_SurvCorr))
## # A tibble: 1 × 1
## suma
## <dbl>
## 1 11920.
## all CKD, partial additivity
data_ckd %>%
dplyr::filter(identified_CKD_by_lab == 1) %>%
dplyr::summarise(suma = sum(DialysisMonthsSaved_byTreatPartial_SurvCorr))
## # A tibble: 1 × 1
## suma
## <dbl>
## 1 11835.
## all CKD, SGLT treatment
data_ckd %>%
dplyr::filter(identified_CKD_by_lab == 1) %>%
dplyr::summarise(suma = sum(DialysisMonthsSaved_bySGLT_SurvCorr))
## # A tibble: 1 × 1
## suma
## <dbl>
## 1 10117.
## SGLT eligible, all treatment
data_ckd %>%
dplyr::filter(identified_CKD_by_lab == 1, elig_SGLT2i_total == 1) %>%
dplyr::summarise(suma = sum(DialysisMonthsSaved_byTreat_SurvCorr))
## # A tibble: 1 × 1
## suma
## <dbl>
## 1 11401.
## SGLT eligible, SGLT treatment
data_ckd %>%
dplyr::filter(identified_CKD_by_lab == 1, elig_SGLT2i_total == 1) %>%
dplyr::summarise(suma = sum(DialysisMonthsSaved_bySGLT_SurvCorr))
## # A tibble: 1 × 1
## suma
## <dbl>
## 1 10117.6.7 Visualisation
6.7.1 Full additivity
Open code
plotac <- "fig_4"
path <- "gitignore/figures"
tr <- data_ckd %>%
filter(identified_CKD_by_lab == 1) %>%
mutate(
projected_gain = factor(
DialysisMonthsSaved_byTreat_SurvCorr > 0
)
) %>%
select(projected_gain)
summary(tr)
## projected_gain
## FALSE:625
## TRUE :446
mean(tr$projected_gain == "TRUE", na.rm = TRUE)
## [1] 0.4164332
p1 <- data_ckd %>%
filter(identified_CKD_by_lab == 1) %>%
mutate(
projected_gain = DialysisMonthsSaved_byTreat_SurvCorr > 0
) %>%
ggplot(
aes(
x = factor(1),
fill = projected_gain
)
) +
geom_bar(position = "fill") +
scale_y_continuous(
labels = scales::percent
) +
scale_fill_manual(
values = c(
`FALSE` = "#F4A8A8",
`TRUE` = "#A8E6A1"
),
labels = c(
`FALSE` = "Not expected",
`TRUE` = "Expected"
)
) +
labs(
x = "",
y = "Proportion of CKD patients",
fill = "Projected gain"
) +
theme(
axis.text.x = element_blank(),
axis.ticks.x = element_blank()
)
p2 <- data_ckd %>%
filter(
identified_CKD_by_lab == 1,
DialysisMonthsSaved_byTreat_SurvCorr > 0
) %>%
ggplot(
aes(
x = DialysisMonthsSaved_byTreat_SurvCorr
)
) +
geom_histogram(
breaks = seq(
0,
max(
data_ckd$DialysisMonthsSaved_byTreat_SurvCorr,
na.rm = TRUE
),
by = 10
),
fill = "#A8E6A1",
color = "#4C8A4A"
) +
labs(
x = "Projected gain in dialysis-free time (months)",
y = "Number of CKD patients"
)
fig <- cowplot::plot_grid(
p1,
p2,
rel_widths = c(0.4, 0.6),
labels = "AUTO"
)
figOpen code
if (!dir.exists(path)) {
dir.create(path, recursive = TRUE)
}
if (!file.exists(file.path(path, paste0(plotac, ".pdf")))) {
ggplot2::ggsave(
filename = paste0(plotac, ".pdf"),
plot = fig,
path = path,
device = "pdf",
width = 7,
height = 4
)
}6.7.2 Partial additivity
Open code
plotac <- "suppl_fig_8"
path <- "gitignore/figures"
p1 <- data_ckd %>%
filter(identified_CKD_by_lab == 1) %>%
mutate(
projected_gain = DialysisMonthsSaved_byTreatPartial_SurvCorr > 0
) %>%
ggplot(
aes(
x = factor(1),
fill = projected_gain
)
) +
geom_bar(position = "fill") +
scale_y_continuous(
labels = scales::percent
) +
scale_fill_manual(
values = c(
`FALSE` = "#F4A8A8",
`TRUE` = "#A8E6A1"
),
labels = c(
`FALSE` = "Not expected",
`TRUE` = "Expected"
)
) +
labs(
x = "",
y = "Proportion of CKD patients",
fill = "Projected gain"
) +
theme(
axis.text.x = element_blank(),
axis.ticks.x = element_blank()
)
p2 <- data_ckd %>%
filter(
identified_CKD_by_lab == 1,
DialysisMonthsSaved_byTreatPartial_SurvCorr > 0
) %>%
ggplot(
aes(
x = DialysisMonthsSaved_byTreatPartial_SurvCorr
)
) +
geom_histogram(
breaks = seq(
0,
max(
data_ckd$DialysisMonthsSaved_byTreatPartial_SurvCorr,
na.rm = TRUE
),
by = 10
),
fill = "#A8E6A1",
color = "#4C8A4A"
) +
labs(
x = "Projected gain in dialysis-free time (months)",
y = "Number of CKD patients"
)
fig <- cowplot::plot_grid(
p1,
p2,
rel_widths = c(0.4, 0.6),
labels = "AUTO"
)
figOpen code
if (!dir.exists(path)) {
dir.create(path, recursive = TRUE)
}
if (!file.exists(file.path(path, paste0(plotac, ".pdf")))) {
ggplot2::ggsave(
filename = paste0(plotac, ".pdf"),
plot = fig,
path = path,
device = "pdf",
width = 7,
height = 4
)
}7 Reproducibility
Open code
sessionInfo()
## R version 4.4.3 (2025-02-28)
## Platform: x86_64-pc-linux-gnu
## Running under: Ubuntu 22.04.5 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.10.0
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.10.0
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=cs_CZ.UTF-8 LC_COLLATE=en_US.UTF-8
## [5] LC_MONETARY=cs_CZ.UTF-8 LC_MESSAGES=en_US.UTF-8
## [7] LC_PAPER=cs_CZ.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=cs_CZ.UTF-8 LC_IDENTIFICATION=C
##
## time zone: Europe/Prague
## tzcode source: system (glibc)
##
## attached base packages:
## [1] parallel stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] scales_1.3.0 ComplexUpset_1.3.3 UpSetR_1.4.0 survival_3.7-0
## [5] pROC_1.18.0 arm_1.12-2 lme4_1.1-35.5 Matrix_1.7-0
## [9] MASS_7.3-65 car_3.1-2 carData_3.0-5 emmeans_1.10.4
## [13] brms_2.21.0 Rcpp_1.1.0 rmsb_1.1-1 rms_6.8-1
## [17] Hmisc_5.1-3 glmmTMB_1.1.9 ggdist_3.3.2 cowplot_1.1.1
## [21] ggpubr_0.4.0 sjPlot_2.8.16 kableExtra_1.4.0 flextable_0.9.6
## [25] gtsummary_2.4.0 janitor_2.2.0 stringi_1.8.7 lubridate_1.9.4
## [29] posterior_1.6.0 forcats_1.0.0 stringr_1.5.1 dplyr_1.1.4
## [33] purrr_1.0.4 readr_2.1.5 tidyr_1.3.1 tibble_3.3.0
## [37] ggplot2_3.5.1 tidyverse_1.3.1 readxl_1.3.1 RJDBC_0.2-10
## [41] rJava_1.0-11 DBI_1.2.3 rstudioapi_0.16.0
##
## loaded via a namespace (and not attached):
## [1] splines_4.4.3 later_1.4.7 polspline_1.1.25
## [4] cellranger_1.1.0 datawizard_0.12.2 reprex_2.0.1
## [7] rpart_4.1.24 lifecycle_1.0.4 rstatix_0.7.0
## [10] StanHeaders_2.32.10 processx_3.8.6 lattice_0.22-5
## [13] insight_1.5.2 backports_1.5.0 magrittr_2.0.4
## [16] sass_0.4.9 rmarkdown_2.27 yaml_2.3.10
## [19] httpuv_1.6.5 otel_0.2.0 skimr_2.1.5
## [22] zip_2.2.0 askpass_1.1 pkgbuild_1.4.8
## [25] minqa_1.2.4 multcomp_1.4-18 abind_1.4-5
## [28] rvest_1.0.2 nnet_7.3-20 TH.data_1.1-0
## [31] tensorA_0.36.2.1 sandwich_3.0-1 gdtools_0.3.7
## [34] inline_0.3.19 crul_1.5.0 cards_0.7.0
## [37] MatrixModels_0.5-3 performance_0.12.2 cardx_0.3.0
## [40] bridgesampling_1.1-2 commonmark_1.9.1 svglite_2.1.3
## [43] codetools_0.2-19 xml2_1.4.1 tidyselect_1.2.1
## [46] farver_2.1.0 bayesplot_1.8.1 ggeffects_1.7.0
## [49] httpcode_0.3.0 matrixStats_1.3.0 stats4_4.4.3
## [52] base64enc_0.1-3 jsonlite_2.0.0 Formula_1.2-4
## [55] ggridges_0.5.3 systemfonts_1.0.4 tools_4.4.3
## [58] ragg_1.4.0 glue_1.8.0 gridExtra_2.3
## [61] xfun_0.52 mgcv_1.9-1 cmdstanr_0.8.0.9000
## [64] distributional_0.4.0 loo_2.4.1 withr_3.0.2
## [67] numDeriv_2016.8-1.1 fastmap_1.2.0 boot_1.3-31
## [70] SparseM_1.81 openssl_1.4.6 digest_0.6.37
## [73] timechange_0.3.0 R6_2.6.1 mime_0.12
## [76] estimability_1.5.1 textshaping_0.3.6 colorspace_2.0-2
## [79] markdown_1.13 generics_0.1.4 fontLiberation_0.1.0
## [82] data.table_1.18.4 httr_1.4.2 htmlwidgets_1.6.4
## [85] pkgconfig_2.0.3 gtable_0.3.0 htmltools_0.5.8.1
## [88] fontBitstreamVera_0.1.1 TMB_1.9.14 corrplot_0.92
## [91] snakecase_0.11.1 knitr_1.50 reshape2_1.4.4
## [94] tzdb_0.5.0 uuid_1.0-3 coda_0.19-4.1
## [97] checkmate_2.3.2 nlme_3.1-168 curl_6.4.0
## [100] nloptr_2.0.0 repr_1.1.7 zoo_1.8-9
## [103] sjlabelled_1.2.0 foreign_0.8-90 pillar_1.11.0
## [106] grid_4.4.3 vctrs_0.6.5 promises_1.5.0
## [109] dbplyr_2.1.1 xtable_1.8-4 cluster_2.1.8.1
## [112] htmlTable_2.4.0 evaluate_1.0.5 mvtnorm_1.1-3
## [115] cli_3.6.5 compiler_4.4.3 rlang_1.1.6
## [118] crayon_1.5.3 rstantools_2.1.1 ggsignif_0.6.3
## [121] labeling_0.4.2 modelr_0.1.8 ps_1.9.1
## [124] plyr_1.8.6 sjmisc_2.8.10 fs_1.6.6
## [127] rstan_2.32.6 viridisLite_0.4.0 QuickJSR_1.3.1
## [130] assertthat_0.2.1 munsell_0.5.0 Brobdingnag_1.2-7
## [133] V8_4.4.2 quantreg_5.98 fontquiver_0.2.1
## [136] sjstats_0.19.0 patchwork_1.2.0 hms_1.1.3
## [139] gfonts_0.2.0 shiny_1.9.1 haven_2.4.3
## [142] gt_1.1.0 broom_1.0.10 RcppParallel_5.1.8
## [145] officer_0.6.6