################################################################################
# Supplementary Code S1
# Version: final_revision_v12
# Analysis code for: Information Reliability and Engagement Patterns of
# Alzheimer's Disease-Related Short Videos on Douyin and Bilibili
#
# Input file requirement:
#   The Excel file should contain one analytical worksheet with the following
#   English-language column names:
#   Video ID, Video length, Likes, Collections, Comments, Shares, Uploader, platform,
#   GQS1, GQS2, GQS scores,
#   mDISCERN1, mDISCERN2, modified DISCERN scores,
#   JAMA1, JAMA2, JAMA,
#   and binary content-category columns such as Epidemiology, Etiology, Symptoms,
#   Diagnosis, Treatment, and Prevention.
#
# Output:
#   All tables and figures are saved to an output folder named
#   "AD_analysis_outputs" in the same directory as the source Excel file.
################################################################################

# ==============================
# 0. Package setup
# ==============================
# IMPORTANT: Run this script from the beginning by clicking "Source" in RStudio.
# Do not start running from the middle of the package-installation section; otherwise
# objects such as `required_packages` will not exist.
required_packages <- c(
  "readxl", "dplyr", "tidyr", "stringr", "purrr", "ggplot2",
  "broom", "MASS", "car", "ResourceSelection", "pROC",
  "irr", "psych", "openxlsx", "scales", "officer", "flextable"
)

if (!exists("required_packages")) {
  required_packages <- c(
    "readxl", "dplyr", "tidyr", "stringr", "purrr", "ggplot2",
    "broom", "MASS", "car", "ResourceSelection", "pROC",
    "irr", "psych", "openxlsx", "scales", "officer", "flextable"
  )
}

installed <- rownames(installed.packages())
for (pkg in required_packages) {
  if (!pkg %in% installed) {
    install.packages(pkg, repos = "https://cloud.r-project.org")
  }
}

suppressPackageStartupMessages({
  library(readxl)
  library(dplyr)
  library(tidyr)
  library(stringr)
  library(purrr)
  library(ggplot2)
  library(broom)
  library(MASS)
  library(car)
  library(ResourceSelection)
  library(pROC)
  library(irr)
  library(psych)
  library(openxlsx)
  library(scales)
  library(officer)
  library(flextable)
})

# Avoid function-name conflicts after loading MASS/car.
# MASS also has a function named select(), which can mask dplyr::select().
select <- dplyr::select
recode <- dplyr::recode
filter <- dplyr::filter
rename <- dplyr::rename
mutate <- dplyr::mutate
summarise <- dplyr::summarise

# ==============================
# 1. Input and output paths
# ==============================
# The code first searches the folder containing this R script and the current
# R working directory. If the Excel file is still not found, an interactive
# file-selection window will open so that the dataset can be selected manually.

get_script_directory <- function() {
  script_path <- ""

  # When the script is run with Rscript.
  cmd_args <- commandArgs(trailingOnly = FALSE)
  file_arg <- grep("^--file=", cmd_args, value = TRUE)
  if (length(file_arg) > 0) {
    script_path <- sub("^--file=", "", file_arg[1])
  }

  # When the script is opened or sourced in RStudio.
  if (!nzchar(script_path) &&
      requireNamespace("rstudioapi", quietly = TRUE) &&
      rstudioapi::isAvailable()) {
    script_path <- tryCatch(
      rstudioapi::getSourceEditorContext()$path,
      error = function(e) ""
    )
  }

  if (nzchar(script_path) && file.exists(script_path)) {
    return(dirname(normalizePath(script_path, mustWork = TRUE)))
  }

  # Fallback for an unsaved script or a non-RStudio session.
  getwd()
}

script_dir <- get_script_directory()
working_dir <- getwd()
search_dirs <- unique(c(script_dir, working_dir))

message("R working directory: ", normalizePath(working_dir, mustWork = FALSE))
message("R script directory: ", normalizePath(script_dir, mustWork = FALSE))

# Accept the standard filename and duplicate-safe filenames such as:
# "Supplementary Dataset S1(3).xlsx".
candidate_inputs <- unique(unlist(lapply(search_dirs, function(folder) {
  if (!dir.exists(folder)) return(character())
  list.files(
    folder,
    pattern = "^Supplementary Dataset S1.*\\.xlsx$",
    full.names = TRUE,
    ignore.case = TRUE
  )
})))

candidate_inputs <- candidate_inputs[file.exists(candidate_inputs)]

# Prefer the exact standard filename when it is available. Otherwise, order
# duplicate-safe filenames by modification time so that the newest file is
# selected in non-interactive sessions.
exact_candidates <- file.path(search_dirs, "Supplementary Dataset S1.xlsx")
exact_candidates <- exact_candidates[file.exists(exact_candidates)]

if (length(candidate_inputs) > 1) {
  candidate_inputs <- candidate_inputs[
    order(file.info(candidate_inputs)$mtime, decreasing = TRUE)
  ]
}

if (length(exact_candidates) > 0) {
  input_file <- exact_candidates[1]
} else if (length(candidate_inputs) == 1) {
  input_file <- candidate_inputs[1]
} else if (length(candidate_inputs) > 1 && interactive()) {
  choice <- utils::menu(
    choices = basename(candidate_inputs),
    title = "Select the Supplementary Dataset S1 Excel file"
  )
  if (choice == 0) {
    stop("No input file was selected.")
  }
  input_file <- candidate_inputs[choice]
} else if (length(candidate_inputs) > 1) {
  input_file <- candidate_inputs[1]
  message(
    "Multiple candidate datasets were found. The most recently modified file was selected: ",
    basename(input_file)
  )
} else if (interactive()) {
  message(
    "The dataset was not found automatically. ",
    "Please select Supplementary Dataset S1.xlsx in the file-selection window."
  )
  input_file <- file.choose()

  if (!file.exists(input_file)) {
    stop("The selected input file does not exist.")
  }
  if (!grepl("\\.xlsx$", input_file, ignore.case = TRUE)) {
    stop("Please select an .xlsx file.")
  }
} else {
  stop(
    paste0(
      "Input file not found. Searched folders:\n- ",
      paste(search_dirs, collapse = "\n- "),
      "\nPlace Supplementary Dataset S1.xlsx in one of these folders ",
      "or run the script interactively and select the file manually."
    )
  )
}

input_file <- normalizePath(input_file, mustWork = TRUE)
message("Using input file: ", input_file)

source_dir <- dirname(input_file)
output_dir <- file.path(source_dir, "AD_analysis_outputs")
dir.create(output_dir, showWarnings = FALSE, recursive = TRUE)
message("Output folder: ", output_dir)

# ==============================
# 2. Read and clean data
# ==============================
raw <- readxl::read_excel(input_file, sheet = 1)

required_columns <- c(
  "Video ID", "Video length", "Likes", "Collections", "Comments", "Shares",
  "Uploader", "platform", "GQS1", "GQS2", "GQS scores",
  "mDISCERN1", "mDISCERN2", "modified DISCERN scores",
  "JAMA1", "JAMA2", "JAMA",
  "Epidemiology", "Etiology", "Symptoms", "Diagnosis", "Treatment", "Prevention"
)

missing_columns <- setdiff(required_columns, names(raw))
if (length(missing_columns) > 0) {
  stop(
    "The input dataset is missing the following required column(s): ",
    paste(missing_columns, collapse = ", ")
  )
}

# Standardize column names used internally in the analysis.
dat <- raw %>%
  rename(
    video_id = `Video ID`,
    video_length = `Video length`,
    likes = Likes,
    collections = Collections,
    comments = Comments,
    shares = Shares,
    uploader_raw = Uploader,
    platform_raw = platform,
    gqs_rater1 = GQS1,
    gqs_rater2 = GQS2,
    gqs = `GQS scores`,
    mdiscern_rater1 = mDISCERN1,
    mdiscern_rater2 = mDISCERN2,
    mdiscern = `modified DISCERN scores`,
    jama_rater1 = JAMA1,
    jama_rater2 = JAMA2,
    jama = JAMA
  ) %>%
  mutate(
    across(
      c(
        video_id, video_length, likes, collections, comments, shares,
        gqs_rater1, gqs_rater2, gqs,
        mdiscern_rater1, mdiscern_rater2, mdiscern,
        jama_rater1, jama_rater2, jama
      ),
      as.numeric
    ),
    platform_key = str_to_lower(str_squish(as.character(platform_raw))),
    platform = case_when(
      platform_key == "douyin" ~ "Douyin",
      platform_key == "bilibili" ~ "Bilibili",
      TRUE ~ NA_character_
    ),
    uploader_key = str_to_lower(str_squish(as.character(uploader_raw))),
    uploader_type = case_when(
      uploader_key %in% c("self-media", "self media") ~ "Self-media",
      uploader_key %in% c("physician", "doctor") ~ "Physician",
      uploader_key %in% c(
        "family members of patients",
        "family member of a patient",
        "family member/caregiver",
        "caregiver"
      ) ~ "Family members of patients",
      uploader_key %in% c(
        "official media",
        "official or institutional",
        "official/institutional",
        "institutional"
      ) ~ "Official media",
      TRUE ~ NA_character_
    )
  )

invalid_platforms <- unique(as.character(dat$platform_raw[is.na(dat$platform)]))
if (length(invalid_platforms) > 0) {
  stop(
    "Unrecognized platform value(s): ",
    paste(invalid_platforms, collapse = ", "),
    ". Expected values are Douyin and Bilibili."
  )
}

invalid_uploaders <- unique(as.character(dat$uploader_raw[is.na(dat$uploader_type)]))
if (length(invalid_uploaders) > 0) {
  stop(
    "Unrecognized uploader value(s): ",
    paste(invalid_uploaders, collapse = ", "),
    ". Expected categories are Family members of patients, Official media, ",
    "Physician, and Self-media."
  )
}

dat <- dat %>%
  mutate(
    platform = factor(platform, levels = c("Douyin", "Bilibili")),
    uploader_type = factor(
      uploader_type,
      levels = c(
        "Family members of patients",
        "Official media",
        "Physician",
        "Self-media"
      )
    ),
    # Binary uploader variable for regression: only physician-generated videos
    # are coded as Physician; all other uploader categories are Non-physician.
    uploader_binary = if_else(
      uploader_type == "Physician",
      "Physician",
      "Non-physician"
    ),
    uploader_binary = factor(
      uploader_binary,
      levels = c("Non-physician", "Physician")
    ),
    high_gqs = as.integer(gqs >= 3),
    high_mdiscern = as.integer(mdiscern >= 3),
    high_jama = as.integer(jama >= 2),
    ln_video_length = log1p(video_length),
    ln_likes = log1p(likes),
    ln_collections = log1p(collections),
    ln_comments = log1p(comments),
    ln_shares = log1p(shares)
  ) %>%
  dplyr::select(-platform_key, -uploader_key)

if (anyDuplicated(dat$video_id) > 0) {
  stop("Duplicate values were detected in the Video ID column.")
}

if (any(dat$video_length < 0, na.rm = TRUE) ||
    any(dat$likes < 0, na.rm = TRUE) ||
    any(dat$collections < 0, na.rm = TRUE) ||
    any(dat$comments < 0, na.rm = TRUE) ||
    any(dat$shares < 0, na.rm = TRUE)) {
  stop("Video length and engagement variables must not contain negative values.")
}

# Check original four-category and binary uploader classification.
uploader_type_check <- dat %>%
  dplyr::count(uploader_type, name = "n") %>%
  dplyr::arrange(uploader_type)

uploader_binary_check <- dat %>%
  dplyr::count(uploader_type, uploader_binary, name = "n") %>%
  dplyr::arrange(uploader_type, uploader_binary)

message("\nUploader four-category classification check:")
print(uploader_type_check)

message("\nUploader binary classification check:")
print(uploader_binary_check)

# Content-category columns included in the final analytical dataset.
content_cols <- intersect(
  c("Epidemiology", "Etiology", "Symptoms", "Diagnosis", "Treatment", "Prevention",
    "Caregiving", "Risk factors", "General disease knowledge"),
  names(raw)
)

# ==============================
# 3. Helper functions
# ==============================
median_iqr <- function(x) {
  x <- as.numeric(x)
  x <- x[!is.na(x)]
  if (length(x) == 0) return(NA_character_)
  sprintf("%.2f (%.2f–%.2f)", median(x), quantile(x, 0.25), quantile(x, 0.75))
}

n_pct <- function(x, total) {
  sprintf("%d/%d (%.1f)", x, total, 100 * x / total)
}

format_p <- function(p) {
  # Vectorized P-value formatter.
  # Works for both one P value and a vector of P values.
  p_num <- suppressWarnings(as.numeric(p))
  out <- rep(NA_character_, length(p_num))
  non_missing <- !is.na(p_num)
  out[non_missing & p_num < 0.001] <- "<.001"
  idx <- non_missing & p_num >= 0.001
  out[idx] <- sub("^0", "", sprintf("%.3f", p_num[idx]))
  out
}

or_ci <- function(or, low, high) {
  sprintf("%.2f (%.2f–%.2f)", or, low, high)
}

safe_chisq_p <- function(tab) {
  out <- tryCatch({
    suppressWarnings(chisq.test(tab)$p.value)
  }, error = function(e) NA_real_)
  if (is.na(out)) {
    out <- tryCatch(fisher.test(tab)$p.value, error = function(e) NA_real_)
  }
  out
}

# ==============================
# 4. De-identified analytical dataset
# ==============================
deidentified_dataset <- dat %>%
  dplyr::select(
    video_id, platform, video_length, uploader_type, uploader_binary,
    likes, collections, comments, shares,
    gqs_rater1, gqs_rater2, gqs,
    mdiscern_rater1, mdiscern_rater2, mdiscern,
    jama_rater1, jama_rater2, jama,
    high_gqs, high_mdiscern, high_jama,
    any_of(content_cols)
  )

write.csv(
  deidentified_dataset,
  file.path(output_dir, "Supplementary_Dataset_S1_deidentified_analytical_dataset.csv"),
  row.names = FALSE,
  fileEncoding = "UTF-8"
)

# ==============================
# 5. Descriptive tables
# ==============================
continuous_vars <- c("video_length", "likes", "collections", "comments", "shares", "gqs", "mdiscern", "jama")
continuous_labels <- c(
  video_length = "Video length, seconds",
  likes = "Likes",
  collections = "Collections",
  comments = "Comments",
  shares = "Shares",
  gqs = "GQS score",
  mdiscern = "mDISCERN score",
  jama = "JAMA score"
)

# Table 1: overall characteristics
cat_platform <- dat %>% count(platform) %>% mutate(Value = sprintf("%d (%.2f%%)", n, 100*n/sum(n))) %>%
  transmute(Variable = paste0("Platform: ", platform), Total = Value)
cat_uploader <- dat %>% count(uploader_type) %>% mutate(Value = sprintf("%d (%.2f%%)", n, 100*n/sum(n))) %>%
  transmute(Variable = paste0("Uploader type: ", uploader_type), Total = Value)
cont_overall <- map_dfr(continuous_vars, function(v) {
  tibble(Variable = continuous_labels[[v]], Total = median_iqr(dat[[v]]))
})
Table1 <- bind_rows(cat_platform, cat_uploader, cont_overall)

# Table 2: by platform
Table2 <- map_dfr(continuous_vars, function(v) {
  p <- wilcox.test(dat[[v]] ~ dat$platform)$p.value
  tibble(
    Variable = continuous_labels[[v]],
    Douyin = median_iqr(dat %>% filter(platform == "Douyin") %>% pull(v)),
    Bilibili = median_iqr(dat %>% filter(platform == "Bilibili") %>% pull(v)),
    P = format_p(p)
  )
})

# Table 3: by uploader type
Table3 <- map_dfr(continuous_vars, function(v) {
  p <- kruskal.test(dat[[v]] ~ dat$uploader_type)$p.value
  tibble(
    Variable = continuous_labels[[v]],
    `Family members of patients` = median_iqr(dat %>% filter(uploader_type == "Family members of patients") %>% pull(v)),
    `Official media` = median_iqr(dat %>% filter(uploader_type == "Official media") %>% pull(v)),
    `Physician` = median_iqr(dat %>% filter(uploader_type == "Physician") %>% pull(v)),
    `Self-media` = median_iqr(dat %>% filter(uploader_type == "Self-media") %>% pull(v)),
    P = format_p(p)
  )
})

# Outcome counts
Outcome_counts <- tibble(
  Outcome = c("GQS ≥3", "mDISCERN ≥3", "JAMA ≥2"),
  Events = c(sum(dat$high_gqs == 1, na.rm = TRUE), sum(dat$high_mdiscern == 1, na.rm = TRUE), sum(dat$high_jama == 1, na.rm = TRUE)),
  N = nrow(dat)
) %>%
  mutate(
    `Events, n/N (%)` = sprintf("%d/%d (%.1f)", Events, N, 100*Events/N),
    `Non-events, n/N (%)` = sprintf("%d/%d (%.1f)", N-Events, N, 100*(N-Events)/N)
  ) %>%
  dplyr::select(Outcome, `Events, n/N (%)`, `Non-events, n/N (%)`)

# ==============================
# 6. Inter-rater agreement
# ==============================
# Robust manual Cohen kappa and quadratic-weighted Cohen kappa.
# This avoids empty outputs caused by package-version differences in irr::kappa2().
manual_kappa <- function(x, y, levels_vec, weighted = FALSE) {
  x <- as.numeric(x)
  y <- as.numeric(y)
  keep <- !is.na(x) & !is.na(y)
  x <- x[keep]
  y <- y[keep]
  if (length(x) == 0) return(NA_real_)

  x <- factor(x, levels = levels_vec)
  y <- factor(y, levels = levels_vec)
  tab <- table(x, y)
  n <- sum(tab)
  if (n == 0) return(NA_real_)

  obs <- as.matrix(tab) / n
  row_marg <- rowSums(obs)
  col_marg <- colSums(obs)
  exp <- outer(row_marg, col_marg)

  k <- length(levels_vec)
  if (!weighted) {
    po <- sum(diag(obs))
    pe <- sum(diag(exp))
    if (isTRUE(all.equal(1, pe))) return(NA_real_)
    return((po - pe) / (1 - pe))
  }

  # Quadratic disagreement weights: 0 on diagonal, 1 for maximum disagreement.
  if (k <= 1) return(NA_real_)
  W <- outer(seq_len(k), seq_len(k), function(i, j) ((i - j) / (k - 1))^2)
  obs_disagreement <- sum(W * obs)
  exp_disagreement <- sum(W * exp)
  if (isTRUE(all.equal(0, exp_disagreement))) return(NA_real_)
  1 - obs_disagreement / exp_disagreement
}

# ICC(2,1), two-way random-effects, absolute-agreement, single-measure ICC.
manual_icc2_1 <- function(x, y) {
  dat_icc <- data.frame(r1 = as.numeric(x), r2 = as.numeric(y)) %>% tidyr::drop_na()
  if (nrow(dat_icc) < 2) return(NA_real_)
  X <- as.matrix(dat_icc)
  n <- nrow(X)
  k <- ncol(X)

  grand_mean <- mean(X)
  subj_means <- rowMeans(X)
  rater_means <- colMeans(X)

  ss_subject <- k * sum((subj_means - grand_mean)^2)
  ss_rater <- n * sum((rater_means - grand_mean)^2)
  ss_total <- sum((X - grand_mean)^2)
  ss_error <- ss_total - ss_subject - ss_rater

  ms_subject <- ss_subject / (n - 1)
  ms_rater <- ss_rater / (k - 1)
  ms_error <- ss_error / ((n - 1) * (k - 1))

  (ms_subject - ms_error) / (ms_subject + (k - 1) * ms_error + k * (ms_rater - ms_error) / n)
}

calc_agreement <- function(data, instrument, r1, r2, score_levels) {
  # Stop clearly if a rater column is missing.
  missing_cols <- setdiff(c(r1, r2), names(data))
  if (length(missing_cols) > 0) {
    stop("Missing rater columns for ", instrument, ": ", paste(missing_cols, collapse = ", "))
  }

  tmp <- data %>%
    dplyr::select(r1 = dplyr::all_of(r1), r2 = dplyr::all_of(r2)) %>%
    dplyr::mutate(
      r1 = as.numeric(r1),
      r2 = as.numeric(r2)
    ) %>%
    tidyr::drop_na()

  n_pair <- nrow(tmp)
  exact_n <- if (n_pair > 0) sum(tmp$r1 == tmp$r2) else 0

  simple_kappa <- manual_kappa(tmp$r1, tmp$r2, score_levels, weighted = FALSE)
  qwk <- manual_kappa(tmp$r1, tmp$r2, score_levels, weighted = TRUE)
  icc21 <- manual_icc2_1(tmp$r1, tmp$r2)

  tibble(
    Instrument = instrument,
    N = n_pair,
    `Exact agreement, n/N (%)` = ifelse(
      n_pair > 0,
      sprintf("%d/%d (%.1f)", exact_n, n_pair, 100 * exact_n / n_pair),
      "0/0 (NA)"
    ),
    `Simple Cohen kappa` = round(simple_kappa, 3),
    `Quadratic-weighted Cohen kappa` = round(qwk, 3),
    `ICC(2,1)` = round(icc21, 3),
    `ICC 95% CI` = NA_character_
  )
}

Agreement <- bind_rows(
  calc_agreement(dat, "GQS", "gqs_rater1", "gqs_rater2", 1:5),
  calc_agreement(dat, "mDISCERN", "mdiscern_rater1", "mdiscern_rater2", 0:5),
  calc_agreement(dat, "JAMA", "jama_rater1", "jama_rater2", 0:4)
)

if (nrow(Agreement) == 0) {
  stop("Inter-rater agreement table is empty. Please check GQS1/GQS2, mDISCERN1/mDISCERN2, and JAMA1/JAMA2 columns.")
}

message("\nInter-rater agreement results:")
print(Agreement)

# ==============================
# 7. Multivariable logistic regression
# ==============================
predictor_formula <- "uploader_binary + platform + ln_video_length + ln_likes + ln_collections + ln_comments"
logistic_formulas <- list(
  `GQS ≥3` = as.formula(paste("high_gqs ~", predictor_formula)),
  `mDISCERN ≥3` = as.formula(paste("high_mdiscern ~", predictor_formula)),
  `JAMA ≥2` = as.formula(paste("high_jama ~", predictor_formula))
)

term_labels <- c(
  "uploader_binaryPhysician" = "Uploader (Physician vs Non-physician)",
  "platformBilibili" = "Platform (Bilibili vs Douyin)",
  "ln_video_length" = "ln(1 + video length, seconds)",
  "ln_likes" = "ln(1 + likes)",
  "ln_collections" = "ln(1 + collections)",
  "ln_comments" = "ln(1 + comments)"
)

fit_glm_safe <- function(formula, data) {
  warnings <- character()
  fit <- withCallingHandlers(
    glm(formula, data = data, family = binomial()),
    warning = function(w) {
      warnings <<- c(warnings, conditionMessage(w))
      invokeRestart("muffleWarning")
    }
  )
  attr(fit, "warnings") <- warnings
  fit
}

logistic_fits <- map(logistic_formulas, fit_glm_safe, data = dat)

extract_logistic <- function(fit, outcome) {
  broom::tidy(fit, conf.int = TRUE, exponentiate = TRUE) %>%
    filter(term != "(Intercept)") %>%
    mutate(
      Variable = dplyr::recode(term, !!!term_labels),
      Outcome = outcome,
      `OR (95% CI)` = or_ci(estimate, conf.low, conf.high),
      P = map_chr(p.value, format_p)
    ) %>%
    dplyr::select(Outcome, Variable, `OR (95% CI)`, P)
}

Table4_long <- imap_dfr(logistic_fits, extract_logistic)
Table4 <- Table4_long %>%
  dplyr::select(Variable, Outcome, `OR (95% CI)`) %>%
  pivot_wider(names_from = Outcome, values_from = `OR (95% CI)`) %>%
  arrange(match(Variable, unname(term_labels)))

Table4_pvalues <- Table4_long %>%
  dplyr::select(Variable, Outcome, P) %>%
  pivot_wider(names_from = Outcome, values_from = P) %>%
  arrange(match(Variable, unname(term_labels)))


# ==============================
# 7b. Reduced-model sensitivity analyses for multicollinearity
# ==============================
# To reduce collinearity among engagement variables, likes, collections,
# and comments are entered one at a time. Each reduced model retains the
# prespecified core covariates: uploader type, platform, and video length.

reduced_engagement_terms <- c(
  "ln_likes" = "Likes",
  "ln_collections" = "Collections",
  "ln_comments" = "Comments"
)

reduced_outcomes <- c(
  "high_gqs" = "GQS ≥3",
  "high_mdiscern" = "mDISCERN ≥3",
  "high_jama" = "JAMA ≥2"
)

extract_reduced_model <- function(outcome_var, outcome_label, engagement_term, engagement_label) {
  reduced_formula <- as.formula(
    paste(outcome_var, "~ uploader_binary + platform + ln_video_length +", engagement_term)
  )
  fit <- fit_glm_safe(reduced_formula, dat)

  # Wald 95% confidence intervals, matching the main Table 4 presentation.
  broom::tidy(fit) %>%
    filter(term != "(Intercept)") %>%
    mutate(
      conf.low = estimate - 1.96 * std.error,
      conf.high = estimate + 1.96 * std.error,
      OR = exp(estimate),
      OR_low = exp(conf.low),
      OR_high = exp(conf.high),
      Outcome = outcome_label,
      `Reduced model` = paste0(engagement_label, " entered separately"),
      `Engagement predictor` = engagement_label,
      Variable = dplyr::recode(
        term,
        uploader_binaryPhysician = "Uploader (Physician vs Non-physician)",
        platformBilibili = "Platform (Bilibili vs Douyin)",
        ln_video_length = "ln(1 + video length, seconds)",
        ln_likes = "ln(1 + likes)",
        ln_collections = "ln(1 + collections)",
        ln_comments = "ln(1 + comments)"
      ),
      `OR (95% CI)` = or_ci(OR, OR_low, OR_high),
      P = format_p(p.value)
    ) %>%
    dplyr::select(
      Outcome, `Reduced model`, `Engagement predictor`,
      Variable, `OR (95% CI)`, P, OR, OR_low, OR_high, p.value
    )
}

Reduced_model_long <- purrr::imap_dfr(reduced_outcomes, function(outcome_label, outcome_var) {
  purrr::imap_dfr(reduced_engagement_terms, function(engagement_label, engagement_term) {
    extract_reduced_model(
      outcome_var = outcome_var,
      outcome_label = outcome_label,
      engagement_term = engagement_term,
      engagement_label = engagement_label
    )
  })
})

# Compact table for submission: one row per outcome and engagement-specific reduced model.
TableS6 <- Reduced_model_long %>%
  dplyr::select(
    Outcome, `Reduced model`, `Engagement predictor`,
    Variable, `OR (95% CI)`, P
  ) %>%
  tidyr::pivot_wider(
    names_from = Variable,
    values_from = c(`OR (95% CI)`, P),
    names_glue = "{Variable}__{.value}"
  ) %>%
  dplyr::transmute(
    Outcome,
    `Reduced model`,
    `Uploader (Physician vs Non-physician), OR (95% CI)` =
      `Uploader (Physician vs Non-physician)__OR (95% CI)`,
    `Platform (Bilibili vs Douyin), OR (95% CI)` =
      `Platform (Bilibili vs Douyin)__OR (95% CI)`,
    `ln(1 + video length, seconds), OR (95% CI)` =
      `ln(1 + video length, seconds)__OR (95% CI)`,
    `Engagement predictor`,
    `Engagement predictor, OR (95% CI)` = dplyr::case_when(
      `Engagement predictor` == "Likes" ~ `ln(1 + likes)__OR (95% CI)`,
      `Engagement predictor` == "Collections" ~ `ln(1 + collections)__OR (95% CI)`,
      `Engagement predictor` == "Comments" ~ `ln(1 + comments)__OR (95% CI)`
    ),
    `Engagement predictor, P` = dplyr::case_when(
      `Engagement predictor` == "Likes" ~ `ln(1 + likes)__P`,
      `Engagement predictor` == "Collections" ~ `ln(1 + collections)__P`,
      `Engagement predictor` == "Comments" ~ `ln(1 + comments)__P`
    )
  ) %>%
  dplyr::arrange(
    factor(Outcome, levels = c("GQS ≥3", "mDISCERN ≥3", "JAMA ≥2")),
    factor(`Engagement predictor`, levels = c("Likes", "Collections", "Comments"))
  )

# Narrow long-format version used for the submission-ready Word file.
TableS6_word <- Reduced_model_long %>%
  dplyr::select(Outcome, `Reduced model`, Variable, `OR (95% CI)`, P)

message("\nReduced-model sensitivity analyses:")
print(TableS6)

# ==============================
# 8. Ordinal logistic regression sensitivity analyses
# ==============================
extract_polr <- function(outcome_var, outcome_label, levels_vec) {
  tmp <- dat %>% mutate(y_ord = ordered(.data[[outcome_var]], levels = levels_vec))
  fit <- MASS::polr(as.formula(paste("y_ord ~", predictor_formula)), data = tmp, Hess = TRUE, method = "logistic")
  co <- coef(summary(fit))
  co <- co[!str_detect(rownames(co), "\\|"), , drop = FALSE]
  est <- co[, "Value"]
  se <- co[, "Std. Error"]
  tibble(
    Outcome = outcome_label,
    term = rownames(co),
    Variable = dplyr::recode(term, !!!term_labels),
    OR = exp(est),
    conf.low = exp(est - 1.96*se),
    conf.high = exp(est + 1.96*se),
    `OR (95% CI)` = or_ci(OR, conf.low, conf.high),
    P = format_p(2 * pnorm(abs(est / se), lower.tail = FALSE))
  ) %>%
    dplyr::select(Outcome, Variable, `OR (95% CI)`, P)
}

Ordinal_long <- bind_rows(
  extract_polr("gqs", "GQS", 1:5),
  extract_polr("mdiscern", "mDISCERN", 0:5),
  extract_polr("jama", "JAMA", 0:4)
)

TableS4 <- Ordinal_long %>%
  dplyr::select(Variable, Outcome, `OR (95% CI)`) %>%
  pivot_wider(names_from = Outcome, values_from = `OR (95% CI)`) %>%
  arrange(match(Variable, unname(term_labels)))

TableS4_pvalues <- Ordinal_long %>%
  dplyr::select(Variable, Outcome, P) %>%
  pivot_wider(names_from = Outcome, values_from = P) %>%
  arrange(match(Variable, unname(term_labels)))

# ==============================
# 9. Regression diagnostics
# ==============================
# VIFs are the same across models because the predictors are the same.
# To avoid package-version differences in car::vif(), VIF is calculated manually
# from the exact predictor matrix used in the GQS logistic model.
manual_vif <- function(fit) {
  X <- stats::model.matrix(fit)
  X <- X[, colnames(X) != "(Intercept)", drop = FALSE]
  out <- sapply(seq_len(ncol(X)), function(j) {
    y <- X[, j]
    others <- X[, -j, drop = FALSE]
    if (ncol(others) == 0) return(1)
    r2 <- summary(stats::lm(y ~ others))$r.squared
    1 / (1 - r2)
  })
  names(out) <- colnames(X)
  out
}

vif_values <- manual_vif(logistic_fits[["GQS ≥3"]])

VIF_table <- tibble(
  Variable = dplyr::recode(names(vif_values),
                    uploader_binaryPhysician = "Uploader (Physician vs Non-physician)",
                    platformBilibili = "Platform (Bilibili vs Douyin)",
                    ln_video_length = "ln(1 + video length, seconds)",
                    ln_likes = "ln(1 + likes)",
                    ln_collections = "ln(1 + collections)",
                    ln_comments = "ln(1 + comments)"),
  VIF = round(as.numeric(vif_values), 2)
)

message("\nVIF results calculated from the Table 4 predictor matrix:")
print(VIF_table)

model_diagnostics <- imap_dfr(logistic_fits, function(fit, outcome) {
  y <- model.response(model.frame(fit))
  pred <- fitted(fit)
  hl <- tryCatch(ResourceSelection::hoslem.test(y, pred, g = 10), error = function(e) NULL)
  auc <- as.numeric(pROC::auc(pROC::roc(y, pred, quiet = TRUE)))
  fit_warnings <- attr(fit, "warnings")
  possible_sep <- any(str_detect(fit_warnings, "fitted probabilities numerically 0 or 1|algorithm did not converge")) ||
    any(!is.finite(coef(fit)))
  new_physician <- dat
  new_physician$uploader_binary <- factor("Physician", levels = levels(dat$uploader_binary))
  new_nonphysician <- dat
  new_nonphysician$uploader_binary <- factor("Non-physician", levels = levels(dat$uploader_binary))
  tibble(
    Outcome = outcome,
    `Events, n/N (%)` = n_pct(sum(y == 1, na.rm = TRUE), length(y)),
    `Non-events, n/N (%)` = n_pct(sum(y == 0, na.rm = TRUE), length(y)),
    `Model converged` = if_else(fit$converged, "Yes", "No"),
    `Complete separation` = if_else(possible_sep, "Possible", "No"),
    `Hosmer-Lemeshow chi-square (df)` = if (!is.null(hl)) sprintf("%.2f (%d)", hl$statistic, hl$parameter) else NA_character_,
    `Hosmer-Lemeshow P value` = if (!is.null(hl)) format_p(hl$p.value) else NA_character_,
    `c-statistic` = round(auc, 3),
    `Adjusted predicted probability if Physician (%)` = round(mean(predict(fit, newdata = new_physician, type = "response"))*100, 1),
    `Adjusted predicted probability if Non-physician (%)` = round(mean(predict(fit, newdata = new_nonphysician, type = "response"))*100, 1)
  )
})

# ==============================
# 10. Correlation analyses
# ==============================
corr_vars <- c("video_length", "likes", "collections", "comments", "shares", "gqs", "mdiscern", "jama")
corr_labels <- c(
  video_length = "Video length",
  likes = "Likes",
  collections = "Collections",
  comments = "Comments",
  shares = "Shares",
  gqs = "GQS",
  mdiscern = "mDISCERN",
  jama = "JAMA"
)

Corr_long <- map_dfr(levels(dat$platform), function(pl) {
  subdat <- dat %>% filter(platform == pl) %>% dplyr::select(all_of(corr_vars))
  mat <- cor(subdat, use = "pairwise.complete.obs", method = "spearman")
  as.data.frame(as.table(mat)) %>%
    rename(Variable1 = Var1, Variable2 = Var2, Spearman_r = Freq) %>%
    mutate(
      Platform = pl,
      Variable1 = dplyr::recode(as.character(Variable1), !!!corr_labels),
      Variable2 = dplyr::recode(as.character(Variable2), !!!corr_labels)
    )
})

# ==============================
# 11. Figures
# ==============================
# Colors chosen to match the manuscript figures.
# Figure 2 category colors match the uploaded manuscript-style plot.
category_colors <- c(
  "Diagnosis" = "#E64B35",
  "Epidemiology" = "#4DBBD5",
  "Etiology" = "#00A087",
  "Prevention" = "#3C5488",
  "Symptoms" = "#F39B7F",
  "Treatment" = "#8491B4",
  "Caregiving" = "#91D1C2",
  "Risk factors" = "#DC0000",
  "General disease knowledge" = "#7E6148"
)

# Figure 3 platform colors use the same visual family as Figure 2.
platform_colors <- c("Douyin" = "#4DBBD5", "Bilibili" = "#E64B35")

# Figure 2: Content categories by platform
if (length(content_cols) > 0) {
  content_summary <- dat %>%
    dplyr::select(platform, all_of(content_cols)) %>%
    pivot_longer(cols = all_of(content_cols), names_to = "Category", values_to = "Included") %>%
    mutate(Included = as.numeric(Included)) %>%
    group_by(platform, Category) %>%
    summarise(Count = sum(Included, na.rm = TRUE), .groups = "drop")

  # Keep only colors for categories present in the dataset; missing categories will use default colors.
  present_category_colors <- category_colors[names(category_colors) %in% unique(content_summary$Category)]

  p_fig2 <- ggplot(content_summary, aes(x = platform, y = Count, fill = Category)) +
    geom_col(position = position_dodge(width = 0.8), width = 0.7) +
    geom_text(aes(label = Count), position = position_dodge(width = 0.8), vjust = -0.25, size = 3.2, color = "white") +
    scale_fill_manual(values = present_category_colors) +
    labs(x = "Platform", y = "Number of videos", fill = "Category") +
    theme_minimal(base_size = 12) +
    theme(
      panel.grid.minor = element_blank(),
      legend.position = "right",
      axis.title = element_text(color = "black"),
      axis.text = element_text(color = "grey30")
    )

  ggsave(file.path(output_dir, "Figure2_content_categories.png"), p_fig2, width = 8.5, height = 5.2, dpi = 600)
  ggsave(file.path(output_dir, "Figure2_content_categories.tiff"), p_fig2, width = 8.5, height = 5.2, dpi = 600, compression = "lzw")
}

# Figure 3: Three-in-one bar plot for discrete quality scores
score_long <- bind_rows(
  dat %>% transmute(platform, Instrument = "GQS", Score = gqs, Score_factor = factor(gqs, levels = 1:5)),
  dat %>% transmute(platform, Instrument = "mDISCERN", Score = mdiscern, Score_factor = factor(mdiscern, levels = 0:5)),
  dat %>% transmute(platform, Instrument = "JAMA", Score = jama, Score_factor = factor(jama, levels = 0:4))
) %>%
  count(Instrument, platform, Score_factor, name = "Count") %>%
  tidyr::complete(Instrument, platform, Score_factor, fill = list(Count = 0))

p_fig3 <- ggplot(score_long, aes(x = Score_factor, y = Count, fill = platform)) +
  geom_col(position = position_dodge(width = 0.75), width = 0.65) +
  geom_text(aes(label = ifelse(Count > 0, Count, "")),
            position = position_dodge(width = 0.75), vjust = -0.25, size = 3.0, color = "black") +
  facet_wrap(~Instrument, scales = "free_x", nrow = 1) +
  scale_fill_manual(values = platform_colors, name = "Platform") +
  labs(x = "Score", y = "Number of videos") +
  theme_minimal(base_size = 12) +
  theme(
    panel.grid.minor = element_blank(),
    legend.position = "right",
    strip.text = element_text(face = "bold"),
    axis.title = element_text(color = "black"),
    axis.text = element_text(color = "black")
  )

ggsave(file.path(output_dir, "Figure3_quality_score_distribution.png"), p_fig3, width = 10, height = 4.6, dpi = 600)
ggsave(file.path(output_dir, "Figure3_quality_score_distribution.tiff"), p_fig3, width = 10, height = 4.6, dpi = 600, compression = "lzw")

# Figure 4: Correlation heatmap by platform
corr_order <- c("Video length", "Likes", "Collections", "Comments", "Shares", "GQS", "mDISCERN", "JAMA")
Corr_long <- Corr_long %>%
  mutate(
    Variable1 = factor(Variable1, levels = corr_order),
    Variable2 = factor(Variable2, levels = rev(corr_order))
  )

p_fig4 <- ggplot(Corr_long, aes(x = Variable1, y = Variable2, fill = Spearman_r)) +
  geom_tile(color = "white", linewidth = 0.3) +
  geom_text(aes(label = sprintf("%.2f", Spearman_r)), size = 2.8) +
  scale_fill_gradient2(low = "#0000FF", mid = "white", high = "#FF0000", midpoint = 0,
                       limits = c(-1, 1), name = "Spearman r") +
  facet_wrap(~Platform, nrow = 1) +
  labs(x = NULL, y = NULL) +
  theme_minimal(base_size = 11) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    panel.grid = element_blank(),
    legend.position = "right"
  )

ggsave(file.path(output_dir, "Figure4_correlation_heatmap.png"), p_fig4, width = 11.5, height = 5.5, dpi = 600)
ggsave(file.path(output_dir, "Figure4_correlation_heatmap.tiff"), p_fig4, width = 11.5, height = 5.5, dpi = 600, compression = "lzw")

# ==============================
# 12. Save all tables to Excel and CSV files
# ==============================
wb <- openxlsx::createWorkbook()
add_sheet <- function(wb, sheet_name, data) {
  openxlsx::addWorksheet(wb, sheet_name)
  openxlsx::writeData(wb, sheet_name, data)
  openxlsx::setColWidths(wb, sheet_name, cols = 1:ncol(data), widths = "auto")
}

add_sheet(wb, "Uploader_type_check", uploader_type_check)
add_sheet(wb, "Uploader_binary_check", uploader_binary_check)
add_sheet(wb, "Table1_overall", Table1)
add_sheet(wb, "Table2_by_platform", Table2)
add_sheet(wb, "Table3_by_uploader", Table3)
add_sheet(wb, "Outcome_counts", Outcome_counts)
add_sheet(wb, "Inter_rater_agreement", Agreement)
add_sheet(wb, "Table4_logistic_OR", Table4)
add_sheet(wb, "Table4_logistic_P", Table4_pvalues)
add_sheet(wb, "TableS4_ordinal_OR", TableS4)
add_sheet(wb, "TableS4_ordinal_P", TableS4_pvalues)
add_sheet(wb, "TableS5_VIF", VIF_table)
add_sheet(wb, "TableS5_model_diagnostics", model_diagnostics)
add_sheet(wb, "TableS6_reduced_summary", TableS6)
add_sheet(wb, "TableS6_reduced_long", Reduced_model_long)
add_sheet(wb, "Correlation_long", Corr_long)

openxlsx::saveWorkbook(wb, file.path(output_dir, "AD_analysis_results_tables.xlsx"), overwrite = TRUE)

# ==============================
# 12b. Save tables directly as Word files
# ==============================
# This creates one combined Word file containing all manuscript and supplementary tables.
# If Word export fails, update officer and flextable with:
# install.packages(c("officer", "flextable"), repos = "https://cloud.r-project.org")
format_flextable <- function(x) {
  flextable::flextable(x) %>%
    flextable::theme_booktabs() %>%
    flextable::fontsize(size = 9, part = "all") %>%
    flextable::font(fontname = "Times New Roman", part = "all") %>%
    flextable::align(align = "center", part = "all") %>%
    flextable::align(j = 1, align = "left", part = "body") %>%
    flextable::autofit()
}

table_notes <- list(
  "Table 1. Characteristics of included videos from Douyin and Bilibili" = c(
    "Abbreviations: GQS, Global Quality Score; mDISCERN, modified DISCERN; JAMA, Journal of the American Medical Association.",
    "Note: Data are presented as median (interquartile range) for continuous variables and n (%) for categorical variables."
  ),
  "Table 2. Comparison of video characteristics and engagement metrics between Douyin and Bilibili" = c(
    "Abbreviations: GQS, Global Quality Score; mDISCERN, modified DISCERN; JAMA, Journal of the American Medical Association."
  ),
  "Table 3. Comparison of informational quality scores across uploader types" = c(
    "Abbreviations: GQS, Global Quality Score; mDISCERN, modified DISCERN; JAMA, Journal of the American Medical Association."
  ),
  "Table 4. Multivariable logistic regression models across GQS, mDISCERN, and JAMA outcomes" = c(
    "Abbreviations: GQS, Global Quality Score; mDISCERN, modified DISCERN; JAMA, Journal of the American Medical Association; OR, odds ratio; CI, confidence interval.",
    "Note: High-quality videos were defined as GQS >=3, mDISCERN >=3, and JAMA >=2, respectively. Continuous variables were log-transformed using ln(1+x). Additional ordinal logistic regression analyses using the original GQS, mDISCERN, and JAMA scores were conducted as sensitivity analyses and are presented in Supplementary Table S4."
  ),
  "Supplementary Table S4. Ordinal logistic regression analyses using original scores" = c(
    "Abbreviations: GQS, Global Quality Score; mDISCERN, modified DISCERN; JAMA, Journal of the American Medical Association; OR, odds ratio; CI, confidence interval.",
    "Note: Multivariable proportional odds ordinal logistic regression models were fitted using the original ordinal scores. OR > 1 indicates higher odds of being in a higher score category. Engagement variables were log-transformed using ln(1+x)."
  ),
  "Supplementary Table S5A. Multicollinearity diagnostics" = c(
    "Abbreviation: VIF, variance inflation factor."
  ),
  "Supplementary Table S5B. Model diagnostics" = c(
    "Abbreviations: GQS, Global Quality Score; mDISCERN, modified DISCERN; JAMA, Journal of the American Medical Association.",
    "Note: Multivariable logistic regression models used the same predictors as Table 4. Continuous predictors were log-transformed using ln(1+x). The Hosmer-Lemeshow test was calculated using deciles of predicted risk. Adjusted predicted probabilities were estimated by marginal standardization, setting uploader type to physician-generated or non-physician-generated."
  ),
  "Supplementary Table S6. Reduced-model sensitivity analyses" = c(
    "Abbreviations: GQS, Global Quality Score; mDISCERN, modified DISCERN; JAMA, Journal of the American Medical Association; OR, odds ratio; CI, confidence interval.",
    "Note: To assess the influence of multicollinearity among the engagement variables, separate multivariable logistic regression models were fitted for likes, collections, and comments. Each model retained uploader type, platform, and video length. Continuous variables were transformed using ln(1+x)."
  )
)

add_table_to_doc <- function(doc, title, data) {
  doc <- officer::body_add_par(doc, title, style = "heading 1")
  doc <- flextable::body_add_flextable(doc, value = format_flextable(data))

  if (title %in% names(table_notes)) {
    for (note_text in table_notes[[title]]) {
      doc <- officer::body_add_par(doc, note_text, style = "Normal")
    }
  }

  doc <- officer::body_add_par(doc, "", style = "Normal")
  doc
}

tables_for_word <- list(
  "Uploader four-category classification check" = uploader_type_check,
  "Uploader binary classification check" = uploader_binary_check,
  "Table 1. Characteristics of included videos from Douyin and Bilibili" = Table1,
  "Table 2. Comparison of video characteristics and engagement metrics between Douyin and Bilibili" = Table2,
  "Table 3. Comparison of informational quality scores across uploader types" = Table3,
  "Outcome counts for binary quality definitions" = Outcome_counts,
  "Inter-rater agreement for quality scoring" = Agreement,
  "Table 4. Multivariable logistic regression models across GQS, mDISCERN, and JAMA outcomes" = Table4,
  "Supplementary Table S4. Ordinal logistic regression analyses using original scores" = TableS4,
  "Supplementary Table S5A. Multicollinearity diagnostics" = VIF_table,
  "Supplementary Table S5B. Model diagnostics" = model_diagnostics,
  "Supplementary Table S6. Reduced-model sensitivity analyses" = TableS6_word
)

doc_all <- officer::read_docx()
for (nm in names(tables_for_word)) {
  doc_all <- add_table_to_doc(doc_all, nm, tables_for_word[[nm]])
}
print(doc_all, target = file.path(output_dir, "AD_analysis_tables_for_submission.docx"))

# Also create individual Word files for key tables.
for (nm in names(tables_for_word)) {
  safe_name <- gsub("[^A-Za-z0-9]+", "_", nm)
  safe_name <- gsub("^_|_$", "", safe_name)
  doc_one <- officer::read_docx()
  doc_one <- add_table_to_doc(doc_one, nm, tables_for_word[[nm]])
  print(doc_one, target = file.path(output_dir, paste0(safe_name, ".docx")))
}

# Also save major tables as CSV files.
write.csv(uploader_type_check, file.path(output_dir, "Uploader_type_check.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(uploader_binary_check, file.path(output_dir, "Uploader_binary_check.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(Table1, file.path(output_dir, "Table1_overall.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(Table2, file.path(output_dir, "Table2_by_platform.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(Table3, file.path(output_dir, "Table3_by_uploader.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(Agreement, file.path(output_dir, "Inter_rater_agreement.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(Table4, file.path(output_dir, "Table4_logistic_OR.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(TableS4, file.path(output_dir, "TableS4_ordinal_OR.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(VIF_table, file.path(output_dir, "TableS5_VIF.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(model_diagnostics, file.path(output_dir, "TableS5_model_diagnostics.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(TableS6, file.path(output_dir, "TableS6_reduced_model_summary.csv"), row.names = FALSE, fileEncoding = "UTF-8")
write.csv(Reduced_model_long, file.path(output_dir, "TableS6_reduced_model_long.csv"), row.names = FALSE, fileEncoding = "UTF-8")

# ==============================
# 13. Session information
# ==============================
sink(file.path(output_dir, "R_session_info.txt"))
print(sessionInfo())
sink()

message("Analysis completed successfully.")
message("Word tables were saved as: ", file.path(output_dir, "AD_analysis_tables_for_submission.docx"))
message("Uploader binary classification check was saved as Uploader_binary_check.csv and included in the Word/Excel outputs.")
message("Inter-rater agreement was saved in the Excel file, CSV file, and Word table.")
message("Reduced-model sensitivity analyses were saved as Supplementary Table S6 in Excel, CSV, and Word formats.")
message("All outputs were saved to: ", output_dir)