suppressPackageStartupMessages({
  library(readxl)
  library(openxlsx)
  library(metafor)
})

script_arg <- grep("^--file=", commandArgs(trailingOnly = FALSE), value = TRUE)
script_dir <- if (length(script_arg)) {
  dirname(normalizePath(sub("^--file=", "", script_arg[1])))
} else {
  normalizePath(getwd())
}
input_wb <- file.path(script_dir, "07_Supplementary_Data.xlsx")
if (!file.exists(input_wb)) {
  stop("Place 07_Supplementary_Data.xlsx in the same folder as this script.")
}
out_dir <- file.path(script_dir, "reanalysis_output")
forest_dir <- file.path(out_dir, "forest")
funnel_dir <- file.path(out_dir, "funnel")
dir.create(out_dir, recursive = TRUE, showWarnings = FALSE)
dir.create(forest_dir, recursive = TRUE, showWarnings = FALSE)
dir.create(funnel_dir, recursive = TRUE, showWarnings = FALSE)

display_names <- c(
  "01.Zong 2025" = "Zong YY 2025",
  "02.Sun 2024" = "Sun ZL 2024",
  "03.Lin 2023" = "Lin HY 2023",
  "04.Qiu 2022" = "Qiu F 2022",
  "05.Liu 2022" = "Liu ML 2022",
  "06.Ma 2021" = "Ma L 2021",
  "07.Jin 2021" = "Jin YS 2021",
  "08.Ya 2020" = "Ya BY 2020",
  "09.Cai 2020" = "Cai JY 2019",
  "10.Li 2019" = "Li S 2019",
  "11.Song 2019" = "Song QW 2019",
  "12.Hou 2019" = "Hou LL 2019",
  "13.Lin 2018" = "Lin DL 2018",
  "14.Shi 2016" = "Shi TF 2018",
  "15.Shi 2018" = "Shi QS 2018",
  "16.Gao 2018" = "Gao HS 2018",
  "17.Liu 2018" = "Liu DM 2018",
  "18.Guo 2018" = "Guo LL 2018",
  "19.Wang 2018" = "Wang GX 2018",
  "20.Zhou 2018" = "Zou YN 2018",
  "21.Wang 2017" = "Wang XF 2017",
  "22.Zhao 2017" = "Zhao H 2017",
  "23.Zhang2017" = "Zhang XL 2017",
  "24.Liu 2017" = "Liu F 2017",
  "25.Xu 2016" = "Xu Y 2016",
  "26.Zeng 2016" = "Zeng J 2016",
  "27.Wan 2016" = "Wan CR 2016",
  "28.Chen 2016" = "Chen XF 2016",
  "29.Wang  2013" = "Wang YZ 2013",
  "30.Yang  2017" = "Yang XY 2017",
  "31.Yu 2014" = "Yu YY 2014"
)

excluded_nonrandom <- c("21.Wang 2017", "29.Wang  2013")
# Conservative classification: the report required or described objective reflux
# confirmation for the full study population, rather than endoscopy alone or an
# "OR" criterion that could also be satisfied by symptoms.
objective_confirmed <- c("06.Ma 2021", "09.Cai 2020", "15.Shi 2018", "24.Liu 2017")

# The supplied workbook already contains the source-audited arm-level data.
# Reading these final sheets makes the submitted script self-contained and avoids
# dependence on an unpublished local extraction workbook.
cont <- as.data.frame(read_excel(input_wb, sheet = "Corrected_continuous"))
dich <- as.data.frame(read_excel(input_wb, sheet = "Corrected_dichotomous"))
base <- as.data.frame(read_excel(input_wb, sheet = "Included_study_characteristics"))
rob <- as.data.frame(read_excel(input_wb, sheet = "Risk_of_bias"))

# Recalculate all effect sizes from arm-level values.
for (m in unique(cont$Measure)) {
  idx <- cont$Measure == m
  es <- escalc(
    measure = m,
    m1i = mean_t, sd1i = sd_t, n1i = nt,
    m2i = mean_c, sd2i = sd_c, n2i = nc,
    data = cont[idx, ]
  )
  cont$yi[idx] <- es$yi
  cont$vi[idx] <- es$vi
}
esd <- escalc(
  measure = "RR",
  ai = events_t, n1i = nt,
  ci = events_c, n2i = nc,
  add = 0.5, to = "only0",
  data = dich
)
dich$yi <- esd$yi
dich$vi <- esd$vi

cont$objective_confirmed <- ifelse(cont$study_original %in% objective_confirmed, "yes", "no/unclear")
dich$objective_confirmed <- ifelse(dich$study_original %in% objective_confirmed, "yes", "no/unclear")

all_dat <- rbind(
  cont[, c("study", "study_original", "nt", "nc", "duration_weeks", "duration_group",
           "background", "psych_defined", "rigorous_def", "sample_total", "Outcome",
           "Scale", "Measure", "yi", "vi", "objective_confirmed")],
  transform(
    dich,
    Scale = ifelse(Outcome == "Total effective rate", "Composite response", "Any adverse event")
  )[, c("study", "study_original", "nt", "nc", "duration_weeks", "duration_group",
        "background", "psych_defined", "rigorous_def", "sample_total", "Outcome",
        "Scale", "Measure", "yi", "vi", "objective_confirmed")]
)

fmt_p <- function(p) {
  if (is.na(p)) return(NA_character_)
  if (p < 0.001) return("<0.001")
  sprintf("%.3f", p)
}

fit_model <- function(dat) {
  dat <- dat[is.finite(dat$yi) & is.finite(dat$vi), ]
  if (nrow(dat) < 2) return(NULL)
  rma(yi = yi, vi = vi, data = dat, method = "DL", test = "z")
}

extract_model <- function(label, dat, res) {
  measure <- unique(dat$Measure)[1]
  rr <- measure == "RR"
  pr <- tryCatch(predict(res), error = function(e) NULL)
  conv <- function(x) if (rr) exp(as.numeric(x)) else as.numeric(x)
  data.frame(
    Outcome = label,
    Effect_measure = measure,
    k = res$k,
    Participants = sum(dat$sample_total),
    Effect = conv(res$b[1, 1]),
    CI_lower = conv(res$ci.lb),
    CI_upper = conv(res$ci.ub),
    P_value = res$pval,
    Q = res$QE,
    Q_p = res$QEp,
    I2_percent = res$I2,
    tau2 = res$tau2,
    PI_lower = if (is.null(pr)) NA_real_ else conv(pr$pi.lb),
    PI_upper = if (is.null(pr)) NA_real_ else conv(pr$pi.ub),
    stringsAsFactors = FALSE
  )
}

analysis_sets <- list(
  "Anxiety symptoms (all scales)" = cont[cont$Outcome == "Anxiety", ],
  "HAMA" = cont[cont$Scale == "HAMA", ],
  "SAS" = cont[cont$Scale == "SAS", ],
  "Depressive symptoms (all scales)" = cont[cont$Outcome == "Depression", ],
  "HAMD" = cont[cont$Scale == "HAMD", ],
  "SDS" = cont[cont$Scale == "SDS", ],
  "RDQ" = cont[cont$Outcome == "RDQ", ],
  "Total effective rate" = dich[dich$Outcome == "Total effective rate", ],
  "Any adverse event" = dich[dich$Outcome == "Any adverse event", ]
)

main_rows <- list()
for (nm in names(analysis_sets)) {
  d <- analysis_sets[[nm]]
  res <- fit_model(d)
  if (!is.null(res)) main_rows[[nm]] <- extract_model(nm, d, res)
}
main_results <- do.call(rbind, main_rows)
rownames(main_results) <- NULL

subgroup_vars <- c(
  "Scale", "duration_group", "background", "psych_defined", "rigorous_def",
  "objective_confirmed"
)
subgroup_rows <- list()
nrow_sg <- 0
for (nm in c("Anxiety symptoms (all scales)", "Depressive symptoms (all scales)",
             "RDQ", "Total effective rate", "Any adverse event")) {
  d0 <- analysis_sets[[nm]]
  for (v in subgroup_vars) {
    d <- d0[!is.na(d0[[v]]) & d0[[v]] != "", ]
    levs <- unique(d[[v]])
    if (length(levs) < 2) next
    p_int <- NA_real_
    if (nrow(d) >= 4) {
      mod <- tryCatch(
        rma(yi = yi, vi = vi, mods = as.formula(paste0("~ factor(", v, ")")),
            data = d, method = "DL", test = "z"),
        error = function(e) NULL
      )
      if (!is.null(mod)) p_int <- mod$QMp
    }
    for (lev in levs) {
      ds <- d[d[[v]] == lev, ]
      if (nrow(ds) == 1) {
        rr <- unique(ds$Measure) == "RR"
        est <- if (rr) exp(ds$yi) else ds$yi
        lb <- if (rr) exp(ds$yi - 1.96 * sqrt(ds$vi)) else ds$yi - 1.96 * sqrt(ds$vi)
        ub <- if (rr) exp(ds$yi + 1.96 * sqrt(ds$vi)) else ds$yi + 1.96 * sqrt(ds$vi)
        er <- data.frame(
          Outcome = nm, Effect_measure = unique(ds$Measure), k = 1,
          Participants = sum(ds$sample_total), Effect = est, CI_lower = lb, CI_upper = ub,
          P_value = NA_real_, Q = NA_real_, Q_p = NA_real_, I2_percent = NA_real_,
          tau2 = NA_real_, PI_lower = NA_real_, PI_upper = NA_real_
        )
      } else {
        res <- fit_model(ds)
        if (is.null(res)) next
        er <- extract_model(nm, ds, res)
      }
      nrow_sg <- nrow_sg + 1
      subgroup_rows[[nrow_sg]] <- data.frame(
        Outcome = nm,
        Subgroup_variable = v,
        Level = lev,
        Effect_measure = er$Effect_measure,
        k = er$k,
        Participants = er$Participants,
        Effect = er$Effect,
        CI_lower = er$CI_lower,
        CI_upper = er$CI_upper,
        P_value = er$P_value,
        I2_percent = er$I2_percent,
        tau2 = er$tau2,
        Interaction_p = p_int,
        stringsAsFactors = FALSE
      )
    }
  }
}
subgroup_results <- do.call(rbind, subgroup_rows)

sensitivity_rows <- list()
nrow_sens <- 0
for (nm in names(analysis_sets)) {
  d0 <- analysis_sets[[nm]]
  if (nrow(d0) < 2) next
  base_res <- fit_model(d0)
  if (is.null(base_res)) next
  std <- tryCatch(rstandard(base_res)$z, error = function(e) rep(NA_real_, nrow(d0)))
  extreme <- unique(d0$study[is.finite(std) & abs(std) > 2])
  scenarios <- list(
    "Main analysis" = rep(TRUE, nrow(d0)),
    "Strict rGERD definition only" = d0$rigorous_def == "yes",
    "Objective testing required/reported for all participants" = d0$objective_confirmed == "yes",
    "Exclude studies with total sample <80" = d0$sample_total >= 80,
    "Exclude standardized residual >2" = !(d0$study %in% extreme)
  )
  for (sn in names(scenarios)) {
    keep <- scenarios[[sn]]
    ds <- d0[keep & !is.na(keep), ]
    if (nrow(ds) < 2) next
    res <- fit_model(ds)
    if (is.null(res)) next
    er <- extract_model(nm, ds, res)
    nrow_sens <- nrow_sens + 1
    sensitivity_rows[[nrow_sens]] <- data.frame(
      Outcome = nm,
      Scenario = sn,
      Excluded_studies = paste(setdiff(d0$study, ds$study), collapse = "; "),
      er[, -1],
      stringsAsFactors = FALSE
    )
  }
}
sensitivity_results <- do.call(rbind, sensitivity_rows)

loo_rows <- list()
nrow_loo <- 0
for (nm in names(analysis_sets)) {
  d0 <- analysis_sets[[nm]]
  if (nrow(d0) < 3) next
  for (st in d0$study) {
    ds <- d0[d0$study != st, ]
    res <- fit_model(ds)
    if (is.null(res)) next
    er <- extract_model(nm, ds, res)
    nrow_loo <- nrow_loo + 1
    loo_rows[[nrow_loo]] <- data.frame(
      Outcome = nm, Omitted_study = st, er[, -1], stringsAsFactors = FALSE
    )
  }
}
leave_one_out <- do.call(rbind, loo_rows)

bias_rows <- list()
nrow_bias <- 0
for (nm in names(analysis_sets)) {
  d <- analysis_sets[[nm]]
  if (nrow(d) < 10) next
  res <- fit_model(d)
  eg <- tryCatch(regtest(res, model = "rma", predictor = "sei"), error = function(e) NULL)
  if (is.null(eg)) next
  nrow_bias <- nrow_bias + 1
  bias_rows[[nrow_bias]] <- data.frame(
    Outcome = nm, k = nrow(d), Egger_z = as.numeric(eg$zval),
    Egger_p = as.numeric(eg$pval), stringsAsFactors = FALSE
  )
}
publication_bias <- if (length(bias_rows)) do.call(rbind, bias_rows) else data.frame()

metareg_rows <- list()
nrow_mr <- 0
for (nm in c("Anxiety symptoms (all scales)", "Depressive symptoms (all scales)",
             "RDQ", "Total effective rate", "Any adverse event")) {
  d <- analysis_sets[[nm]]
  if (nrow(d) < 10) next
  covars <- c("duration_weeks", "sample_total")
  for (v in covars) {
    fit <- tryCatch(
      rma(yi = yi, vi = vi, mods = as.formula(paste0("~ ", v)),
          data = d, method = "DL", test = "z"),
      error = function(e) NULL
    )
    if (is.null(fit)) next
    nrow_mr <- nrow_mr + 1
    metareg_rows[[nrow_mr]] <- data.frame(
      Outcome = nm, Moderator = v, k = fit$k,
      Coefficient = as.numeric(fit$beta[2]),
      CI_lower = as.numeric(fit$ci.lb[2]),
      CI_upper = as.numeric(fit$ci.ub[2]),
      P_value = as.numeric(fit$pval[2]),
      Residual_I2_percent = fit$I2,
      stringsAsFactors = FALSE
    )
  }
}
meta_regression <- if (length(metareg_rows)) do.call(rbind, metareg_rows) else data.frame()

plot_forest <- function(d, nm, file) {
  res <- fit_model(d)
  if (is.null(res)) return()
  d <- d[order(d$study), ]
  res <- fit_model(d)
  rr <- unique(d$Measure) == "RR"
  h <- max(1700, 540 + 92 * nrow(d))
  png(file, width = 2300, height = h, res = 220)
  par(mar = c(4.2, 4.2, 3.0, 1.5))
  if (rr) {
    forest(res, slab = d$study, atransf = exp, refline = 1,
           xlab = "Risk ratio (RR)", header = c("Study", "RR [95% CI]"), main = nm)
  } else {
    m <- unique(d$Measure)
    forest(res, slab = d$study, refline = 0,
           xlab = ifelse(m == "MD", "Mean difference (MD)", "Standardized mean difference (SMD)"),
           header = c("Study", paste0(m, " [95% CI]")), main = nm)
  }
  dev.off()
}

plot_funnel <- function(d, nm, file) {
  res <- fit_model(d)
  if (is.null(res)) return()
  rr <- unique(d$Measure) == "RR"
  png(file, width = 1800, height = 1600, res = 220)
  par(mar = c(4.2, 4.2, 3.0, 1.5))
  if (rr) {
    funnel(res, atransf = exp, yaxis = "sei", xlab = "Risk ratio (RR)", main = nm)
  } else {
    funnel(res, yaxis = "sei", xlab = unique(d$Measure), main = nm)
  }
  dev.off()
}

safe_name <- function(x) gsub("[^A-Za-z0-9]+", "_", x)
for (nm in names(analysis_sets)) {
  d <- analysis_sets[[nm]]
  plot_forest(d, nm, file.path(forest_dir, paste0(safe_name(nm), ".png")))
  if (nrow(d) >= 10) {
    plot_funnel(d, nm, file.path(funnel_dir, paste0(safe_name(nm), ".png")))
  }
}

# Safety event table from the corrected arm-level totals.
safety <- dich[dich$Outcome == "Any adverse event",
               c("study", "nt", "events_t", "nc", "events_c")]
safety$Risk_T <- safety$events_t / safety$nt
safety$Risk_C <- safety$events_c / safety$nc

# Trial-level inclusion/exclusion audit.
trial_audit <- data.frame(
  Study = names(display_names),
  Display_name = unname(display_names),
  Main_analysis_status = ifelse(
    names(display_names) %in% excluded_nonrandom,
    "Excluded after source re-audit",
    "Included"
  ),
  Reason = ifelse(
    names(display_names) == "21.Wang 2017",
    "Allocated according to treatment plan; not randomized",
    ifelse(
      names(display_names) == "29.Wang  2013",
      "No random allocation method reported",
      "Meets the retained eligibility criteria"
    )
  ),
  Objective_testing_required_or_reported_for_all = ifelse(
    names(display_names) %in% objective_confirmed, "Yes", "No/unclear"
  ),
  stringsAsFactors = FALSE
)

write.csv(main_results, file.path(out_dir, "main_results.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(subgroup_results, file.path(out_dir, "subgroup_results.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(sensitivity_results, file.path(out_dir, "sensitivity_results.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(leave_one_out, file.path(out_dir, "leave_one_out.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(publication_bias, file.path(out_dir, "publication_bias.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(meta_regression, file.path(out_dir, "meta_regression.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(safety, file.path(out_dir, "safety_totals.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(trial_audit, file.path(out_dir, "trial_audit.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(cont, file.path(out_dir, "corrected_continuous_data.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(dich, file.path(out_dir, "corrected_dichotomous_data.csv"), row.names = FALSE, fileEncoding = "UTF-8")

wb <- createWorkbook()
sheet_data <- list(
  Main_results = main_results,
  Subgroups = subgroup_results,
  Sensitivity = sensitivity_results,
  Leave_one_out = leave_one_out,
  Publication_bias = publication_bias,
  Meta_regression = meta_regression,
  Safety_totals = safety,
  Trial_audit = trial_audit,
  Corrected_continuous = cont,
  Corrected_dichotomous = dich,
  Included_study_characteristics = base,
  Risk_of_bias = rob
)
for (nm in names(sheet_data)) {
  item <- sheet_data[[nm]]
  addWorksheet(wb, nm)
  writeData(wb, nm, item)
  freezePane(wb, nm, firstRow = TRUE)
  setColWidths(wb, nm, cols = 1:ncol(item), widths = "auto")
}
saveWorkbook(wb, file.path(out_dir, "GERD_FM_reanalysis_revised.xlsx"), overwrite = TRUE)

cat("Reanalysis completed:", out_dir, "\n")
print(main_results)