#' @importFrom stats setNames quantile sd glm.fit na.omit pchisq
#' @importFrom utils head modifyList
# plotg
#' @keywords internal
#' @noRd
.create_igraph_plot <- function(mat, index) {
    g <- igraph::graph_from_adjacency_matrix(mat,
        mode = "undirected",
        weighted = NULL,
        diag = FALSE
    )
    g <- igraph::delete_vertices(g, igraph::V(g)[igraph::degree(g) == 0])

    if (igraph::vcount(g) == 0 || igraph::ecount(g) == 0) {
        return(NULL)
    }

    title <- paste(
        "Graph",
        index,
        "
Nodes:",
        igraph::vcount(g),
        "Edges:",
        igraph::ecount(g)
    )
    ggraph::ggraph(g, layout = "fr") +
        ggraph::geom_edge_link(color = "gray", width = 0.5) +
        ggraph::geom_node_point(color = "steelblue", size = 3) +
        ggplot2::labs(title = title) +
        ggplot2::theme_minimal() +
        ggplot2::theme(
            plot.title = ggplot2::element_text(
                hjust = 0.5,
                size = 14,
                face = "bold"
            ),
            legend.position = "none"
        )
}

# compare_consensus
#' @keywords internal
#' @noRd

.edge_to_str <- function(edge_list) {
    apply(edge_list, 1, function(e) paste(sort(e), collapse = "-"))
}
#' @keywords internal
#' @noRd

.plot_tp_fn_graph <- function(graph_ref, edge_colors, TP_label, FN_label) {
    graph_clean <- igraph::delete_vertices(
        graph_ref,
        igraph::V(graph_ref)[igraph::degree(graph_ref) == 0]
    )

    ggraph::ggraph(graph_clean, layout = "fr") +
        ggraph::geom_edge_link(ggplot2::aes(color=I(edge_colors)),width=0.7) +
        ggraph::geom_node_point(color = "steelblue", size = 1.5) +
        ggplot2::labs(
            title = paste(
                "Reference Graph
", TP_label, ":", sum(edge_colors == "red"),
                FN_label, ":", sum(edge_colors == "blue")
            )
        ) +
        ggplot2::theme_minimal() +
        ggplot2::theme(legend.position = "none")
}
#' @keywords internal
#' @noRd

.plot_fp_graph <- function(fp_edges_str, FP_label) {
    fp_pairs <- strsplit(fp_edges_str, "-")
    fp_mat <- do.call(rbind, Filter(function(x) length(x) == 2, fp_pairs))
    if (is.null(fp_mat) || nrow(fp_mat) == 0) {
        return(NULL)
    }

    graph_fp <- igraph::graph_from_edgelist(fp_mat, directed = FALSE)
    graph_fp <- igraph::delete_vertices(
        graph_fp,
        igraph::V(graph_fp)[igraph::degree(graph_fp) == 0]
    )

    ggraph::ggraph(graph_fp, layout = "fr") +
        ggraph::geom_edge_link(color = "purple", width = 1) +
        ggraph::geom_node_point(color = "steelblue", size = 2) +
        ggplot2::labs(title = paste(FP_label, ":", nrow(fp_mat))) +
        ggplot2::theme_minimal() +
        ggplot2::theme(legend.position = "none")
}

# zinbsim
#' @keywords internal
#' @noRd

.create_adjacency_expansion <- function(B) {
    p <- nrow(B)
    edges <- which(B == 1, arr.ind = TRUE)
    edges <- edges[edges[, 1] < edges[, 2], , drop = FALSE]

    A <- diag(1, nrow = p, ncol = p)
    for (i in seq_len(nrow(edges))) {
        tmp <- rep(0, p)
        tmp[edges[i, ]] <- 1
        A <- cbind(A, tmp)
    }
    list(A = A, edge_indices = edges)
}

#' @keywords internal
#' @noRd

.simulate_counts_ZINB <- function(n, values, theta, pi) {
    matrix(
        rzinbinom(n * length(values),
            mu = rep(values, each = n),
            theta = theta,
            pi = pi
        ),
        nrow = length(values), ncol = n
    )
}
#' @keywords internal
#' @noRd

.add_technical_noise <- function(n, p, mu, pi) {
    matrix(rzinbinom(n * p, mu = mu, theta = 1, pi = pi), nrow = p, ncol = n)
}

#' @keywords internal
#' @noRd

.normalize_library_size <- function(mat, depth_range) {
    n <- nrow(mat)
    cell_depths <- runif(n, min = depth_range[1], max = depth_range[2])
    row_sums <- rowSums(mat)
    row_sums[row_sums == 0] <- 1
    mat <- sweep(mat, 1, row_sums, FUN = "/")
    mat <- sweep(mat, 1, cell_depths, FUN = "*")
    round(mat)
}

# pscores

#' @keywords internal
#' @noRd
.compute_confusion_metrics <- function(pred_vec, gt_vec, index) {
    TP <- sum(pred_vec == 1 & gt_vec == 1)
    TN <- sum(pred_vec == 0 & gt_vec == 0)
    FP <- sum(pred_vec == 1 & gt_vec == 0)
    FN <- sum(pred_vec == 0 & gt_vec == 1)

    TPR <- ifelse((TP + FN) > 0,
        TP / (TP + FN),
        0
    )
    FPR <- ifelse((FP + TN) > 0,
        FP / (FP + TN),
        0
    )
    Precision <- ifelse((TP + FP) > 0,
        TP / (TP + FP),
        0
    )
    F1 <- ifelse((Precision + TPR) > 0,
        2 * (Precision * TPR) / (Precision + TPR),
        0
    )

    denominator <- sqrt(
        as.numeric(TP + FP) *
            as.numeric(TP + FN) *
            as.numeric(TN + FP) *
            as.numeric(TN + FN)
    )
    MCC <- ifelse(denominator > 0,
        (TP * TN - FP * FN) / denominator,
        0
    )

    data.frame(
        Predicted_Matrix = paste("Matrix", index),
        TP = TP,
        TN = TN,
        FP = FP,
        FN = FN,
        TPR = TPR,
        FPR = FPR,
        Precision = Precision,
        F1 = F1,
        MCC = MCC
    )
}
#' @keywords internal
#' @noRd
.plot_metrics_radar <- function(stats_df, metric_cols) {
    if (!all(metric_cols %in% colnames(stats_df))) stop("Missing metrics.")
    sd <- as.data.frame(lapply(
        stats_df[, metric_cols, drop = FALSE],
        function(x) as.numeric(as.character(x))
    ))
    # Transform FPR to (1-FPR) for visualization only
    if ("FPR" %in% names(sd)) {
        sd$FPR <- 1 - sd$FPR
        colnames(sd)[colnames(sd) == "FPR"] <- "Specificity"
    }
    if ("MCC" %in% names(sd)) {
        neg <- which(sd$MCC < 0)
        if (length(neg)) {
            message("Negative MCC, set to 0.")
            sd$MCC[neg] <- 0
        }
    }
    ok <- colSums(is.finite(as.matrix(sd))) > 0
    sd <- sd[, ok, drop = FALSE]
    if (nrow(sd) == 0 || ncol(sd) < 2) {
        warning("Not enough metrics.")
        return(list(data = NULL, plot = NULL))
    }
    mx <- if (max(sd, na.rm = TRUE) <= 0.5) 0.5 else 1
    mn <- 0
    pd <- rbind(rep(mx, ncol(sd)), rep(mn, ncol(sd)), sd)
    rownames(pd) <- c("Max", "Min", stats_df$Predicted_Matrix)
    labs <- pretty(c(mn, mx), n = 5)
    cols <- grDevices::rainbow(nrow(sd))
    graphics::par(mar = c(2, 2, 2, 2))
    fmsb::radarchart(data.frame(pd),
        axistype = 2, pcol = cols, plty = 1, plwd = 2,
        cglcol = "grey", caxislabels = labs, vlcex = 1.1
    )
    graphics::legend("topright",
        legend = stats_df$Predicted_Matrix,
        col = cols, lty = 1, lwd = 2
    )
    list(data = pd, plot = grDevices::recordPlot())
}

# earlyj
#' @keywords internal
#' @noRd
.merge_matrix_list <- function(input_list, rowg) {
    lapply(seq_along(input_list), function(i) {
        mat <- input_list[[i]]
        # Accept both regular matrices and sparse matrices
        is_valid <- is.matrix(mat) || inherits(mat, "dgCMatrix") ||
            inherits(mat, "Matrix")
        if (!is_valid || nrow(mat) == 0 || ncol(mat) == 0) {
            stop("Each element must be a non-empty matrix or sparse matrix.")
        }
        if (!rowg) mat <- t(mat)
        if (is.null(colnames(mat))) {
            colnames(mat) <- paste0("cell", seq_len(ncol(mat)))
        }
        colnames(mat) <- paste0(colnames(mat), "-m", i)
        mat
    }) |> do.call(cbind, args = _)
}
#' @keywords internal
#' @noRd

.merge_seurat_list <- function(input_list) {
    if (!requireNamespace("Seurat", quietly = TRUE)) {
        stop(
            "Package 'Seurat' is required but not installed. ",
            "Install it with: BiocManager::install('Seurat')"
        )
    }

    common_features <- Reduce(intersect, lapply(input_list, rownames))
    if (length(common_features) == 0) stop("No common feat among Seurat objs.")

    modified <- lapply(seq_along(input_list), function(i) {
        obj <- subset(input_list[[i]], features = common_features)
        Seurat::RenameCells(obj,
            new.names = paste0(
                Seurat::Cells(obj),
                "-m", i
            )
        )
    })

    do.call(merge, modified)
}
#' @keywords internal
#' @noRd

.merge_sce_list <- function(input_list) {
    if (!requireNamespace("SingleCellExperiment", quietly = TRUE)) {
        stop("SingleCellExperiment package is required but not installed.")
    }

    common_features <- Reduce(intersect, lapply(input_list, rownames))
    if (length(common_features) == 0) stop("No common feat among Seurat objs.")

    modified <- lapply(seq_along(input_list), function(i) {
        obj <- input_list[[i]][common_features, ]
        colnames(obj) <- paste0(colnames(obj), "-m", i)
        obj
    })

    do.call(SummarizedExperiment::cbind, modified)
}

# cutoff_adjacency
#' @keywords internal
#' @noRd

.shuffle_matrix_rows <- function(mat) {
    shuffled <- t(apply(mat, 1, sample))
    rownames(shuffled) <- rownames(mat)
    colnames(shuffled) <- colnames(mat)
    return(shuffled)
}

.run_network_on_shuffled <- function(
    mat,
    method,
    grnboost_modules,
    weight_function,
    quantile_threshold) {
    # Enhanced error handling for shuffled network inference
    tryCatch(
        {
            shuffled <- .shuffle_matrix_rows(mat)

            # Wrap shuffled matrix in MAE for infer_networks
            shuffled_mae <- create_mae(list(shuffled = shuffled))

            inferred <- infer_networks(shuffled_mae,
                method = method,
                grnboost_modules = grnboost_modules
            )
            adjm <- generate_adjacency(inferred)
            symm <- symmetrize(adjm, weight_function = weight_function)
            # Extract first assay from SE
            symm_mat <- SummarizedExperiment::assays(symm)[[1]]
            quantile(symm_mat[upper.tri(symm_mat)], quantile_threshold,
                names = FALSE
            )
        },
        error = function(e) {
            stop("Shuffled netinf failed (", method, "):", conditionMessage(e))
        }
    )
}

# JRF-specific function for joint null distribution
.run_jrf_on_shuffled_joint <- function(
    matrices_list,
    method,
    weight_function,
    quantile_threshold) {
    # Shuffle ALL matrices together (joint null distribution)
    shuffled_list <- lapply(matrices_list, .shuffle_matrix_rows)

    # Wrap in MAE for infer_networks
    shuffled_mae <- create_mae(shuffled_list)

    # Run joint inference on shuffled data
    joint_networks <- infer_networks(shuffled_mae, method = method)

    # Generate adjacency matrices for each condition
    adjm_se <- generate_adjacency(joint_networks)

    # Symmetrize (returns SE)
    symm_se <- symmetrize(adjm_se, weight_function = weight_function)

    # Extract matrices from SE
    symm_list <- as.list(SummarizedExperiment::assays(symm_se))

    # Calculate condition-specific cutoffs from joint null distribution
    cutoffs <- vapply(symm_list, function(symm_adjm) {
        quantile(symm_adjm[upper.tri(symm_adjm)], quantile_threshold,
            names = FALSE
        )
    }, FUN.VALUE = numeric(1))

    return(cutoffs) # Vector of cutoffs, one per condition
}
#' @keywords internal
#' @noRd

.aggregate_cutoffs <- function(results, n_matrices) {
    percentile_vals <- vector("list", n_matrices)
    for (res in results) {
        mat_idx <- res$matrix_idx
        percentile_vals[[mat_idx]] <- c(
            percentile_vals[[mat_idx]],
            res$q_value
        )
    }
    percentile_vals
}
#' @keywords internal
#' @noRd

.binarize_adjacency <- function(weighted_list, cutoffs, method, debug) {
    lapply(seq_along(weighted_list), function(i) {
        avg_cutoff <- mean(cutoffs[[i]])
        if (debug) {
            message(sprintf(
                "[Method: %s] Matrix %d \u2192 Cutoff = %.5f",
                method,
                i,
                avg_cutoff
            ))
        }
        ifelse(weighted_list[[i]] > avg_cutoff, 1, 0)
    })
}

# plotROC
#' @keywords internal
#' @noRd

.prepare_prediction_vectors <- function(pred_matrix, ground_truth) {
    pred_matrix <- as.data.frame(pred_matrix)
    pred_matrix <- pred_matrix[rownames(ground_truth), colnames(ground_truth)]
    as.vector(as.matrix(pred_matrix)[upper.tri(pred_matrix)])
}
#' @keywords internal
#' @noRd

.compute_binary_roc_point <- function(pred_vec, truth_vec) {
    tp <- sum(pred_vec == 1 & truth_vec == 1)
    fp <- sum(pred_vec == 1 & truth_vec == 0)
    fn <- sum(pred_vec == 0 & truth_vec == 1)
    tn <- sum(pred_vec == 0 & truth_vec == 0)

    TPR <- tp / (tp + fn)
    FPR <- fp / (fp + tn)
    list(FPR = FPR, TPR = TPR)
}
#' @keywords internal
#' @noRd

.compute_weighted_roc_curve <- function(pred_vec, truth_vec, label) {
    roc_obj <- pROC::roc(truth_vec, pred_vec, quiet = TRUE)
    auc <- round(roc_obj$auc, 2)

    df <- data.frame(
        FPR = 1 - roc_obj$specificities,
        TPR = roc_obj$sensitivities,
        Matrix = paste0(label, " (AUC=", auc, ")")
    )
    list(df = df, auc = auc)
}
#' @keywords internal
#' @noRd

.plot_roc_curve <- function(roc_data, binary_points = NULL, title = "") {
    total_matrices <- length(unique(roc_data$Matrix))
    colors <- scales::hue_pal()(total_matrices)

    p <- ggplot2::ggplot() +
        ggplot2::labs(
            title = title,
            x = "False Positive Rate (1 - Specificity)",
            y = "True Positive Rate (Sensitivity)"
        ) +
        ggplot2::theme_minimal() +
        ggplot2::theme(
            plot.title = ggplot2::element_text(hjust = 0.5),
            legend.position = "bottom"
        ) +
        ggplot2::geom_abline(
            slope = 1,
            intercept = 0,
            linetype = "dashed",
            color = "grey"
        ) +
        ggplot2::geom_line(
            data = roc_data, ggplot2::aes(
                x = FPR,
                y = TPR,
                color = Matrix
            ),
            linewidth = 1.2
        )

    if (!is.null(binary_points)) {
        p <- p + ggplot2::geom_point(
            data = binary_points,
            ggplot2::aes(x = FPR, y = TPR),
            size = 2, color = "blue"
        )
    }

    p + ggplot2::scale_color_manual(values = colors)
}


# selgene
#' @keywords internal
#' @noRd

.extract_expression <- function(object, assay = NULL) {
    if (inherits(object, "Seurat")) {
        if (!requireNamespace("Seurat", quietly = TRUE)) {
            stop(
                "Package 'Seurat' is required but not installed. ",
                "Install it with: BiocManager::install('Seurat')"
            )
        }
        assay_name <- Seurat::DefaultAssay(object)
        seurat_assay <- object[[assay_name]]
        slots_avail <- methods::slotNames(seurat_assay)

        if (!"data" %in% slots_avail) {
            stop(
                "Assay '", assay_name, "' has no 'data' slot. slots: ",
                paste(slots_avail, collapse = ", ")
            )
        }
        message(
            "Using Seurat assay '",
            assay_name,
            "' slot 'data' (log-normalized)."
        )
        return(seurat_assay@data)
    }

    if (inherits(object, "SingleCellExperiment")) {
        available_assays <- SummarizedExperiment::assayNames(object)
        assay_to_use <- if (!is.null(assay)) assay else "logcounts"

        if (!assay_to_use %in% available_assays) {
            stop(
                "Requested assay '", assay_to_use, "' not found. assays: ",
                paste(available_assays, collapse = ", ")
            )
        }

        message("Using SCE assay '", assay_to_use, "' (log-normalized).")
        return(SummarizedExperiment::assay(object, assay_to_use))
    }

    if (is.matrix(object)) {
        return(object)
    }

    stop("Input must be a Seurat, SingleCellExperiment, or matrix.")
}
#' @keywords internal
#' @noRd

.filter_by_cell_type <- function(expr, object, cell_type, cell_type_col) {
    if (inherits(object, "Seurat")) {
        if (!requireNamespace("Seurat", quietly = TRUE)) {
            stop(
                "Package 'Seurat' is required but not installed. ",
                "Install it with: BiocManager::install('Seurat')"
            )
        }
        meta <- object@meta.data
    } else if (inherits(object, "SingleCellExperiment")) {
        meta <- as.data.frame(SummarizedExperiment::colData(object))
    } else {
        stop("'cell_type' filtering is not supported for raw matrices.")
    }

    if (!cell_type_col %in% colnames(meta)) {
        stop("Metadata must contain column '", cell_type_col, "'.")
    }

    keep_cells <- rownames(meta)[meta[[cell_type_col]] == cell_type]
    message(
        "Subsetted to ",
        length(keep_cells),
        " cells where ",
        cell_type_col,
        " = '",
        cell_type, "'."
    )
    return(expr[, colnames(expr) %in% keep_cells, drop = FALSE])
}
#' @keywords internal
#' @noRd

.filter_genes <- function(expr, remove_mt, remove_rib) {
    gene_names <- rownames(expr)
    keep_genes <- rep(TRUE, length(gene_names))

    if (remove_mt) {
        keep_genes <- keep_genes & !grepl("^MT-",
            gene_names,
            ignore.case = TRUE
        )
        message("Removed mitochondrial genes matching '^MT-'.")
    }

    if (remove_rib) {
        keep_genes <- keep_genes & !grepl("^RP[SL]",
            gene_names,
            ignore.case = TRUE
        )
        message("Removed ribosomal genes matching '^RP[SL]'.")
    }

    expr[keep_genes, , drop = FALSE]
}
#' @keywords internal
#' @noRd

.select_top_genes <- function(expr, top_n) {
    expr <- as.matrix(expr)
    expr <- expr[!duplicated(rownames(expr)), , drop = FALSE]
    expr <- expr[, !duplicated(colnames(expr)), drop = FALSE]

    avg_expression <- rowMeans(expr, na.rm = TRUE)
    sorted_genes <- names(sort(avg_expression, decreasing = TRUE))
    head(sorted_genes, top_n)
}


# Infer_networks
#' @keywords internal
#' @noRd

.convert_counts_list <- function(count_matrices_list) {
    lapply(count_matrices_list, function(obj) {
        if (inherits(obj, "Seurat")) {
            if (!requireNamespace("Seurat", quietly = TRUE)) {
                stop(
                    "Package 'Seurat' is required but not installed. ",
                    "Install it with: BiocManager::install('Seurat')"
                )
            }
            as.matrix(Seurat::GetAssayData(obj,
                assay = "RNA",
                slot = "counts"
            ))
        } else if (inherits(obj, "SingleCellExperiment")) {
            as.matrix(SummarizedExperiment::assay(obj, "counts"))
        } else {
            as.matrix(obj)
        }
    })
}
#' @keywords internal
#' @noRd

.run_genie3 <- function(mat, nCores, params = list()) {
    genie3_args <- modifyList(list(exprMatrix = mat, nCores = nCores), params)
    # Remove seed from GENIE3 args as it's not supported
    genie3_args$seed <- NULL
    adj <- do.call(GENIE3::GENIE3, genie3_args)
    GENIE3::getLinkList(adj)
}
#' @keywords internal
#' @noRd

.run_zilgm <- function(mat, adjm, nCores, params = list()) {
    # Ensure lambda is calculated using original ZILGM method for consistency
    if (is.null(params$lambda)) {
        # Use original ZILGM find_lammax() function
        lambda_max <- find_lammax(mat)
        lambda_min <- 1e-4 * lambda_max
        params$lambda <- exp(seq(log(lambda_max), log(lambda_min),
            length.out = 50
        ))
    }

    # Use updated internal implementation
    zilgm_args <- modifyList(list(
        X = t(mat),
        family = "NBII",
        nlambda = 50,
        nCores = nCores
    ), params)

    fit <- do.call(zilgm_internal, zilgm_args)

    # Use optimal binary network from bootstrap selection
    if (!is.null(fit$opt_index) && fit$opt_index > 0 &&
        fit$opt_index <= length(fit$network)) {
        adj <- fit$network[[fit$opt_index]]
    } else {
        # Fallback to first network if bootstrap failed or invalid index
        adj <- fit$network[[1]]
    }

    # Set proper dimensions
    dimnames(adj) <- if (is.null(adjm)) {
        list(rownames(mat), rownames(mat))
    } else {
        dimnames(adjm)
    }

    adj
}
#' @keywords internal
#' @noRd

.run_jrf <- function(count_matrices_list, ntree = 1000, mtry = NULL) {
    message(
        "[JRF] Running Joint Random Forest for ",
        length(count_matrices_list), " datasets using C implementation..."
    )
    return(.jrf_network(count_matrices_list,
        ntree = ntree, mtry = mtry
    ))
}

#' @keywords internal
#' @noRd
.run_pczinb <- function(mat, adjm, nCores, params = list()) {
    pczinb_args <- modifyList(list(
        X = t(mat),
        method = "poi",
        maxcard = 2,
        alpha = 0.05,
        extend = TRUE,
        max_iter = 100,
        tol = 1e-6,
        nCores = nCores
    ), params)

    adj <- do.call(PCzinb_internal, pczinb_args)

    # Format output matrix
    dimnames(adj) <- if (is.null(adjm)) {
        list(rownames(mat), rownames(mat))
    } else {
        dimnames(adjm)
    }
    adj
}

#' @keywords internal
#' @noRd

.run_parallel_networks <- function(
    count_matrices_list,
    method,
    nCores,
    adjm,
    grnboost_modules,
    params = list()) {
    # Use BiocParallel for parallel processing
    if (method == "GRNBoost2") {
        param_outer <- BiocParallel::MulticoreParam(workers = nCores)
    } else {
        param_outer <- BiocParallel::MulticoreParam(workers = nCores)
    }

    BiocParallel::bplapply(
        seq_along(count_matrices_list),
        function(i) {
            mat <- count_matrices_list[[i]]

            if (method == "GRNBoost2") {
                if (is.null(grnboost_modules)) {
                    stop("Provide grnboost_modules")
                }
                df <- as.data.frame(t(mat))
                genes <- colnames(df)
                rownames(df) <- make.unique(rownames(df))
                df_pandas <- grnboost_modules$pandas$DataFrame(
                    data    = as.matrix(df),
                    columns = genes,
                    index   = rownames(df)
                )
                # Prepare GRNBoost2 arguments
                grnboost_args <- list(
                    expression_data = df_pandas,
                    tf_names = genes
                )

                # Merge with user parameters
                if (length(params) > 0) {
                    grnboost_args <- modifyList(grnboost_args, params)
                }

                result_py <- do.call(
                    grnboost_modules$arboreto$grnboost2,
                    grnboost_args
                )
                result_r <- reticulate::py_to_r(result_py)
                if (is.data.frame(result_r)) {
                    rownames(result_r) <- NULL
                }
                return(result_r)
            } else if (method == "PCzinb") {
                return(.run_pczinb(mat, adjm, nCores, params))
            }
        },
        BPPARAM = param_outer
    )
}


# community similarity
#' @keywords internal
#' @noRd

.compute_topo_metrics <- function(graph, comm) {
    metrics <- c(
        Modularity   = igraph::modularity(graph, comm),
        Communities  = length(unique(comm)),
        Density      = igraph::edge_density(graph),
        Transitivity = igraph::transitivity(graph, type = "global")
    )
    metrics[is.na(metrics)] <- 0
    metrics
}

#' @keywords internal
#' @noRd

.compare_communities <- function(control_comm, pred_comm) {
    c(
        VI  = igraph::compare(control_comm, pred_comm, method = "vi"),
        NMI = igraph::compare(control_comm, pred_comm, method = "nmi"),
        ARI = igraph::compare(control_comm, pred_comm, method = "adjusted.rand")
    )
}

#' @keywords internal
#' @noRd

.plot_radar_communities <- function(comm_df) {
    max_val <- ceiling(max(comm_df, na.rm = TRUE))
    axis_steps <- pretty(c(0, max_val), n = 5)
    radar_comm <- rbind(
        rep(max_val, ncol(comm_df)),
        rep(0, ncol(comm_df)),
        comm_df
    )

    colors <- grDevices::rainbow(nrow(comm_df))
    graphics::par(mfrow = c(1, 1), mar = c(2, 2, 2, 2))

    fmsb::radarchart(radar_comm,
        axistype = 2, pcol = colors, plwd = 2, plty = 1,
        cglcol = "grey", axislabcol = "black",
        caxislabels = axis_steps, vlcex = 1.1,
        title = "Community Similarity Metrics"
    )

    graphics::legend("topright",
        legend = rownames(comm_df),
        col = colors,
        lty = 1,
        lwd = 2
    )
}
#' @keywords internal
#' @noRd

.plot_topo_barplots <- function(topo_df, control_topo) {
    for (i in seq_len(nrow(topo_df))) {
        pred_name <- rownames(topo_df)[i]
        pred_topo <- topo_df[i, ]

        graphics::par(mfrow = c(2, 2), mar = c(4, 4, 4, 2))
        for (metric in colnames(pred_topo)) {
            graphics::barplot(
                height = c(control_topo[[metric]], pred_topo[[metric]]),
                names.arg = c("Control", "Predicted"),
                main = paste0(metric, " Comparison
", pred_name),
                ylab = metric,
                col = c("lightblue", "salmon")
            )
        }
    }
}

# This is edge_mining.R
#' @keywords internal
#' @noRd

.identify_edges <- function(predicted, ground_truth, query_edge_types) {
    indices <- which(
        ((predicted == 1) | (ground_truth == 1)) &
            upper.tri(predicted),
        arr.ind = TRUE
    )

    if (nrow(indices) == 0) {
        return(NULL)
    }

    gene_pairs <- data.frame(
        gene1 = rownames(predicted)[indices[, "row"]],
        gene2 = colnames(predicted)[indices[, "col"]],
        stringsAsFactors = FALSE
    )

    gene_pairs$edge_type <- ifelse(
        predicted[indices] == 1 & ground_truth[indices] == 1,
        "TP",
        ifelse(
            predicted[indices] == 1 & ground_truth[indices] == 0,
            "FP",
            "FN"
        )
    )

    gene_pairs <- gene_pairs[
        gene_pairs$edge_type %in% query_edge_types, ,
        drop = FALSE
    ]

    if (nrow(gene_pairs) == 0) {
        return(NULL)
    }

    return(gene_pairs)
} #' @keywords internal
#' @noRd

.safe_query_pubmed <- function(gene1, gene2, query_field, delay, max_retries) {
    query <- paste0(
        gene1, "[", query_field, "] AND ",
        gene2, "[", query_field, "]"
    )

    for (attempt in seq_len(max_retries)) {
        result <- tryCatch(
            {
                search_res <- rentrez::entrez_search(
                    db = "pubmed",
                    term = query,
                    retmax = 100
                )
                Sys.sleep(delay)
                list(
                    pubmed_hits = as.numeric(search_res$count),
                    PMIDs = if (length(search_res$ids) > 0) {
                        paste(search_res$ids,
                            collapse = ","
                        )
                    } else {
                        NA_character_
                    }
                )
            },
            error = function(e) NULL
        )
        if (!is.null(result)) {
            return(result)
        }
        Sys.sleep(delay)
    }

    return(list(pubmed_hits = NA_integer_, PMIDs = NA_character_))
}
#' @keywords internal
#' @noRd

.query_edge_pairs <- function(
    gene_pairs,
    query_field,
    delay,
    max_retries,
    BPPARAM) {
    pubmed_info <- BiocParallel::bplapply(seq_len(nrow(gene_pairs)),
        function(j) {
            res <- .safe_query_pubmed(
                gene_pairs$gene1[j],
                gene_pairs$gene2[j],
                query_field,
                delay,
                max_retries
            )
            data.frame(
                pubmed_hits = res$pubmed_hits,
                PMIDs = res$PMIDs,
                stringsAsFactors = FALSE
            )
        },
        BPPARAM = BPPARAM
    )

    pubmed_info <- do.call(rbind, pubmed_info)

    gene_pairs$pubmed_hits <- pubmed_info$pubmed_hits
    gene_pairs$PMIDs <- pubmed_info$PMIDs
    gene_pairs$query_status <- ifelse(is.na(gene_pairs$pubmed_hits), "error",
        ifelse(gene_pairs$pubmed_hits == 0,
            "no_hits", "hits_found"
        )
    )

    return(gene_pairs)
}

# This is stringdb
#' @keywords internal
#' @noRd

.map_genes_to_string <- function(string_db, genes) {
    df <- data.frame(genes, stringsAsFactors = FALSE)
    mapped <- string_db$map(df, "genes", removeUnmappedRows = FALSE)
    mapped_clean <- mapped[!is.na(mapped$STRING_id), ]
    unmapped <- setdiff(genes, mapped_clean$genes)
    return(list(mapped = mapped_clean, unmapped = unmapped))
}
#' @keywords internal
#' @noRd

.query_string_api <- function(mapped_ids, species, required_score) {
    base_url <- "https://string-db.org/api/json/network"
    identifiers_str <- paste(mapped_ids, collapse = "
")

    res <- httr::POST(
        url = base_url,
        body = list(
            identifiers    = identifiers_str,
            species        = species,
            required_score = required_score,
            network_type   = "physical"
        ),
        encode = "form"
    )

    if (res$status_code != 200) {
        stop("STRING API query failed. Status code: ", res$status_code)
    }

    interactions <- jsonlite::fromJSON(httr::content(res, "text",
        encoding = "UTF-8"
    ))

    if (!is.data.frame(interactions) || nrow(interactions) == 0) {
        return(NULL)
    }

    return(interactions)
}
#' @keywords internal
#' @noRd

.build_adjacency_matrices <- function(
    interactions,
    mapped_genes,
    genes,
    keep_all_genes) {
    interactions$interaction_score <- interactions$score
    id_to_gene <- setNames(mapped_genes$genes, mapped_genes$STRING_id)
    interactions$gene_A <- id_to_gene[interactions$stringId_A]
    interactions$gene_B <- id_to_gene[interactions$stringId_B]

    interactions <- interactions[!is.na(interactions$gene_A) &
        !is.na(interactions$gene_B), ]

    final_gene_list <- if (keep_all_genes) {
        genes
    } else {
        unique(c(interactions$gene_A, interactions$gene_B))
    }
    p <- length(final_gene_list)

    weighted_mat <- matrix(0,
        nrow = p,
        ncol = p,
        dimnames = list(final_gene_list, final_gene_list)
    )
    for (i in seq_len(nrow(interactions))) {
        a <- interactions$gene_A[i]
        b <- interactions$gene_B[i]
        s <- interactions$interaction_score[i]
        if (!is.na(a) &&
            !is.na(b) &&
            a %in% final_gene_list &&
            b %in% final_gene_list) {
            weighted_mat[a, b] <- s
            weighted_mat[b, a] <- s
        }
    }

    binary_mat <- ifelse(weighted_mat > 0, 1, 0)

    return(list(weighted = weighted_mat, binary = binary_mat))
}
#' @keywords internal
#' @noRd

.zero_matrix_result <- function(genes) {
    zero_mat <- matrix(0,
        length(genes),
        length(genes),
        dimnames = list(genes, genes)
    )
    list(weighted = zero_mat, binary = zero_mat)
}


# This is community_path
#' @keywords internal
#' @noRd

.prepare_method_args <- function(method, method_params) {
    method_args <- list()

    # Extract method-specific parameters
    if (method == "louvain" && !is.null(method_params$resolution)) {
        method_args$resolution <- method_params$resolution
    }

    if (method == "leiden") {
        if (!is.null(method_params$resolution)) {
            method_args$resolution <- method_params$resolution
        }
        if (!is.null(method_params$objective_function)) {
            method_args$objective_function <- method_params$objective_function
        }
        if (!is.null(method_params$beta)) {
            method_args$beta <- method_params$beta
        }
        if (!is.null(method_params$n_iterations)) {
            method_args$n_iterations <- method_params$n_iterations
        }
    }

    if (method == "walktrap") {
        if (!is.null(method_params$steps)) {
            method_args$steps <- method_params$steps
        }
    }

    if (method == "spinglass") {
        if (!is.null(method_params$spins)) {
            method_args$spins <- method_params$spins
        }
        if (!is.null(method_params$start.temp)) {
            method_args$start.temp <- method_params$start.temp
        }
        if (!is.null(method_params$stop.temp)) {
            method_args$stop.temp <- method_params$stop.temp
        }
        if (!is.null(method_params$cool.fact)) {
            method_args$cool.fact <- method_params$cool.fact
        }
        if (!is.null(method_params$gamma)) {
            method_args$gamma <- method_params$gamma
        }
    }

    if (method == "infomap") {
        if (!is.null(method_params$nb.trials)) {
            method_args$nb.trials <- method_params$nb.trials
        }
    }

    return(method_args)
}

# Parameter helper functions for infer_networks
.merge_genie3_params <- function(user_params) {
    defaults <- list(
        regulators = NULL,
        targets = NULL,
        treeMethod = "RF",
        K = "sqrt",
        nTrees = 1000,
        seed = NULL
    )
    modifyList(defaults, user_params)
}

.merge_grnboost2_params <- function(user_params) {
    defaults <- list(
        tf_names = NULL,
        gene_names = NULL,
        client_or_address = NULL,
        seed = NULL
    )
    modifyList(defaults, user_params)
}

.merge_zilgm_params <- function(user_params) {
    # Default parameters for ZILGM (based on original zilgm function signature)
    defaults <- list(
        lambda = NULL,
        nlambda = 50,
        family = "NBII",
        update_type = "IRLS",
        sym = "AND",
        theta = NULL,
        thresh = 1e-6,
        weights_mat = NULL,
        penalty_mat = NULL,
        do_boot = FALSE,
        boot_num = 10,
        beta = 0.05,
        lambda_min_ratio = 1e-4,
        init_select = FALSE,
        verbose = 0
    )
    modifyList(defaults, user_params)
}

.merge_jrf_params <- function(user_params) {
    defaults <- list(
        ntree = 500,
        mtry = NULL,
        nodesize = 5,
        maxnodes = NULL
    )
    modifyList(defaults, user_params)
}

.merge_pczinb_params <- function(user_params) {
    defaults <- list(
        method = "zinb1",
        maxcard = 2,
        alpha = 0.05,
        extend = TRUE,
        max_iter = 100,
        tol = 1e-6
    )
    modifyList(defaults, user_params)
}

.detect_communities <- function(graph, methods, method_params = list(),
                                comparison_params = list(),
                                BPPARAM = BiocParallel::bpparam()) {
    # Merge default comparison parameters
    comparison_defaults <- list(
        measure = "vi",
        type = "independent",
        rewire.w.type = "Rewire",
        verbose = TRUE
    )
    comparison_params <- modifyList(comparison_defaults, comparison_params)

    if (length(methods) == 1) {
        best_method <- methods[1]

        # Prepare method-specific parameters
        method_args <- .prepare_method_args(best_method, method_params)

        best_communities <- do.call(
            robin::membershipCommunities,
            c(list(graph = graph, method = best_method), method_args)
        )
    } else if (length(methods) == 2) {
        # Prepare method-specific parameters for both methods
        args1 <- .prepare_method_args(methods[1], method_params)
        args2 <- .prepare_method_args(methods[2], method_params)

        res <- tryCatch(
            do.call(robin::robinCompare, c(
                list(
                    graph = graph,
                    method1 = methods[1],
                    method2 = methods[2],
                    args1 = args1,
                    args2 = args2,
                    BPPARAM = BPPARAM
                ),
                comparison_params
            )),
            error = function(e) {
                stop(
                    "robinCompare failed: ",
                    conditionMessage(e)
                )
            }
        )

        auc <- robin::robinAUC(res, verbose = comparison_params$verbose)
        if (auc[1] < auc[2]) {
            best_method <- methods[1]
            best_communities <- res$Communities1
        } else {
            best_method <- methods[2]
            best_communities <- res$Communities2
        }
    } else {
        stop("methods must be a character vector of length 1 or 2.")
    }

    return(list(
        best_method = best_method,
        best_communities = best_communities
    ))
}
#' @keywords internal
#' @noRd

.plot_communities <- function(graph, best_method) {
    nisonodes <- igraph::degree(graph) > 0
    plot_graph <- igraph::induced_subgraph(graph,
        vids = igraph::V(graph)[nisonodes]
    )
    ncommunities <- length(unique(igraph::V(plot_graph)$community))

    colors <- if (ncommunities <= 12) {
        RColorBrewer::brewer.pal(ncommunities, "Set3")
    } else {
        grDevices::colorRampPalette(
            RColorBrewer::brewer.pal(12, "Set3")
        )(ncommunities)
    }

    plot_title <- paste0(
        "Community Structure (", best_method, ")
Nodes: ",
        igraph::vcount(plot_graph), " Edges: ", igraph::ecount(plot_graph)
    )

    g <- ggraph::ggraph(plot_graph, layout = "fr") +
        ggraph::geom_edge_link(color = "gray", width = 0.5) +
        ggraph::geom_node_point(ggplot2::aes(color = community), size = 3) +
        ggplot2::scale_color_manual(values = colors) +
        ggplot2::labs(title = plot_title) +
        ggplot2::theme_minimal() +
        ggplot2::theme(
            plot.title = ggplot2::element_text(
                hjust = 0.5,
                size = 14,
                face = "bold"
            ),
            legend.position = "none"
        )

    plot(g)
}
#' @keywords internal
#' @noRd

.enrich_communities <- function(graph,
                                non_isolated_nodes,
                                pathway_db, organism, genes_path) {
    pathway_results <- list()
    non_isolated_genes <- igraph::V(graph)$name[non_isolated_nodes]

    for (comm in unique(igraph::V(graph)$community)) {
        genes <- intersect(
            igraph::V(graph)$name[igraph::V(graph)$community == comm],
            non_isolated_genes
        )

        if (length(genes) < genes_path) {
            pathway_results[[as.character(comm)]] <- NULL
            next
        }

        # Select organism database
        org_db <- if (organism == "human") {
            org.Hs.eg.db::org.Hs.eg.db
        } else {
            org.Mm.eg.db::org.Mm.eg.db
        }

        entrez <- AnnotationDbi::mapIds(org_db,
            keys = genes,
            column = "ENTREZID",
            keytype = "SYMBOL",
            multiVals = "first"
        )
        entrez <- na.omit(entrez)

        if (length(entrez) >= genes_path) {
            # Set organism codes for pathway databases
            kegg_org <- if (organism == "human") "hsa" else "mmu"
            reactome_org <- organism  # "human" or "mouse"

            enrich <- tryCatch(
                {
                    switch(pathway_db,
                        "KEGG" = clusterProfiler::enrichKEGG(
                            gene = entrez,
                            organism = kegg_org,
                            keyType = "kegg"
                        ),
                        "Reactome" = ReactomePA::enrichPathway(
                            gene = entrez,
                            organism = reactome_org
                        ),
                        NULL
                    )
                },
                error = function(e) {
                    warning(
                        "Enrichment failed for community ", comm, ": ",
                        conditionMessage(e)
                    )
                    NULL
                }
            )

            if (!is.null(enrich) && nrow(enrich@result) > 0) {
                pathway_results[[as.character(comm)]] <- enrich
            } else {
                pathway_results[[as.character(comm)]] <- NULL
            }
        } else {
            pathway_results[[as.character(comm)]] <- NULL
        }
    }

    return(pathway_results)
}

# Define global variables to avoid R CMD check NOTEs for ggplot2 aes() usage
utils::globalVariables(c("FPR", "TPR", "community"))

# MultiAssayExperiment utility functions
#' @keywords internal
#' @noRd
.create_sample_map_for_mae <- function(sce_list, exp_names) {
    map_list <- lapply(seq_along(sce_list), function(i) {
        sce <- sce_list[[i]]
        exp_name <- exp_names[i]

        sample_ids <- colnames(sce)
        if (is.null(sample_ids)) {
            sample_ids <- paste0(exp_name, "_cell_", seq_len(ncol(sce)))
        }

        S4Vectors::DataFrame(
            assay = exp_name,
            primary = sample_ids,
            colname = sample_ids
        )
    })

    do.call(rbind, map_list)
}

#' @keywords internal
#' @noRd
.convert_to_sce_list <- function(datasets) {
    lapply(datasets, function(x) {
        if (is.matrix(x) || inherits(x, "dgCMatrix")) {
            SingleCellExperiment::SingleCellExperiment(assays = list(
                counts = x
            ))
        } else if (inherits(x, "Seurat")) {
            if (!requireNamespace("Seurat", quietly = TRUE)) {
                stop(
                    "Package 'Seurat' is required but not installed. ",
                    "Install it with: BiocManager::install('Seurat')"
                )
            }
            counts <- Seurat::GetAssayData(x, slot = "counts")
            SingleCellExperiment::SingleCellExperiment(assays = list(
                counts = counts
            ))
        } else if (inherits(x, "SingleCellExperiment")) {
            x
        } else {
            stop("Unsupported object type: ", class(x))
        }
    })
}

#' @keywords internal
#' @noRd
.extract_from_mae <- function(mae) {
    exps <- MultiAssayExperiment::experiments(mae)
    lapply(exps, function(sce) {
        SummarizedExperiment::assay(sce, "counts")
    })
}

# Network SummarizedExperiment utility functions
#' @keywords internal
#' @noRd
.validate_network_list <- function(networks) {
    if (!is.list(networks)) {
        stop("networks must be a list of matrices")
    }

    dims <- lapply(networks, dim)
    if (length(unique(dims)) > 1) {
        stop("All networks must have the same dimensions")
    }

    gene_names <- rownames(networks[[1]])
    if (is.null(gene_names)) {
        stop("Networks must have rownames (gene names)")
    }

    all_same <- all(vapply(networks, function(x) {
        identical(rownames(x), gene_names) && identical(colnames(x), gene_names)
    }, logical(1)))

    if (!all_same) {
        stop("All networks must have identical row and column names")
    }

    gene_names
}

#' @keywords internal
#' @noRd
.extract_networks_from_se <- function(network_se) {
    if (!inherits(network_se, "SummarizedExperiment")) {
        stop("Input must be a SummarizedExperiment object")
    }
    assays_list <- SummarizedExperiment::assays(network_se)
    as.list(assays_list)
}

#' @keywords internal
#' @noRd
.is_network_se <- function(obj) {
    inherits(obj, "SummarizedExperiment") &&
        !is.null(S4Vectors::metadata(obj)$object_type) &&
        S4Vectors::metadata(obj)$object_type == "network_collection"
}
