# =========================
# 通用函数
# =========================

`%||%` <- function(x, y) if (is.null(x) || length(x) == 0 || all(is.na(x))) y else x

ensure_dir <- function(path) {
  if (!dir.exists(path)) dir.create(path, showWarnings = FALSE, recursive = TRUE)
  invisible(TRUE)
}

pick_col <- function(dat, candidates) {
  nms <- names(dat)
  hit <- candidates[candidates %in% nms]
  if (length(hit) == 0) return(NA_character_)
  hit[1]
}

read_loci_file <- function() {
  if (file.exists(TARGET_LOCI_XLSX)) {
    dat <- readxl::read_excel(TARGET_LOCI_XLSX)
    dat <- data.table::as.data.table(dat)
  } else if (file.exists(TARGET_LOCI_TSV)) {
    dat <- data.table::fread(TARGET_LOCI_TSV)
  } else {
    stop("Cannot find original_coloc_loci.xlsx or original_coloc_loci.tsv in 01_target_loci.")
  }

  names(dat) <- gsub("\\s+", "_", names(dat))
  names(dat) <- gsub("\\.", "_", names(dat))

  # 常见列名兼容
  rename_if_exists <- function(old, new) {
    if (old %in% names(dat) && !(new %in% names(dat))) {
      data.table::setnames(dat, old, new)
    }
  }

  rename_if_exists("ProteinID", "Protein_ID")
  rename_if_exists("protein_id", "Protein_ID")
  rename_if_exists("protein", "Protein")
  rename_if_exists("CHR", "chr")
  rename_if_exists("Chromosome", "chr")
  rename_if_exists("start", "region_start")
  rename_if_exists("end", "region_end")

  required <- c("Gene", "Protein_ID", "chr", "region_start", "region_end")
  missing_required <- setdiff(required, names(dat))
  if (length(missing_required) > 0) {
    stop("Missing required columns in target loci file: ", paste(missing_required, collapse = ", "))
  }

  dat[, Gene := as.character(Gene)]
  dat[, Protein_ID := as.character(Protein_ID)]
  dat[, chr := as.integer(gsub("^chr", "", as.character(chr), ignore.case = TRUE))]
  dat[, region_start := as.integer(region_start)]
  dat[, region_end := as.integer(region_end)]

  if (!("Protein" %in% names(dat))) dat[, Protein := Gene]
  if (!("Outcome" %in% names(dat))) {
    # 如果原始表只有 6 行基因区域，则扩展成 18 行：6 gene × 3 outcomes
    dat <- merge(dat, data.table::as.data.table(OUTCOME_MAP), by = NULL, allow.cartesian = TRUE)
  }
  if (!("Outcome_ID" %in% names(dat))) {
    dat <- merge(dat, data.table::as.data.table(OUTCOME_MAP), by = "Outcome", all.x = TRUE)
  }

  dat[]
}

read_any_tsv <- function(path) {
  if (!file.exists(path)) {
    gz <- paste0(path, ".gz")
    if (file.exists(gz)) path <- gz
  }
  if (!file.exists(path)) stop("Cannot find file: ", path)
  data.table::fread(path)
}

standardise_gwas <- function(gwas) {
  gwas <- data.table::as.data.table(gwas)
  names(gwas) <- gsub("\\.", "_", names(gwas))

  snp_col  <- pick_col(gwas, c("SNP", "rsid", "rsids", "variant", "MarkerName"))
  chr_col  <- pick_col(gwas, c("chr", "#chrom", "chrom", "CHR", "region_chr"))
  pos_col  <- pick_col(gwas, c("pos", "position", "base_pair_location", "bp"))
  ea_col   <- pick_col(gwas, c("ea_gwas", "ea", "effect_allele", "alt", "A1"))
  nea_col  <- pick_col(gwas, c("nea_gwas", "nea", "other_allele", "ref", "A2"))
  eaf_col  <- pick_col(gwas, c("eaf_gwas", "eaf", "af_alt", "af", "effect_allele_frequency"))
  beta_col <- pick_col(gwas, c("beta_gwas", "beta", "b", "Effect"))
  se_col   <- pick_col(gwas, c("se_gwas", "se", "sebeta", "standard_error", "StdErr"))
  p_col    <- pick_col(gwas, c("p_gwas", "p", "pval", "p_value", "P", "pval_nominal"))
  mlogp_col <- pick_col(gwas, c("mlogp", "minus_log10_p", "neglog10p"))

  if (is.na(snp_col) || is.na(chr_col) || is.na(pos_col)) {
    stop("GWAS file must contain SNP/chr/pos columns.")
  }

  out <- data.table::data.table(
    SNP = as.character(gwas[[snp_col]]),
    chr_gwas = as.integer(gsub("^chr", "", as.character(gwas[[chr_col]]), ignore.case = TRUE)),
    pos_gwas = as.integer(gwas[[pos_col]])
  )

  if (!is.na(ea_col))   out[, ea_gwas := as.character(gwas[[ea_col]])]
  if (!is.na(nea_col))  out[, nea_gwas := as.character(gwas[[nea_col]])]
  if (!is.na(eaf_col))  out[, eaf_gwas := suppressWarnings(as.numeric(gwas[[eaf_col]]))]
  if (!is.na(beta_col)) out[, beta_gwas := suppressWarnings(as.numeric(gwas[[beta_col]]))]
  if (!is.na(se_col))   out[, se_gwas := suppressWarnings(as.numeric(gwas[[se_col]]))]

  if (!is.na(p_col)) {
    out[, p_gwas := suppressWarnings(as.numeric(gwas[[p_col]]))]
  } else if (!is.na(mlogp_col)) {
    out[, p_gwas := 10^(-suppressWarnings(as.numeric(gwas[[mlogp_col]])))]
  } else {
    out[, p_gwas := NA_real_]
  }

  out <- out[!is.na(SNP) & SNP != ""]
  out[, SNP := trimws(sapply(strsplit(SNP, ","), `[`, 1))]
  out[, p_gwas := pmax(p_gwas, .Machine$double.xmin, na.rm = FALSE)]
  out[]
}

standardise_pqtl <- function(pqtl) {
  pqtl <- data.table::as.data.table(pqtl)
  names(pqtl) <- gsub("\\.", "_", names(pqtl))

  snp_col  <- pick_col(pqtl, c("SNP", "rsid", "rsids", "variant", "MarkerName"))
  chr_col  <- pick_col(pqtl, c("chr", "#chrom", "chrom", "CHR", "region_chr"))
  pos_col  <- pick_col(pqtl, c("position", "pos", "base_pair_location", "bp"))
  ea_col   <- pick_col(pqtl, c("ea_pqtl", "ea", "effect_allele", "alt", "A1"))
  nea_col  <- pick_col(pqtl, c("nea_pqtl", "nea", "other_allele", "ref", "A2"))
  eaf_col  <- pick_col(pqtl, c("eaf_pqtl", "eaf", "af", "effect_allele_frequency"))
  beta_col <- pick_col(pqtl, c("beta_pqtl", "beta", "b", "Effect"))
  se_col   <- pick_col(pqtl, c("se_pqtl", "se", "standard_error", "StdErr"))
  p_col    <- pick_col(pqtl, c("p_pqtl", "p", "pval", "p_value", "P", "pval_nominal"))
  n_col    <- pick_col(pqtl, c("n_pqtl", "n", "samplesize", "sample_size"))

  required_cols <- c(snp_col, chr_col, pos_col, beta_col, se_col, p_col)
  if (any(is.na(required_cols))) {
    stop("pQTL file must contain SNP/chr/pos/beta/se/p columns.")
  }

  out <- data.table::data.table(
    SNP = as.character(pqtl[[snp_col]]),
    chr_pqtl = as.integer(gsub("^chr", "", as.character(pqtl[[chr_col]]), ignore.case = TRUE)),
    position_pqtl = as.integer(pqtl[[pos_col]]),
    beta_pqtl = suppressWarnings(as.numeric(pqtl[[beta_col]])),
    se_pqtl = suppressWarnings(as.numeric(pqtl[[se_col]])),
    p_pqtl = suppressWarnings(as.numeric(pqtl[[p_col]]))
  )

  if (!is.na(ea_col))  out[, ea_pqtl := as.character(pqtl[[ea_col]])]
  if (!is.na(nea_col)) out[, nea_pqtl := as.character(pqtl[[nea_col]])]
  if (!is.na(eaf_col)) out[, eaf_pqtl := suppressWarnings(as.numeric(pqtl[[eaf_col]]))]
  if (!is.na(n_col))   out[, n_pqtl := suppressWarnings(as.numeric(pqtl[[n_col]]))]

  out <- out[!is.na(SNP) & SNP != ""]
  out[, SNP := trimws(SNP)]
  out[, p_pqtl := pmax(p_pqtl, .Machine$double.xmin, na.rm = FALSE)]
  out[]
}

neglog10 <- function(p) {
  p <- suppressWarnings(as.numeric(p))
  -log10(pmax(p, .Machine$double.xmin, na.rm = FALSE))
}

write_status <- function(step, ok, message = "") {
  ensure_dir(DIR_TABLES)
  status_file <- file.path(DIR_TABLES, "pipeline_status.xlsx")
  row <- data.frame(
    Time = as.character(Sys.time()),
    Step = step,
    OK = as.logical(ok),
    Message = as.character(message),
    stringsAsFactors = FALSE
  )
  if (file.exists(status_file)) {
    old <- openxlsx::read.xlsx(status_file)
    out <- rbind(old, row)
  } else {
    out <- row
  }
  openxlsx::write.xlsx(out, status_file, overwrite = TRUE)
  cat(step, ":", ok, "\n")
  invisible(ok)
}