#' @title Batch Parallel GSEA Calculation

#' @description Consumes a standard GseaEnv object and performs efficient parallel GSEA calculation.

#' @param gsea_env GseaEnv object

#' @param custom_series_name String. Analysis series name

#' @param output_dir String. Output directory for results, default "./GSEA_Output"

#' @param workers Number of parallel cores. Default 4

#' @param bidirectional Logical. Whether to automatically generate reverse contrasts, default TRUE

#' @param minGSSize Minimum gene set size, default 10

#' @param maxGSSize Maximum gene set size, default 500

#' @param pvalueCutoff P-value threshold, default 1

#' @param seed Integer or NULL. Base random seed for per-contrast GSEA

#'   permutation, default 123. Each contrast derives its own deterministic

#'   seed from the base seed and the contrast id, so results are reproducible

#'   across runs and independent of `workers`/`chunk_size`. On

#'   clusterProfiler <= 4.20.x (where the `seed` argument of `GSEA()` is

#'   silently dropped) reproducibility is guaranteed by seeding the worker R

#'   RNG via `withr::local_seed()`; on clusterProfiler >= 4.21.x the derived

#'   seed is also forwarded to `clusterProfiler::GSEA(seed = ...)`. Set to

#'   NULL to restore native (non-reproducible) engine sampling.

#' @param force Logical. Whether to force recalculation, default FALSE

#' @param use_progress Logical. Whether to show progress bar, default TRUE

#' @param chunk_size Integer. Number of tasks per worker per chunk, default NULL (auto)

#' @return GseaRes object

#' @examples


#' # Build a GseaEnv from pre-computed inputs shipped with the package

#' data(preprocessed_limma, package = "GSEAlens")
#'
#' precomp <- preprocessed_limma

#' data(gsea_pathwaysets_toy, package = "GSEAlens")
#'
#' pathways <- gsea_pathwaysets_toy

#' gsea_env <- setup_gsea_env(

#'   fit = precomp$fit,

#'   pathway_obj = pathways,

#'   expr_data = precomp$gsea_limma_voom_data

#' )

#' # Run batch GSEA (writes to a temporary directory; ~20s on the toy set)

#' gsea_res <- batch_calc_gsea(gsea_env, workers = 2, output_dir = tempdir())

#' @export

batch_calc_gsea <- function(gsea_env,

                            custom_series_name = "Auto_Analysis",

                            output_dir = tempdir(),

                            workers = 2,

                            bidirectional = TRUE,

                            minGSSize = 10,

                            maxGSSize = 500,

                            pvalueCutoff = 1,

                            seed = 123,

                            force = FALSE,

                            use_progress = FALSE,

                            chunk_size = NULL) {

    .check_gsea_env(gsea_env)



    start_time <- Sys.time()

    start_ms <- as.numeric(start_time) * 1000



    series_dir <- file.path(output_dir, custom_series_name)

    if (!dir.exists(series_dir)) {

    dir.create(series_dir, recursive = TRUE, showWarnings = FALSE)

    }



    rds_name <- sprintf(

    "GSEA_Capsule_[%s]_[%s].rds",

    custom_series_name, gsea_env$geneset$name

    )

    rds_path <- file.path(series_dir, rds_name)



    if (file.exists(rds_path) && !force) {

    message(sprintf("Cache hit! Existing GSEA capsule detected: %s", rds_name))

    return(readRDS(rds_path))

    }



    registry <- gsea_env$contrast_registry

    de_store <- gsea_env$de_store



    task_metadata <- list()

    for (i in seq_len(nrow(registry))) {

    row <- registry[i, ]

    cid <- row$contrast_id

    task_metadata[[cid]] <- list(

            task_id = cid,

            left_group = row$left_group,

            right_group = row$right_group,

            is_reversed = FALSE

    )

    if (bidirectional) {

            rev_cid <- paste(row$right_group, row$left_group, sep = "_vs_")

            task_metadata[[rev_cid]] <- list(

        task_id = rev_cid,

        left_group = row$right_group,

        right_group = row$left_group,

        is_reversed = TRUE

            )

    }

    }



    total_tasks <- length(task_metadata)

    message(sprintf("Ready: %d contrast tasks pending calculation...", total_tasks))



    # Raise future.globals.maxSize for the duration of this call to accommodate

    # large globals (full DE table + gene set dictionary). Restore the user's

    # original option on exit to avoid leaking the inflated limit.

    old_max_size <- getOption("future.globals.maxSize")

    options(future.globals.maxSize = 192 * 1024^3)

    on.exit(options(future.globals.maxSize = old_max_size), add = TRUE)



    # Use future::availableCores() instead of parallel::detectCores() so that

    # the package does not need to declare a dependency on the `parallel`

    # package. `future` is already in Imports and `availableCores()` honors

    # future options (e.g. future.availableWorkers) for finer control.

    total_cores <- as.integer(future::availableCores())

    # B10 fix: guard against NA / non-integer workers input
    workers <- suppressWarnings(as.integer(workers))
    if (is.na(workers) || workers < 1) workers <- 1
    use_cores <- min(total_cores, max(1L, workers))

    message(sprintf("Hardware scheduling: Using %d cores for parallel computation...", use_cores))



    if (is.null(chunk_size)) {

    chunk_size <- max(1, ceiling(total_tasks / (use_cores * 4)))

    }



    # B7 fix: Set the future backend for this call. Save the current plan so it
    # can be restored on exit (avoid clobbering a plan the user set elsewhere,
    # e.g. in global.R or another Shiny session). Restoring the old plan also
    # avoids the global side-effect of forcing everyone back to `sequential`.
    old_plan <- future::plan(future::multisession, workers = use_cores)

    on.exit(future::plan(old_plan), add = TRUE)



    if (use_progress) {

    if (!requireNamespace("progressr", quietly = TRUE)) {

            stop("Please install progressr package: install.packages('progressr')")

    }

    progressr::handlers(global = TRUE)

    progressr::handlers("progress")

    }



    worker_term2gene <- gsea_env$geneset$term2gene

    worker_meta_dict <- gsea_env$geneset$meta_dict

    worker_de_list <- as.list(de_store)



    task_names <- names(task_metadata)

    task_chunks <- split(task_names, ceiling(seq_along(task_names) / chunk_size))



    message(sprintf(

    "Chunk strategy: %d chunks, up to %d tasks per chunk",

    length(task_chunks), chunk_size

    ))



    # Derive one deterministic seed per task up front, in the MAIN process,
    # so future workers only receive a plain named integer vector and never
    # depend on helper-function visibility across worker serialization.
    # .derive_task_seed() ranks tasks against the alphabetically sorted full
    # task list, making each seed independent of workers / chunk_size.
    task_seeds <- vapply(
    task_names,
    function(tid) {
        v <- .derive_task_seed(seed, tid, task_names)
        if (is.null(v)) NA_integer_ else v
    },
    integer(1)
    )

    p <- progressr::progressor(steps = total_tasks, enable = use_progress)



    res_list <- future.apply::future_lapply(

    X = task_chunks,

    FUN = function(chunk_task_names,

                                        task_metadata,

                                        de_list,

                                        term2gene,

                                        meta_dict,

                                        minGSSize,

                                        maxGSSize,

                                        pvalueCutoff,

                                        task_seeds,

                                        progressor_fn) {

            if (!requireNamespace("clusterProfiler", quietly = TRUE) ||

        !requireNamespace("dplyr", quietly = TRUE)) {

        stop("Worker missing required packages")

            }



            chunk_results <- list()



            for (task_name in chunk_task_names) {

        task_info <- task_metadata[[task_name]]

        task_id <- task_info$task_id



        if (task_info$is_reversed) {

                    original_cid <- paste(task_info$right_group, task_info$left_group, sep = "_vs_")

        } else {

                    original_cid <- task_id

        }



        de_table <- de_list[[original_cid]]



        if (is.null(de_table) || nrow(de_table) == 0) {

                    chunk_results[[task_name]] <- list(

            name = task_id,

            status = "Failed",

            data = NULL,

            genelist = c()

                    )

                    if (!is.null(progressor_fn)) progressor_fn()

                    next

        }



        genelist <- tryCatch(

                    {

            .prepare_rank_vector_fast(de_table, flip = task_info$is_reversed)

                    },

                    error = function(e) {

            c()

                    }

        )



        if (length(genelist) == 0) {

                    chunk_results[[task_name]] <- list(

            name = task_id,

            status = "Failed",

            data = NULL,

            genelist = c()

                    )

                    if (!is.null(progressor_fn)) progressor_fn()

                    next

        }



        detect_case_format <- function(genes) {

                    sample <- head(unique(genes), 100)

                    sample_filtered <- sample[!grepl("^[0-9]", sample)]

                    if (length(sample_filtered) == 0) {

            return("mixed")

                    }

                    n_title <- sum(grepl("^[A-Z][a-z]", sample_filtered))

                    n_upper <- sum(grepl("^[A-Z]{2,}$", sample_filtered))

                    if (n_title > n_upper) {

            return("title_case")

                    }

                    if (n_upper > n_title) {

            return("upper_case")

                    }

                    return("mixed")

        }



        # Note: gene-case detection uses term2gene + names(genelist) only.
        # (geneset_species was previously derived from gsea_env$geneset$species
        #  inside the future worker but never read; removed 2026-07-01.)
        term2gene_format <- detect_case_format(term2gene$gene_symbol)

        de_format <- detect_case_format(names(genelist))



        if (term2gene_format == "upper_case") {

                    if (de_format == "title_case") {

            names(genelist) <- toupper(names(genelist))

                    } else if (de_format == "mixed") {

            warning(

                            "[Ambiguous Gene Symbol Case]\n",

                            "Gene set format: Uppercase (HS / human); DE gene format: Mixed (cannot be auto-detected).\n",

                            "Common cause: a large fraction of gene symbols start with digits (e.g., '12R5', '7SK'), ",

                            "or symbols are non-standard identifiers.\n",

                            "Case auto-conversion was SKIPPED. If DE genes are actually mouse title case (e.g., Gapdh, Irf7), ",

                            "this may silently return zero enrichments. Please manually verify symbol consistency."

            )

                    }

        } else if (term2gene_format == "title_case") {

                    if (de_format == "upper_case") {

            stop(

                            "[Species Mismatch Error]\nGene set species: Mouse (MM) - requires title case gene symbols\nDE gene format: Uppercase (e.g., GAPDH, IRF7) - appears to be human data\n\nPlease use human gene sets (species='HS') for uppercase DE data,\nor provide mouse DE data with title case gene symbols (e.g., Gapdh, Irf7)."

            )

                    } else if (de_format == "mixed") {

            warning(

                            "[Ambiguous Gene Symbol Case]\n",

                            "Gene set format: Title case (MM / mouse); DE gene format: Mixed (cannot be auto-detected).\n",

                            "Case auto-conversion was SKIPPED. If DE genes are actually human uppercase (e.g., GAPDH, IRF7), ",

                            "this may silently return zero enrichments. Please manually verify symbol consistency."

            )

                    }

        } else if (term2gene_format == "mixed") {

                    warning(

            "[Ambiguous Gene Symbol Case]\n",

            "TERM2GENE gene set format could not be auto-detected (possibly contains many non-standard ",

            "or digit-leading symbols). Case auto-conversion was SKIPPED. ",

            "Please manually verify that DE gene symbols and gene set symbols use the same convention."

                    )

        }



        seed_val <- task_seeds[[task_name]]

        if (length(seed_val) == 1L && !is.na(seed_val)) withr::local_seed(seed_val)

        gsea_res <- tryCatch(

                    {

            clusterProfiler::GSEA(

                            geneList = genelist,

                            TERM2GENE = term2gene,

                            minGSSize = minGSSize,

                            maxGSSize = maxGSSize,

                            pvalueCutoff = pvalueCutoff,

                            pAdjustMethod = "BH",

                            verbose = FALSE,

                            seed = if (is.na(seed_val)) FALSE else seed_val,

                            eps = 0

            )

                    },

                    error = function(e) {

            NULL

                    }

        )



        status <- if (!is.null(gsea_res) && nrow(gsea_res@result) > 0) "Success" else "Failed/NoEnrich"



        if (status == "Success" && !is.null(meta_dict)) {

                    gsea_res@result <- .enrich_gsea_result(gsea_res@result, meta_dict)

        }



        chunk_results[[task_name]] <- list(

                    name = task_id,

                    status = status,

                    data = gsea_res,

                    genelist = genelist

        )



        if (!is.null(progressor_fn)) progressor_fn()

            }



            return(chunk_results)

    },

    task_metadata = task_metadata,

    de_list = worker_de_list,

    term2gene = worker_term2gene,

    meta_dict = worker_meta_dict,

    minGSSize = minGSSize,

    maxGSSize = maxGSSize,

    pvalueCutoff = pvalueCutoff,

    task_seeds = task_seeds,

    progressor_fn = if (use_progress) p else NULL,

    future.seed = TRUE,

    future.scheduling = 1.0

    )



    # future::plan(future::sequential) is handled by on.exit() above, so that the

    # plan is restored even if future_lapply throws.



    all_cons <- showConnections(all = TRUE)

    if (nrow(all_cons) > 1) {

    for (con_idx in as.integer(rownames(all_cons))) {

            if (con_idx > 2) {

        try(suppressWarnings(close.connection(getConnection(con_idx))), silent = TRUE)

            }

    }

    }

# suppressWarnings: suppress "closing unused connection" noise during cleanup

        

    invisible(gc(verbose = FALSE, full = TRUE))



    res_list_flat <- do.call(c, res_list)

    names(res_list_flat) <- names(task_metadata)



    end_time <- Sys.time()

    end_ms <- as.numeric(end_time) * 1000



    final_obj <- create_gsea_res(

    metadata = list(

            run_time = format(Sys.time(), "%Y-%m-%d %H:%M:%S"),

            workers_used = use_cores,

            chunk_size = chunk_size,

            parameters = list(

        bidirectional = bidirectional,

        minGSSize = minGSSize,

        maxGSSize = maxGSSize,

        pvalueCutoff = pvalueCutoff,

        seed = seed

            ),

            project_info = list(

        custom_series_name = custom_series_name,

        output_dir = normalizePath(output_dir, mustWork = FALSE),

        series_dir = normalizePath(series_dir, mustWork = FALSE),

        rds_path = normalizePath(rds_path, mustWork = FALSE)

            ),

            gsea_benchmark = list(

        start_time = format(start_time, "%Y-%m-%d %H:%M:%OS3"),

        start_ms = start_ms,

        end_time = format(end_time, "%Y-%m-%d %H:%M:%OS3"),

        end_ms = end_ms,

        duration_sec = round((end_ms - start_ms) / 1000, 3),

        workers = use_cores,

        total_tasks = length(task_metadata),

        successful_tasks = sum(vapply(res_list_flat, function(x) x$status == "Success", logical(1)))

            )

    ),

    backend_info = gsea_env$backend_info,

    contrast_registry = gsea_env$contrast_registry,

    de_store = gsea_env$de_store,

    expr_bundle = gsea_env$expr_bundle,

    geneset_info = gsea_env$geneset,

    results = res_list_flat

    )



    saveRDS(final_obj, rds_path)



    success_count <- final_obj$metadata$gsea_benchmark$successful_tasks



    message(sprintf(

    "\nCalculation complete! Time elapsed: %.2f seconds",

    final_obj$metadata$gsea_benchmark$duration_sec

    ))

    message(sprintf("   Successfully analyzed: %d/%d contrasts", success_count, total_tasks))

    message(sprintf("   Results saved to: %s", rds_path))



    return(final_obj)

}





#' @title Derive Deterministic Per-Task Seed
#'
#' @param seed Integer or NULL. Base seed chosen by the user.
#' @param task_id Character. Contrast task identifier.
#' @param all_task_ids Character vector. All task ids in the current run.
#' @return Integer seed derived from the base seed and the task's rank in the
#'   alphabetically sorted task list, or NULL when `seed` is NULL, NA or
#'   non-numeric. Ranking
#'   against the sorted full task list (not the chunk-local order) makes the
#'   derived seed independent of `workers` and `chunk_size`.
#' @keywords internal
.derive_task_seed <- function(seed, task_id, all_task_ids) {
    if (is.null(seed) || length(seed) == 0L ||
        !is.numeric(seed) || is.na(seed[1])) return(NULL)
    seed <- as.numeric(seed[1])
    idx <- match(task_id, sort(all_task_ids))
    if (is.na(idx)) idx <- 1L
    as.integer((seed + idx - 1) %% .Machine$integer.max)
}

#' @title Fast Rank Vector Preparation

#' @param de_table DE result table

#' @param flip Whether to flip sign

#' @return Named numeric vector

#' @keywords internal

.prepare_rank_vector_fast <- function(de_table, flip = FALSE) {

    # Preserve original case; format standardization is performed in worker function

    # based on TERM2GENE

    vals_df <- de_table |>

    dplyr::filter(!is.na(gene_symbol), gene_symbol != "") |>

    dplyr::mutate(abs_stat = abs(stat)) |>

    dplyr::arrange(dplyr::desc(abs_stat)) |>

    dplyr::distinct(gene_symbol, .keep_all = TRUE)



    vals <- vals_df$stat

    names(vals) <- vals_df$gene_symbol



    if (flip) vals <- -vals

    sort(vals, decreasing = TRUE)

}





#' @title GSEA Result Metadata Injection

#' @param result_df GSEA result dataframe

#' @param meta_dict Metadata dictionary

#' @return Enriched dataframe

#' @keywords internal

.enrich_gsea_result <- function(result_df, meta_dict) {

    if (!is.data.frame(result_df) || nrow(result_df) == 0) {

    warning("result_df is invalid or empty")

    return(result_df)

    }



    if (!is.data.frame(meta_dict) || nrow(meta_dict) == 0) {

    warning("meta_dict is empty, cannot enrich results")

    return(result_df)

    }



    if (!"ID" %in% colnames(result_df) || !"ID" %in% colnames(meta_dict)) {

    stop("Both result_df and meta_dict must contain 'ID' column")

    }



    original_rownames <- rownames(result_df)

    original_ids <- result_df$ID



    required_cols <- c("ID", "Description", "URL", "Collection", "Subcollection", "Combo_Name")



    for (col in required_cols) {

    if (!col %in% colnames(meta_dict)) {

            warning(sprintf("meta_dict missing column '%s', creating placeholder", col))

            meta_dict[[col]] <- NA_character_

    }

    }



    if (all(is.na(meta_dict$Subcollection)) || is.null(meta_dict$Subcollection)) {

    meta_dict$Subcollection <- ""

    }



    if (all(is.na(meta_dict$Combo_Name))) {

    meta_dict$Combo_Name <- ifelse(

            is.na(meta_dict$Subcollection) | meta_dict$Subcollection == "",

            meta_dict$Collection,

            paste0(meta_dict$Collection, ":", meta_dict$Subcollection)

    )

    }



    core_stat_cols <- c(

    "ID", "setSize", "enrichmentScore", "NES", "pvalue",

    "p.adjust", "qvalue", "rank", "leading_edge", "core_enrichment"

    )



    conflict_cols <- c("Description", "URL", "Collection", "Subcollection", "Combo_Name")



    cols_to_keep <- setdiff(colnames(result_df), conflict_cols)

    result_work <- result_df[, cols_to_keep, drop = FALSE]



    meta_subset <- meta_dict[, required_cols, drop = FALSE]



    merged_df <- result_work |>

    dplyr::left_join(

            meta_subset,

            by = "ID",

            suffix = c("", "_meta")

    )



    if (nrow(merged_df) != nrow(result_work)) {

    warning(sprintf(

            "Row count changed during merge: %d -> %d",

            nrow(result_work), nrow(merged_df)

    ))

    }



    merged_df$Display_Collection <- dplyr::coalesce(

    merged_df$Combo_Name,

    merged_df$Collection,

    "Unknown"

    )

    merged_df$Display_Collection <- as.factor(merged_df$Display_Collection)



    merged_df$Pathway_Link <- ifelse(

    is.na(merged_df$URL) | merged_df$URL == "",

    sprintf("<b>%s</b>", merged_df$ID),

    sprintf('<a href="%s" target="_blank">%s</a>', merged_df$URL, merged_df$ID)

    )



    if ("Description_meta" %in% colnames(merged_df)) {

    merged_df$Description <- dplyr::coalesce(

            merged_df$Description_meta,

            merged_df$ID

    )

    merged_df$Description_meta <- NULL

    } else if (!"Description" %in% colnames(merged_df)) {

    merged_df$Description <- merged_df$ID

    }



    merged_df$Description[is.na(merged_df$Description)] <- merged_df$ID[is.na(merged_df$Description)]



    meta_temp_cols <- grep("_meta$", colnames(merged_df), value = TRUE)

    if (length(meta_temp_cols) > 0) {

    merged_df <- merged_df[, !(colnames(merged_df) %in% meta_temp_cols), drop = FALSE]

    }



    merged_df <- as.data.frame(merged_df)

    if ("ID" %in% colnames(merged_df)) {

    if (any(duplicated(merged_df$ID))) {

            warning("Duplicate IDs found in result, using original rownames")

            rownames(merged_df) <- original_rownames

    } else {

            rownames(merged_df) <- merged_df$ID

    }

    } else {

    rownames(merged_df) <- original_rownames

    }



    standard_cols <- c(

    "ID", "setSize", "enrichmentScore", "NES", "pvalue",

    "p.adjust", "qvalue", "rank", "leading_edge", "core_enrichment",

    "Description", "URL", "Collection", "Subcollection", "Combo_Name",

    "Display_Collection", "Pathway_Link"

    )



    missing_standard <- setdiff(standard_cols, colnames(merged_df))

    if (length(missing_standard) > 0) {

    warning(sprintf(

            "Final result missing standard columns: %s",

            paste(missing_standard, collapse = ", ")

    ))

    for (col in missing_standard) {

            merged_df[[col]] <- NA_character_

    }

    }



    present_cols <- intersect(standard_cols, colnames(merged_df))

    extra_cols <- setdiff(colnames(merged_df), standard_cols)

    merged_df <- merged_df[, c(present_cols, extra_cols), drop = FALSE]



    message(sprintf(

    "[.enrich_gsea_result] Successfully enriched: %d rows x %d columns",

    nrow(merged_df), ncol(merged_df)

    ))



    return(merged_df)

}

