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:


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)
Data summary
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   1

Estimated 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.325

4.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()

fig

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
  )
}

\(\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.8234519

5.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")
unscreened
screening
enriched
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.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.0222539

5.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"
  )
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)
  )

fig

Open 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)
  )

fig

Open 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+04

Extract 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."
)
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")
unscreened
screening
enriched
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.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"
  )

fig

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 = 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.9114040

5.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.")
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)
  )

fig

Open 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+03

Extract 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."
)
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")
unscreened
screening
enriched
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.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.1231256

5.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.")
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)
  )

fig

Open 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+04

Extract 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."
)
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.06666667

6.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.16

6.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.823

6.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.33326

6.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.*'
    )
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.*')
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.*')
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.*')
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"
)

fig

(A) Proportion of patients with CKD with a positive model-projected gain in dialysis-free time under optimized renoprotective treatment. (B) Distribution of the model-projected gain in dialysis-free time (months) among patients with a positive projected gain
Open 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"
)

fig

(A) Proportion of patients with CKD with a positive model-projected gain in dialysis-free time under optimized renoprotective treatment assuming partially additive treatment effects. (B) Distribution of the model-projected gain in dialysis-free time (months) among patients with a positive projected gain
Open 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