# S3 File. R analysis code
# This script reproduces the main three-level meta-analysis, subgroup analyses,
# and meta-regression analyses for the systematic review and meta-analysis of
# exercise-based cardiac rehabilitation and health-related quality of life in
# patients with coronary artery disease.
# Input: S1_Extracted_data_and_effect_sizes.xlsx

# Required packages -----------------------------------------------------------
library(readxl)
library(dplyr)
library(metafor)
library(ggplot2)

# The orchaRd package is optional and is used only for orchard-style plots.
has_orchard <- requireNamespace("orchaRd", quietly = TRUE)

# File paths ------------------------------------------------------------------
data_path <- "S1_Extracted_data_and_effect_sizes.xlsx"
output_dir <- "analysis_outputs"
dir.create(output_dir, showWarnings = FALSE)

# Variable mapping ------------------------------------------------------------
# Edit this mapping only if column names in S1 Dataset are changed.
vars <- list(
  study = "study",
  studyid = "studyid",
  esid = "esid",
  outcome = "outcome",
  exp_n = "EXPn",
  exp_mean = "EXPmean",
  exp_sd = "EXPsd",
  con_n = "CONn",
  con_mean = "CONmean",
  con_sd = "CONsd",
  exercise_modality = "exercise_modality",
  disease_status = "disease_status",
  mean_age = "mean_age",
  exercise_dose = "exercise_dose_MET_min_week",
  included_main = "included_in_main_analysis",
  included_modality = "included_in_exercise_modality_subgroup",
  included_age_dose = "included_in_age_dose_metaregression",
  instrument = "instrument"
)

required_columns <- unlist(vars[c(
  "study", "studyid", "esid", "outcome",
  "exp_n", "exp_mean", "exp_sd", "con_n", "con_mean", "con_sd",
  "exercise_modality", "disease_status", "mean_age", "exercise_dose",
  "included_main", "included_modality", "included_age_dose"
)])

# Helper functions ------------------------------------------------------------
check_required_columns <- function(data, required) {
  missing_columns <- setdiff(required, names(data))
  if (length(missing_columns) > 0) {
    stop(
      "The following required columns are missing from S1 Dataset: ",
      paste(missing_columns, collapse = ", ")
    )
  }
}

as_yes <- function(x) {
  tolower(trimws(as.character(x))) == "yes"
}

write_model_summary <- function(model, file, heading = NULL, extra = NULL) {
  out <- c()
  if (!is.null(heading)) {
    out <- c(out, heading, strrep("=", nchar(heading)), "")
  }
  if (!is.null(extra)) {
    out <- c(out, extra, "")
  }
  out <- c(out, capture.output(summary(model)))
  out <- c(out, "", "Variance components:", capture.output(model$sigma2))
  out <- c(out, "", "Q test:", capture.output(model$QE))
  writeLines(out, con = file.path(output_dir, file))
}

format_main_results <- function(model, data) {
  model_summary <- summary(model)
  c(
    paste0("Number of effect sizes: ", nrow(data)),
    paste0("Number of study clusters: ", dplyr::n_distinct(data$studyid)),
    paste0("Hedges' g: ", round(as.numeric(model$b[1]), 4)),
    paste0("95% CI: ", round(model_summary$ci.lb, 4), " to ", round(model_summary$ci.ub, 4)),
    paste0("p value: ", signif(model_summary$pval, 4)),
    paste0("Variance components: ", paste(round(model$sigma2, 4), collapse = ", ")),
    paste0("Q statistic: ", round(model$QE, 4)),
    paste0("Q-test degrees of freedom: ", model$k - model$p),
    paste0("Q-test p value: ", signif(model$QEp, 4))
  )
}

calculate_effect_sizes <- function(data) {
  escalc(
    measure = "SMD",
    m1i = EXPmean,
    sd1i = EXPsd,
    n1i = EXPn,
    m2i = CONmean,
    sd2i = CONsd,
    n2i = CONn,
    data = data,
    slab = study
  )
}

fit_three_level_model <- function(data, mods = NULL) {
  if (is.null(mods)) {
    rma.mv(
      yi = yi,
      V = vi,
      random = ~ 1 | studyid / esid,
      method = "REML",
      test = "t",
      data = data
    )
  } else {
    rma.mv(
      yi = yi,
      V = vi,
      mods = mods,
      random = ~ 1 | studyid / esid,
      method = "REML",
      test = "t",
      data = data
    )
  }
}

write_subgroup_summary <- function(model_no_intercept, model_test, data, variable, file) {
  out <- c(
    paste0(variable, " subgroup analysis"),
    strrep("=", nchar(variable) + 18),
    "",
    paste0("Number of effect sizes: ", nrow(data)),
    paste0("Number of study clusters: ", dplyr::n_distinct(data$studyid)),
    "",
    "Subgroup-specific estimates:",
    capture.output(summary(model_no_intercept)),
    "",
    "Moderator test model:",
    capture.output(summary(model_test)),
    "",
    "Moderator test:",
    capture.output(anova(model_test))
  )
  writeLines(out, con = file.path(output_dir, file))
}

make_caterpillar_plot <- function(data) {
  plot_data <- data %>%
    mutate(
      ci_lower = yi - 1.96 * sqrt(vi),
      ci_upper = yi + 1.96 * sqrt(vi),
      label = paste0("esid ", esid, ": ", study, " (", outcome, ")")
    ) %>%
    arrange(yi) %>%
    mutate(label = factor(label, levels = label))

  ggplot(plot_data, aes(x = yi, y = label)) +
    geom_vline(xintercept = 0, linetype = "dashed", color = "grey50") +
    geom_errorbar(
      aes(xmin = ci_lower, xmax = ci_upper),
      orientation = "y",
      width = 0.15,
      color = "grey45"
    ) +
    geom_point(size = 1.8, color = "#2C7FB8") +
    labs(x = "Hedges' g for HR-QoL", y = NULL) +
    theme_bw(base_size = 9)
}

make_bubble_plot <- function(data, xvar, xlab) {
  ggplot(data, aes(x = .data[[xvar]], y = yi)) +
    geom_hline(yintercept = 0, linetype = "dashed", color = "grey50") +
    geom_point(aes(size = 1 / vi), alpha = 0.55, color = "#2C7FB8") +
    geom_smooth(
      method = "lm",
      formula = y ~ x,
      se = TRUE,
      color = "#D95F0E",
      linewidth = 0.7
    ) +
    scale_size_continuous(name = "Precision", range = c(1.5, 6)) +
    labs(x = xlab, y = "Hedges' g for HR-QoL") +
    theme_bw(base_size = 10)
}

make_subgroup_estimate_plot <- function(model, variable, xlab) {
  model_summary <- summary(model)
  plot_data <- data.frame(
    subgroup = gsub(paste0("factor\\(", variable, "\\)"), "", rownames(model_summary$beta)),
    estimate = as.numeric(model_summary$beta[, 1]),
    ci_lower = model_summary$ci.lb,
    ci_upper = model_summary$ci.ub
  )

  ggplot(plot_data, aes(x = estimate, y = subgroup)) +
    geom_vline(xintercept = 0, linetype = "dashed", color = "grey50") +
    geom_errorbar(
      aes(xmin = ci_lower, xmax = ci_upper),
      orientation = "y",
      width = 0.15,
      color = "grey45"
    ) +
    geom_point(size = 2.4, color = "#2C7FB8") +
    labs(x = xlab, y = NULL) +
    theme_bw(base_size = 10)
}

# Read and prepare data -------------------------------------------------------
raw_data <- read_excel(data_path, sheet = "Extracted_data")
check_required_columns(raw_data, required_columns)

analysis_data <- raw_data %>%
  rename(
    study = all_of(vars$study),
    studyid = all_of(vars$studyid),
    esid = all_of(vars$esid),
    outcome = all_of(vars$outcome),
    EXPn = all_of(vars$exp_n),
    EXPmean = all_of(vars$exp_mean),
    EXPsd = all_of(vars$exp_sd),
    CONn = all_of(vars$con_n),
    CONmean = all_of(vars$con_mean),
    CONsd = all_of(vars$con_sd),
    exercise_modality = all_of(vars$exercise_modality),
    disease_status = all_of(vars$disease_status),
    mean_age = all_of(vars$mean_age),
    exercise_dose_MET_min_week = all_of(vars$exercise_dose),
    included_in_main_analysis = all_of(vars$included_main),
    included_in_exercise_modality_subgroup = all_of(vars$included_modality),
    included_in_age_dose_metaregression = all_of(vars$included_age_dose)
  ) %>%
  mutate(
    study = as.character(study),
    studyid = as.factor(studyid),
    esid = as.factor(esid),
    outcome = as.character(outcome),
    exercise_modality = as.factor(exercise_modality),
    disease_status = as.factor(disease_status),
    mean_age = as.numeric(mean_age),
    exercise_dose_MET_min_week = as.numeric(exercise_dose_MET_min_week),
    included_in_main_analysis = as_yes(included_in_main_analysis),
    included_in_exercise_modality_subgroup = as_yes(included_in_exercise_modality_subgroup),
    included_in_age_dose_metaregression = as_yes(included_in_age_dose_metaregression)
  )

# Main three-level meta-analysis ---------------------------------------------
main_data <- analysis_data %>%
  filter(included_in_main_analysis)

data_es <- calculate_effect_sizes(main_data)

model_main <- fit_three_level_model(data_es)

write_model_summary(
  model_main,
  "main_model_summary.txt",
  heading = "Main three-level random-effects meta-analysis",
  extra = format_main_results(model_main, data_es)
)

# Exercise-modality subgroup analysis ----------------------------------------
subgroup_data <- analysis_data %>%
  filter(included_in_exercise_modality_subgroup, !is.na(exercise_modality)) %>%
  calculate_effect_sizes()

model_modality <- fit_three_level_model(
  subgroup_data,
  mods = ~ factor(exercise_modality) - 1
)

model_modality_test <- fit_three_level_model(
  subgroup_data,
  mods = ~ factor(exercise_modality)
)

write_subgroup_summary(
  model_modality,
  model_modality_test,
  subgroup_data,
  "exercise_modality",
  "exercise_modality_subgroup_summary.txt"
)

# Disease-status subgroup analysis -------------------------------------------
disease_data <- analysis_data %>%
  filter(included_in_main_analysis, !is.na(disease_status)) %>%
  calculate_effect_sizes()

model_disease <- fit_three_level_model(
  disease_data,
  mods = ~ factor(disease_status) - 1
)

model_disease_test <- fit_three_level_model(
  disease_data,
  mods = ~ factor(disease_status)
)

write_subgroup_summary(
  model_disease,
  model_disease_test,
  disease_data,
  "disease_status",
  "disease_status_subgroup_summary.txt"
)

# HR-QoL instrument subgroup analysis ----------------------------------------
if (vars$instrument %in% names(raw_data)) {
  instrument_data <- analysis_data %>%
    mutate(instrument = as.factor(raw_data[[vars$instrument]])) %>%
    filter(included_in_main_analysis, !is.na(instrument)) %>%
    calculate_effect_sizes()

  model_instrument <- fit_three_level_model(
    instrument_data,
    mods = ~ factor(instrument) - 1
  )

  model_instrument_test <- fit_three_level_model(
    instrument_data,
    mods = ~ factor(instrument)
  )

  write_subgroup_summary(
    model_instrument,
    model_instrument_test,
    instrument_data,
    "instrument",
    "instrument_subgroup_summary.txt"
  )
} else {
  writeLines(
    "Instrument subgroup analysis requires an instrument variable in the dataset.",
    con = file.path(output_dir, "instrument_subgroup_summary.txt")
  )
}

# Mean-age meta-regression ----------------------------------------------------
age_data <- analysis_data %>%
  filter(included_in_age_dose_metaregression, !is.na(mean_age)) %>%
  calculate_effect_sizes()

model_age <- fit_three_level_model(
  age_data,
  mods = ~ mean_age
)

write_model_summary(
  model_age,
  "age_metareg_summary.txt",
  heading = "Mean-age meta-regression",
  extra = c(
    paste0("Number of effect sizes: ", nrow(age_data)),
    paste0("Number of study clusters: ", dplyr::n_distinct(age_data$studyid))
  )
)

# Exercise-dose meta-regression ----------------------------------------------
dose_data <- analysis_data %>%
  filter(included_in_age_dose_metaregression, !is.na(exercise_dose_MET_min_week)) %>%
  calculate_effect_sizes()

model_dose <- fit_three_level_model(
  dose_data,
  mods = ~ exercise_dose_MET_min_week
)

write_model_summary(
  model_dose,
  "dose_metareg_summary.txt",
  heading = "Exercise-dose meta-regression",
  extra = c(
    paste0("Number of effect sizes: ", nrow(dose_data)),
    paste0("Number of study clusters: ", dplyr::n_distinct(dose_data$studyid))
  )
)

# Optional figures ------------------------------------------------------------
caterpillar_plot <- make_caterpillar_plot(data_es)
ggsave(
  filename = file.path(output_dir, "figure_caterpillar.tiff"),
  plot = caterpillar_plot,
  width = 7,
  height = 10,
  units = "in",
  dpi = 300,
  compression = "lzw"
)

if (has_orchard) {
  orchard_plot <- try(
    orchaRd::orchard_plot(
      model_modality,
      mod = "factor(exercise_modality)",
      xlab = "Hedges' g for HR-QoL"
    ),
    silent = TRUE
  )

  if (!inherits(orchard_plot, "try-error")) {
    ggsave(
      filename = file.path(output_dir, "figure_orchard_exercise_modality.tiff"),
      plot = orchard_plot,
      width = 6,
      height = 4,
      units = "in",
      dpi = 300,
      compression = "lzw"
    )
  }
}

if (!file.exists(file.path(output_dir, "figure_orchard_exercise_modality.tiff"))) {
  modality_plot <- make_subgroup_estimate_plot(
    model_modality,
    "exercise_modality",
    "Hedges' g for HR-QoL"
  )
  ggsave(
    filename = file.path(output_dir, "figure_orchard_exercise_modality.tiff"),
    plot = modality_plot,
    width = 6,
    height = 4,
    units = "in",
    dpi = 300,
    compression = "lzw"
  )
}

age_bubble_plot <- make_bubble_plot(age_data, "mean_age", "Mean age (years)")
ggsave(
  filename = file.path(output_dir, "figure_age_bubble.tiff"),
  plot = age_bubble_plot,
  width = 6,
  height = 4,
  units = "in",
  dpi = 300,
  compression = "lzw"
)

dose_bubble_plot <- make_bubble_plot(
  dose_data,
  "exercise_dose_MET_min_week",
  "Exercise dose (MET-min/week)"
)
ggsave(
  filename = file.path(output_dir, "figure_dose_bubble.tiff"),
  plot = dose_bubble_plot,
  width = 6,
  height = 4,
  units = "in",
  dpi = 300,
  compression = "lzw"
)

message("Analysis complete. Results saved in: ", output_dir)