############################################################
# Supplementary Code File 1
# R code for data preprocessing, model development,
# validation, calibration analysis, decision curve analysis,
# restricted cubic spline analysis, and visualization.
#
# Note:
# Institution-specific file paths and identifiers have been removed.
# The input file should be a de-identified dataset.
############################################################


############################################################
# 1. Load required packages
############################################################

required_packages <- c(
  "readxl", "dplyr", "caret", "mice", "glmnet", "pROC",
  "rms", "car", "Hmisc", "ggplot2", "rmda"
)

for (pkg in required_packages) {
  if (!requireNamespace(pkg, quietly = TRUE)) {
    install.packages(pkg)
  }
}

library(readxl)
library(dplyr)
library(caret)
library(mice)
library(glmnet)
library(pROC)
library(rms)
library(car)
library(Hmisc)
library(ggplot2)
library(rmda)


############################################################
# 2. Import de-identified dataset
############################################################

# The dataset should be de-identified before analysis.
# Please ensure that the column names in the dataset match the names below.
# Suggested input file name:
# deidentified_dataset.xlsx

data_raw <- read_excel("deidentified_dataset.xlsx")

# Optional: inspect variable names
print(names(data_raw))


############################################################
# 3. Variable preprocessing and coding
############################################################

# Expected original variables:
# IPCs: outcome variable, coded as 0 = no IPCs, 1 = IPCs
# Age: age in years
# Sex or Male: sex variable, if available
# Course: duration from symptom onset to admission, in days
# PLT: platelet count
# CRP: C-reactive protein
# AST: aspartate aminotransferase
# ESR: erythrocyte sedimentation rate
# LDH: lactate dehydrogenase
# D_dimer: D-dimer level
# IgE: immunoglobulin E
# PMH: past medical history, coded as 0/1
# Oxy_ECG: oxygen therapy and/or continuous ECG monitoring, coded as 0/1
# MP: Mycoplasma pneumoniae positivity, coded as 0/1
# OP: other pathogen positivity, coded as 0/1
# IS: pulmonary imaging score

# If your D-dimer column is named "D-dimer" or "D.dimer",
# rename it to D_dimer before running the analysis.
# Example:
# data_raw <- data_raw %>% rename(D_dimer = `D-dimer`)

data_processed <- data_raw %>%
  mutate(
    IPCs = as.numeric(IPCs),
    Age = as.numeric(Age),
    Course = as.numeric(Course),
    PLT = as.numeric(PLT),
    CRP = as.numeric(CRP),
    AST = as.numeric(AST),
    ESR = as.numeric(ESR),
    LDH = as.numeric(LDH),
    D_dimer = as.numeric(D_dimer),
    IgE = as.numeric(IgE),
    PMH = as.numeric(PMH),
    Oxy_ECG = as.numeric(Oxy_ECG),
    MP = as.numeric(MP),
    OP = as.numeric(OP),
    IS = as.numeric(IS),
    
    PLT_500 = ifelse(PLT >= 500, 1, 0),
    CRP_30 = ifelse(CRP >= 30, 1, 0),
    AST_40 = ifelse(AST >= 40, 1, 0),
    ESR_40 = ifelse(ESR >= 40, 1, 0),
    LDH_500 = ifelse(LDH >= 500, 1, 0),
    D_dimer_1 = ifelse(D_dimer >= 1, 1, 0),
    IgE_1000 = ifelse(IgE >= 1000, 1, 0)
  )

# Candidate variables used for model development
candidate_vars <- c(
  "Course", "PLT_500", "CRP_30", "AST_40", "ESR_40",
  "LDH_500", "D_dimer_1", "IgE_1000",
  "PMH", "Oxy_ECG", "MP", "OP", "IS"
)

# Variables for baseline comparison may include continuous forms
baseline_vars <- c(
  "Age", "Course", "PLT", "CRP", "AST", "ESR",
  "LDH", "D_dimer", "IgE", "PMH", "Oxy_ECG",
  "MP", "OP", "IS", "IPCs"
)


############################################################
# 4. Stratified training-validation split
############################################################

set.seed(123)

train_index <- createDataPartition(
  y = data_processed$IPCs,
  p = 0.7,
  list = FALSE
)

train_data_raw <- data_processed[train_index, ]
valid_data_raw <- data_processed[-train_index, ]

cat("Training cohort size:", nrow(train_data_raw), "\n")
cat("Validation cohort size:", nrow(valid_data_raw), "\n")
cat("Training IPC events:", sum(train_data_raw$IPCs, na.rm = TRUE), "\n")
cat("Validation IPC events:", sum(valid_data_raw$IPCs, na.rm = TRUE), "\n")


############################################################
# 5. Missing-data imputation using MICE
############################################################

# Missing laboratory values are imputed separately within the training
# and validation cohorts to avoid information leakage.
# The imputation assumes missing at random (MAR).

impute_vars <- c(
  "IPCs", "Age", "Course", "PLT", "CRP", "AST", "ESR",
  "LDH", "D_dimer", "IgE", "PMH", "Oxy_ECG",
  "MP", "OP", "IS"
)

train_for_mice <- train_data_raw[, impute_vars]
valid_for_mice <- valid_data_raw[, impute_vars]

set.seed(123)
imp_train <- mice(
  train_for_mice,
  m = 5,
  maxit = 20,
  method = "pmm",
  seed = 123,
  printFlag = FALSE
)

set.seed(123)
imp_valid <- mice(
  valid_for_mice,
  m = 5,
  maxit = 20,
  method = "pmm",
  seed = 123,
  printFlag = FALSE
)

# In this script, the first completed dataset is used for model development
# and validation, consistent with a complete-data modelling workflow.
# If pooled estimates are required, Rubin's rules should be applied separately
# for regression-based analyses.

train_imp <- complete(imp_train, action = 1)
valid_imp <- complete(imp_valid, action = 1)

# Re-create dichotomized variables after imputation
create_binary_vars <- function(dat) {
  dat %>%
    mutate(
      PLT_500 = ifelse(PLT >= 500, 1, 0),
      CRP_30 = ifelse(CRP >= 30, 1, 0),
      AST_40 = ifelse(AST >= 40, 1, 0),
      ESR_40 = ifelse(ESR >= 40, 1, 0),
      LDH_500 = ifelse(LDH >= 500, 1, 0),
      D_dimer_1 = ifelse(D_dimer >= 1, 1, 0),
      IgE_1000 = ifelse(IgE >= 1000, 1, 0),
      IPCs = as.numeric(IPCs),
      PMH = as.numeric(PMH),
      Oxy_ECG = as.numeric(Oxy_ECG),
      MP = as.numeric(MP),
      OP = as.numeric(OP),
      IS = as.numeric(IS)
    )
}

train_data <- create_binary_vars(train_imp)
valid_data <- create_binary_vars(valid_imp)


############################################################
# 6. LASSO variable selection
############################################################

x_train <- model.matrix(
  IPCs ~ Course + PLT_500 + CRP_30 + AST_40 + ESR_40 +
    LDH_500 + D_dimer_1 + IgE_1000 + PMH + Oxy_ECG +
    MP + OP + IS,
  data = train_data
)[, -1]

y_train <- train_data$IPCs

set.seed(123)
cv_lasso <- cv.glmnet(
  x = x_train,
  y = y_train,
  family = "binomial",
  alpha = 1,
  nfolds = 10
)

lambda_min <- cv_lasso$lambda.min
lambda_1se <- cv_lasso$lambda.1se

cat("lambda_min:", lambda_min, "\n")
cat("lambda_1se:", lambda_1se, "\n")

lasso_coef <- coef(cv_lasso, s = "lambda.min")
selected_vars <- rownames(lasso_coef)[as.numeric(lasso_coef) != 0]
selected_vars <- selected_vars[selected_vars != "(Intercept)"]

cat("Variables selected by LASSO at lambda_min:\n")
print(selected_vars)

# Plot LASSO coefficient paths
tiff("Figure_1A_LASSO_coefficients.tif", width = 1800, height = 1500, res = 300)
plot(cv_lasso$glmnet.fit, xvar = "lambda", label = TRUE)
abline(v = log(lambda_min), lty = 2)
abline(v = log(lambda_1se), lty = 2)
dev.off()

# Plot cross-validation curve
tiff("Figure_1B_LASSO_CV.tif", width = 1800, height = 1500, res = 300)
plot(cv_lasso)
dev.off()


############################################################
# 7. Multivariable logistic regression and VIF
############################################################

# Candidate predictors retained after LASSO in the manuscript:
# Course, CRP_30, AST_40, LDH_500, D_dimer_1, PMH,
# Oxy_ECG, MP, and IS.

candidate_formula <- IPCs ~ Course + CRP_30 + AST_40 + LDH_500 +
  D_dimer_1 + PMH + Oxy_ECG + MP + IS

candidate_model <- glm(
  candidate_formula,
  data = train_data,
  family = binomial(link = "logit")
)

summary(candidate_model)

# VIF assessment
vif_values <- car::vif(candidate_model)
vif_table <- data.frame(
  Variable = names(vif_values),
  VIF = as.numeric(vif_values)
)
print(vif_table)
write.csv(vif_table, "Supplementary_Table_S2_VIF.csv", row.names = FALSE)

# Final six-predictor model
final_model <- glm(
  IPCs ~ AST_40 + D_dimer_1 + PMH + Oxy_ECG + MP + IS,
  data = train_data,
  family = binomial(link = "logit")
)

summary(final_model)

coef_final <- coef(final_model)
or_final <- exp(coef_final)
ci_final <- exp(confint(final_model))

model_table <- data.frame(
  Variable = names(coef_final),
  B = as.numeric(coef_final),
  OR = as.numeric(or_final),
  CI_lower = c(NA, ci_final[, 1][-1]),
  CI_upper = c(NA, ci_final[, 2][-1])
)

print(model_table)
write.csv(model_table, "Final_logistic_model_coefficients.csv", row.names = FALSE)

# Complete prediction equation:
# logit(P) = intercept + coefficients * predictors
cat("Final prediction equation coefficients:\n")
print(coef_final)


############################################################
# 8. Nomogram construction
############################################################

dd <- datadist(train_data)
options(datadist = "dd")

nom_model <- lrm(
  IPCs ~ AST_40 + D_dimer_1 + PMH + Oxy_ECG + MP + IS,
  data = train_data,
  x = TRUE,
  y = TRUE
)

nom <- nomogram(
  nom_model,
  fun = plogis,
  fun.at = c(0.05, 0.10, 0.20, 0.30, 0.50, 0.70, 0.90),
  lp = TRUE,
  funlabel = "Predicted probability of IPCs"
)

tiff("Figure_2_Nomogram.tif", width = 2400, height = 1800, res = 300)
plot(nom)
dev.off()


############################################################
# 9. Prediction in training and validation cohorts
############################################################

train_data$pred_prob <- predict(final_model, newdata = train_data, type = "response")
valid_data$pred_prob <- predict(final_model, newdata = valid_data, type = "response")

# Linear predictor
train_data$linear_predictor <- predict(final_model, newdata = train_data, type = "link")
valid_data$linear_predictor <- predict(final_model, newdata = valid_data, type = "link")


############################################################
# 10. ROC analysis
############################################################

roc_train <- roc(train_data$IPCs, train_data$pred_prob, ci = TRUE)
roc_valid <- roc(valid_data$IPCs, valid_data$pred_prob, ci = TRUE)

cat("Training AUC:\n")
print(auc(roc_train))
print(ci.auc(roc_train))

cat("Validation AUC:\n")
print(auc(roc_valid))
print(ci.auc(roc_valid))

tiff("Figure_3A_ROC_training.tif", width = 1800, height = 1500, res = 300)
plot(roc_train, main = "ROC curve in the training cohort")
dev.off()

tiff("Figure_3B_ROC_validation.tif", width = 1800, height = 1500, res = 300)
plot(roc_valid, main = "ROC curve in the validation cohort")
dev.off()


############################################################
# 11. Brier score and bootstrap 95% CI
############################################################

brier_score <- function(actual, predicted) {
  mean((actual - predicted)^2)
}

bootstrap_brier_ci <- function(actual, predicted, B = 1000, seed = 123) {
  set.seed(seed)
  n <- length(actual)
  boot_values <- numeric(B)
  
  for (b in seq_len(B)) {
    idx <- sample(seq_len(n), size = n, replace = TRUE)
    boot_values[b] <- brier_score(actual[idx], predicted[idx])
  }
  
  c(
    Brier = brier_score(actual, predicted),
    CI_lower = quantile(boot_values, 0.025, na.rm = TRUE),
    CI_upper = quantile(boot_values, 0.975, na.rm = TRUE)
  )
}

brier_train <- bootstrap_brier_ci(train_data$IPCs, train_data$pred_prob, B = 1000)
brier_valid <- bootstrap_brier_ci(valid_data$IPCs, valid_data$pred_prob, B = 1000)

cat("Training Brier score and 95% CI:\n")
print(brier_train)

cat("Validation Brier score and 95% CI:\n")
print(brier_valid)


############################################################
# 12. Calibration slope and intercept with 95% CI
############################################################

# Calibration model:
# logit(observed outcome) = intercept + slope * logit(predicted probability)

calibration_slope_intercept <- function(data, pred_col = "pred_prob", outcome_col = "IPCs") {
  eps <- 1e-6
  p <- pmin(pmax(data[[pred_col]], eps), 1 - eps)
  lp <- qlogis(p)
  
  cal_model <- glm(data[[outcome_col]] ~ lp, family = binomial)
  est <- coef(cal_model)
  ci <- confint(cal_model)
  
  out <- data.frame(
    Parameter = c("Calibration intercept", "Calibration slope"),
    Estimate = c(est[1], est[2]),
    CI_lower = c(ci[1, 1], ci[2, 1]),
    CI_upper = c(ci[1, 2], ci[2, 2])
  )
  return(out)
}

cal_train <- calibration_slope_intercept(train_data)
cal_valid <- calibration_slope_intercept(valid_data)

cat("Calibration slope and intercept in training cohort:\n")
print(cal_train)

cat("Calibration slope and intercept in validation cohort:\n")
print(cal_valid)


############################################################
# 13. Calibration plots
############################################################

# Calibration plot using rms::calibrate in training cohort
cal_train_rms <- calibrate(nom_model, method = "boot", B = 1000)

tiff("Figure_4A_Calibration_training.tif", width = 1800, height = 1500, res = 300)
plot(
  cal_train_rms,
  xlab = "Predicted probability",
  ylab = "Observed probability",
  subtitles = FALSE
)
dev.off()

# Calibration plot for validation cohort using grouped calibration
plot_grouped_calibration <- function(data, pred_col = "pred_prob", outcome_col = "IPCs",
                                     groups = 5, filename = NULL, title = NULL) {
  dat <- data %>%
    mutate(group = ntile(.data[[pred_col]], groups)) %>%
    group_by(group) %>%
    summarise(
      mean_pred = mean(.data[[pred_col]], na.rm = TRUE),
      obs_rate = mean(.data[[outcome_col]], na.rm = TRUE),
      n = n(),
      .groups = "drop"
    )
  
  p <- ggplot(dat, aes(x = mean_pred, y = obs_rate)) +
    geom_point() +
    geom_line() +
    geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
    xlim(0, 1) +
    ylim(0, 1) +
    labs(
      title = title,
      x = "Predicted probability",
      y = "Observed probability"
    ) +
    theme_bw()
  
  if (!is.null(filename)) {
    tiff(filename, width = 1800, height = 1500, res = 300)
    print(p)
    dev.off()
  }
  
  return(dat)
}

cal_valid_grouped <- plot_grouped_calibration(
  valid_data,
  filename = "Figure_4D_Calibration_validation.tif",
  title = "Calibration plot in the validation cohort"
)

print(cal_valid_grouped)


############################################################
# 14. Hosmer-Lemeshow test
############################################################

# Optional: install ResourceSelection if not available
if (!requireNamespace("ResourceSelection", quietly = TRUE)) {
  install.packages("ResourceSelection")
}
library(ResourceSelection)

hl_train <- hoslem.test(train_data$IPCs, train_data$pred_prob, g = 10)
hl_valid <- hoslem.test(valid_data$IPCs, valid_data$pred_prob, g = 10)

cat("Hosmer-Lemeshow test in training cohort:\n")
print(hl_train)

cat("Hosmer-Lemeshow test in validation cohort:\n")
print(hl_valid)


############################################################
# 15. High-risk miscalibration in validation cohort
############################################################

# High-risk group defined as predicted probability > 0.5.
# Difference is calculated as observed - predicted.
# Negative value indicates overestimation by the model.

high_risk_valid <- valid_data %>% filter(pred_prob > 0.5)

if (nrow(high_risk_valid) > 0) {
  high_risk_bias <- mean(high_risk_valid$IPCs - high_risk_valid$pred_prob)
  cat("High-risk miscalibration in validation cohort:\n")
  cat("Number of high-risk patients:", nrow(high_risk_valid), "\n")
  cat("Observed event rate:", mean(high_risk_valid$IPCs), "\n")
  cat("Mean predicted probability:", mean(high_risk_valid$pred_prob), "\n")
  cat("Average difference, observed - predicted:", high_risk_bias, "\n")
} else {
  cat("No patients with predicted probability > 0.5 in validation cohort.\n")
}


############################################################
# 16. Manual DCA and bootstrap 95% CI for net benefit
############################################################

net_benefit <- function(actual, predicted, threshold) {
  classified_positive <- ifelse(predicted >= threshold, 1, 0)
  
  TP <- sum(classified_positive == 1 & actual == 1, na.rm = TRUE)
  FP <- sum(classified_positive == 1 & actual == 0, na.rm = TRUE)
  n <- length(actual)
  
  nb <- (TP / n) - (FP / n) * (threshold / (1 - threshold))
  return(nb)
}

bootstrap_dca_ci <- function(actual, predicted, thresholds, B = 1000, seed = 123) {
  set.seed(seed)
  n <- length(actual)
  
  results <- data.frame(
    Threshold = thresholds,
    NetBenefit = NA_real_,
    CI_lower = NA_real_,
    CI_upper = NA_real_
  )
  
  for (i in seq_along(thresholds)) {
    pt <- thresholds[i]
    nb_original <- net_benefit(actual, predicted, pt)
    boot_nb <- numeric(B)
    
    for (b in seq_len(B)) {
      idx <- sample(seq_len(n), size = n, replace = TRUE)
      boot_nb[b] <- net_benefit(actual[idx], predicted[idx], pt)
    }
    
    results$NetBenefit[i] <- nb_original
    results$CI_lower[i] <- quantile(boot_nb, 0.025, na.rm = TRUE)
    results$CI_upper[i] <- quantile(boot_nb, 0.975, na.rm = TRUE)
  }
  
  return(results)
}

# Key thresholds reported in Supplementary Table S3
thresholds_s3 <- c(
  0.15, 0.20, 0.25, 0.30,
  0.50, 0.55, 0.60, 0.65,
  0.70, 0.75, 0.80, 0.85, 0.90
)

dca_valid_ci <- bootstrap_dca_ci(
  actual = valid_data$IPCs,
  predicted = valid_data$pred_prob,
  thresholds = thresholds_s3,
  B = 1000,
  seed = 123
)

dca_valid_ci_rounded <- dca_valid_ci %>%
  mutate(
    Threshold = round(Threshold, 3),
    NetBenefit = round(NetBenefit, 3),
    CI_lower = round(CI_lower, 3),
    CI_upper = round(CI_upper, 3)
  )

print(dca_valid_ci_rounded)
write.csv(dca_valid_ci_rounded, "Supplementary_Table_S3_DCA_NetBenefit_CI.csv", row.names = FALSE)


############################################################
# 17. DCA curve and clinical impact curve
############################################################

# Use rmda package for DCA and CIC plots

dca_train <- decision_curve(
  IPCs ~ pred_prob,
  data = train_data,
  family = binomial(link = "logit"),
  thresholds = seq(0.01, 0.99, by = 0.01),
  confidence.intervals = FALSE,
  study.design = "cohort"
)

dca_valid <- decision_curve(
  IPCs ~ pred_prob,
  data = valid_data,
  family = binomial(link = "logit"),
  thresholds = seq(0.01, 0.99, by = 0.01),
  confidence.intervals = FALSE,
  study.design = "cohort"
)

tiff("Figure_4B_DCA_training.tif", width = 1800, height = 1500, res = 300)
plot_decision_curve(
  dca_train,
  curve.names = "Nomogram",
  xlab = "Threshold probability",
  ylab = "Net benefit",
  standardize = FALSE
)
dev.off()

tiff("Figure_4E_DCA_validation.tif", width = 1800, height = 1500, res = 300)
plot_decision_curve(
  dca_valid,
  curve.names = "Nomogram",
  xlab = "Threshold probability",
  ylab = "Net benefit",
  standardize = FALSE
)
dev.off()

# Clinical impact curves
tiff("Figure_4C_CIC_training.tif", width = 1800, height = 1500, res = 300)
plot_clinical_impact(
  dca_train,
  population.size = 1000,
  cost.benefit.axis = FALSE,
  n.cost.benefits = 8
)
dev.off()

tiff("Figure_4F_CIC_validation.tif", width = 1800, height = 1500, res = 300)
plot_clinical_impact(
  dca_valid,
  population.size = 1000,
  cost.benefit.axis = FALSE,
  n.cost.benefits = 8
)
dev.off()


############################################################
# 18. Restricted cubic spline analysis
############################################################

# RCS analyses are exploratory and are not used to construct
# the final linear nomogram.

dd_all <- datadist(train_data)
options(datadist = "dd_all")

# Unadjusted age RCS
rcs_age_unadj <- lrm(IPCs ~ rcs(Age, 3), data = train_data, x = TRUE, y = TRUE)

# Adjusted age RCS
# Low-risk profile:
# AST_40 = 0, D_dimer_1 = 0, PMH = 0, Oxy_ECG = 0, MP = 0, IS = 2
rcs_age_adj <- lrm(
  IPCs ~ rcs(Age, 3) + AST_40 + D_dimer_1 + PMH + Oxy_ECG + MP + IS,
  data = train_data,
  x = TRUE,
  y = TRUE
)

# Unadjusted D-dimer RCS
rcs_ddimer_unadj <- lrm(IPCs ~ rcs(D_dimer, 3), data = train_data, x = TRUE, y = TRUE)

# Adjusted D-dimer RCS
rcs_ddimer_adj <- lrm(
  IPCs ~ rcs(D_dimer, 3) + AST_40 + PMH + Oxy_ECG + MP + IS,
  data = train_data,
  x = TRUE,
  y = TRUE
)

# Nonlinearity tests
anova_age_unadj <- anova(rcs_age_unadj)
anova_age_adj <- anova(rcs_age_adj)
anova_ddimer_unadj <- anova(rcs_ddimer_unadj)
anova_ddimer_adj <- anova(rcs_ddimer_adj)

cat("RCS nonlinearity tests:\n")
print(anova_age_unadj)
print(anova_age_adj)
print(anova_ddimer_unadj)
print(anova_ddimer_adj)

# Plot RCS curves
tiff("Figure_5A_RCS_Age_unadjusted.tif", width = 1800, height = 1500, res = 300)
plot(
  Predict(rcs_age_unadj, Age, fun = exp, ref.zero = TRUE),
  xlab = "Age, years",
  ylab = "Odds ratio",
  main = "Age, unadjusted"
)
abline(h = 1, lty = 2)
dev.off()

tiff("Figure_5B_RCS_Age_adjusted.tif", width = 1800, height = 1500, res = 300)
plot(
  Predict(
    rcs_age_adj,
    Age,
    AST_40 = 0,
    D_dimer_1 = 0,
    PMH = 0,
    Oxy_ECG = 0,
    MP = 0,
    IS = 2,
    fun = exp,
    ref.zero = TRUE
  ),
  xlab = "Age, years",
  ylab = "Odds ratio",
  main = "Age, adjusted"
)
abline(h = 1, lty = 2)
dev.off()

tiff("Figure_5C_RCS_Ddimer_unadjusted.tif", width = 1800, height = 1500, res = 300)
plot(
  Predict(rcs_ddimer_unadj, D_dimer, fun = exp, ref.zero = TRUE),
  xlab = "D-dimer, mg/L",
  ylab = "Odds ratio",
  main = "D-dimer, unadjusted"
)
abline(h = 1, lty = 2)
dev.off()

tiff("Figure_5D_RCS_Ddimer_adjusted.tif", width = 1800, height = 1500, res = 300)
plot(
  Predict(
    rcs_ddimer_adj,
    D_dimer,
    AST_40 = 0,
    PMH = 0,
    Oxy_ECG = 0,
    MP = 0,
    IS = 2,
    fun = exp,
    ref.zero = TRUE
  ),
  xlab = "D-dimer, mg/L",
  ylab = "Odds ratio",
  main = "D-dimer, adjusted"
)
abline(h = 1, lty = 2)
dev.off()


############################################################
# 19. Export key datasets and model outputs
############################################################

write.csv(train_data, "training_completed_dataset.csv", row.names = FALSE)
write.csv(valid_data, "validation_completed_dataset.csv", row.names = FALSE)
write.csv(model_table, "final_model_table.csv", row.names = FALSE)
write.csv(dca_valid_ci_rounded, "dca_net_benefit_ci_validation.csv", row.names = FALSE)

cat("Analysis completed successfully.\n")