# Supplementary Methods: Key R code for Fine-Gray competing-risk analysis
#
# This script is de-identified for supplementary material.
# It contains no patient identifiers, institution names, local file paths,
# medical record numbers, or individual-level source data.
#
# Required input:
#   A de-identified dataset named "deidentified_analysis_dataset.csv"
#   with one row per patient and variables listed in Section 2.
#
# Main analysis:
#   Fine-Gray competing-risk regression for VTE, with death without prior VTE
#   treated as the competing event.

# 1. Required packages

required_packages <- c(
  "readr", "dplyr", "tidyr", "purrr", "tibble", "cmprsk"
)

new_packages <- required_packages[
  !required_packages %in% rownames(installed.packages())
]

if (length(new_packages) > 0) {
  install.packages(new_packages, dependencies = TRUE)
}

invisible(lapply(required_packages, library, character.only = TRUE))

# 2. Expected variable definitions

# Patient-level time-to-event variables:
#   VTE_num: 0 = no VTE/censored; 1 = VTE; 2 = death without prior VTE
#   VTEtime: time from ICI initiation to VTE, competing death, or censoring
#   Dead_num: 0 = alive/censored; 1 = death
#   OS: time from ICI initiation to death or last follow-up
#
# Biomarkers:
#   DAR = D-dimer-to-albumin ratio
#   PHR = platelet-to-hemoglobin ratio
#   FPR = fibrinogen-to-prealbumin ratio
#
# Covariates:
#   age: age at ICI initiation, in years
#   PS_bin: ECOG-PS category; reference = ECOG-PS 0
#   Stage: tumor stage; reference = III
#   Type: histological subtype; reference = LUAC
#   antiangiotherapy: anti-angiogenic therapy; reference = No
#   antiplatelet: antiplatelet therapy; reference = No
#   HBP: hypertension; reference = No
#   DM: diabetes mellitus; reference = No
#
# Optional variables:
#   padua_cat: Padua risk category; reference = Low-risk
#   Khorana_cat: Khorana risk category; reference = Intermediate Risk

# 3. Helper functions

to_numeric_safely <- function(x) {
  if (is.factor(x)) x <- as.character(x)
  suppressWarnings(as.numeric(x))
}

safe_log2 <- function(x) {
  x <- to_numeric_safely(x)
  out <- rep(NA_real_, length(x))
  ok <- is.finite(x) & !is.na(x) & x > 0
  out[ok] <- log2(x[ok])
  out
}

format_p <- function(p) {
  ifelse(is.na(p), NA_character_, ifelse(p < 0.001, "<0.001", sprintf("%.3f", p)))
}

format_estimate_ci <- function(est, lcl, ucl, digits = 2) {
  sprintf(paste0("%.", digits, "f (%.", digits, "f–%.", digits, "f)"), est, lcl, ucl)
}

set_reference_level <- function(x, reference) {
  x <- factor(x)
  if (reference %in% levels(x)) x <- stats::relevel(x, ref = reference)
  x
}

fit_finegray_model <- function(data, rhs_terms) {
  rhs_terms <- rhs_terms[rhs_terms %in% names(data)]
  if (length(rhs_terms) == 0) stop("No model terms were found in the dataset.")

  model_data <- data %>%
    dplyr::select(ftime, fstatus, dplyr::all_of(rhs_terms)) %>%
    tidyr::drop_na() %>%
    dplyr::filter(is.finite(ftime), ftime >= 0, fstatus %in% c(0, 1, 2))

  if (nrow(model_data) < 30) warning("The model has fewer than 30 complete observations.")
  if (sum(model_data$fstatus == 1) < 5) warning("The model has fewer than 5 VTE events.")

  design_matrix <- stats::model.matrix(
    stats::as.formula(paste("~", paste(rhs_terms, collapse = " + "))),
    data = model_data
  )[, -1, drop = FALSE]

  fit <- cmprsk::crr(
    ftime = model_data$ftime,
    fstatus = model_data$fstatus,
    cov1 = design_matrix,
    failcode = 1,
    cencode = 0
  )

  beta <- fit$coef
  se <- sqrt(diag(fit$var))

  result <- tibble::tibble(
    Term = names(beta),
    log_sHR = as.numeric(beta),
    SE = as.numeric(se),
    sHR = exp(log_sHR),
    LCL = exp(log_sHR - 1.96 * SE),
    UCL = exp(log_sHR + 1.96 * SE),
    P_value = 2 * stats::pnorm(-abs(log_sHR / SE)),
    sHR_95CI = format_estimate_ci(sHR, LCL, UCL),
    P_value_formatted = format_p(P_value),
    N = nrow(model_data),
    VTE_events = sum(model_data$fstatus == 1),
    Competing_deaths = sum(model_data$fstatus == 2)
  )

  list(fit = fit, result = result, model_data = model_data)
}

# 4. Read de-identified dataset

# Replace this file name with the de-identified analysis dataset supplied for reproduction.
data_file <- "deidentified_analysis_dataset.csv"
dat <- readr::read_csv(data_file, show_col_types = FALSE)

# 5. Data preparation


dat <- dat %>%
  dplyr::mutate(
    VTE_num = as.integer(to_numeric_safely(VTE_num)),
    Dead_num = as.integer(to_numeric_safely(Dead_num)),
    VTEtime = to_numeric_safely(VTEtime),
    OS = to_numeric_safely(OS),
    DAR = to_numeric_safely(DAR),
    PHR = to_numeric_safely(PHR),
    FPR = to_numeric_safely(FPR),

    # fstatus: 0 = censoring, 1 = VTE, 2 = death without prior VTE.
    ftime = dplyr::case_when(!is.na(VTEtime) ~ VTEtime, TRUE ~ OS),
    fstatus = dplyr::case_when(
      VTE_num == 1 ~ 1L,
      VTE_num == 2 ~ 2L,
      VTE_num != 1 & Dead_num == 1 ~ 2L,
      TRUE ~ 0L
    ),

    # log2 transformation: estimates are interpreted per doubling.
    log2_DAR = safe_log2(DAR),
    log2_PHR = safe_log2(PHR),
    log2_FPR = safe_log2(FPR)
  )

# Set reference categories. Modify references only if different labels are used.
if ("PS_bin" %in% names(dat)) dat$PS_bin <- set_reference_level(dat$PS_bin, "ECOG-PS 0")
if ("Stage" %in% names(dat)) dat$Stage <- set_reference_level(dat$Stage, "III")
if ("Type" %in% names(dat)) dat$Type <- set_reference_level(dat$Type, "LUAC")
if ("antiangiotherapy" %in% names(dat)) dat$antiangiotherapy <- set_reference_level(dat$antiangiotherapy, "No")
if ("antiplatelet" %in% names(dat)) dat$antiplatelet <- set_reference_level(dat$antiplatelet, "No")
if ("HBP" %in% names(dat)) dat$HBP <- set_reference_level(dat$HBP, "No")
if ("DM" %in% names(dat)) dat$DM <- set_reference_level(dat$DM, "No")
if ("padua_cat" %in% names(dat)) dat$padua_cat <- set_reference_level(dat$padua_cat, "Low-risk")
if ("Khorana_cat" %in% names(dat)) dat$Khorana_cat <- set_reference_level(dat$Khorana_cat, "Intermediate Risk")


# 6. Sequential Fine-Gray models for DAR, PHR, and FPR


# Model 1: biomarker only.
# Model 2: + age, ECOG-PS, tumor stage, and histological subtype.
# Model 3: + anti-angiogenic therapy and antiplatelet therapy.
# Model 4: + hypertension and diabetes mellitus.

finegray_models <- list(
  M1_DAR = c("log2_DAR"),
  M2_DAR = c("log2_DAR", "age", "PS_bin", "Stage", "Type"),
  M3_DAR = c("log2_DAR", "age", "PS_bin", "Stage", "Type", "antiangiotherapy", "antiplatelet"),
  M4_DAR = c("log2_DAR", "age", "PS_bin", "Stage", "Type", "antiangiotherapy", "antiplatelet", "HBP", "DM"),

  M1_PHR = c("log2_PHR"),
  M2_PHR = c("log2_PHR", "age", "PS_bin", "Stage", "Type"),
  M3_PHR = c("log2_PHR", "age", "PS_bin", "Stage", "Type", "antiangiotherapy", "antiplatelet"),
  M4_PHR = c("log2_PHR", "age", "PS_bin", "Stage", "Type", "antiangiotherapy", "antiplatelet", "HBP", "DM"),

  M1_FPR = c("log2_FPR"),
  M2_FPR = c("log2_FPR", "age", "PS_bin", "Stage", "Type"),
  M3_FPR = c("log2_FPR", "age", "PS_bin", "Stage", "Type", "antiangiotherapy", "antiplatelet"),
  M4_FPR = c("log2_FPR", "age", "PS_bin", "Stage", "Type", "antiangiotherapy", "antiplatelet", "HBP", "DM")
)

finegray_results <- purrr::imap_dfr(
  finegray_models,
  function(rhs_terms, model_name) {
    fit_obj <- fit_finegray_model(dat, rhs_terms)
    fit_obj$result %>% dplyr::mutate(Model = model_name, .before = 1)
  }
)

readr::write_csv(finegray_results, "Supplementary_FineGray_full_model_results.csv")


# 7. Compact biomarker summary table


biomarker_terms <- c(
  "log2_DAR" = "DAR, per doubling",
  "log2_PHR" = "PHR, per doubling",
  "log2_FPR" = "FPR, per doubling"
)

finegray_biomarker_summary <- finegray_results %>%
  dplyr::filter(Term %in% names(biomarker_terms)) %>%
  dplyr::mutate(
    Biomarker = unname(biomarker_terms[Term]),
    Estimate = paste0(sHR_95CI, "; P=", P_value_formatted)
  ) %>%
  dplyr::select(Model, Biomarker, Estimate, sHR, LCL, UCL, P_value)

readr::write_csv(finegray_biomarker_summary, "Supplementary_FineGray_biomarker_summary.csv")

# 8. Optional categorical Padua and Khorana Fine-Gray models

optional_models <- list()

if ("padua_cat" %in% names(dat)) {
  optional_models$Padua_model <- c(
    "padua_cat", "age", "PS_bin", "Stage", "Type",
    "antiangiotherapy", "antiplatelet", "HBP", "DM"
  )
}

if ("Khorana_cat" %in% names(dat)) {
  optional_models$Khorana_model <- c(
    "Khorana_cat", "age", "PS_bin", "Stage", "Type",
    "antiangiotherapy", "antiplatelet", "HBP", "DM"
  )
}

if (length(optional_models) > 0) {
  optional_results <- purrr::imap_dfr(
    optional_models,
    function(rhs_terms, model_name) {
      fit_obj <- fit_finegray_model(dat, rhs_terms)
      fit_obj$result %>% dplyr::mutate(Model = model_name, .before = 1)
    }
  )
  readr::write_csv(optional_results, "Supplementary_FineGray_Padua_Khorana_results.csv")
}

# End of supplementary code