R/queryChEA3.R

In rChEA3: R Client for the 'ChEA3' Transcription Factor Enrichment API

#' @keywords internal
.check_chea3_collections <- function(x) {
    expected <- c("Integrated--meanRank", "Integrated--topRank",
                  "GTEx--Coexpression", "ARCHS4--Coexpression",
                  "ENCODE--ChIP-seq", "ReMap--ChIP-seq",
                  "Literature--ChIP-seq", "Enrichr--Queries")
    missing    <- setdiff(expected, names(x))
    unexpected <- setdiff(names(x), expected)

    if (length(missing)) {
        warning("These collections are missing in the response: ",
                paste(missing, collapse = ", "), call. = FALSE)
    }
    if (length(unexpected)) {
        warning("Unexpected collections in the response: ",
                paste(unexpected, collapse = ", "), call. = FALSE)
    }
    invisible(x)
}

# Internal: map API names -> display section/label/description
.chea3_collection_table <- function() {
    data.frame(
        internal = c(
            "Integrated--meanRank", "Integrated--topRank",
            "ENCODE--ChIP-seq", "ReMap--ChIP-seq", "Literature--ChIP-seq",
            "ARCHS4--Coexpression", "GTEx--Coexpression",
            "Enrichr--Queries"
        ),
        section  = c(
            rep("Integrated Results", 2),
            rep("ChIP-Seq", 3),
            rep("Coexpression", 2),
            "Co-occurrence"
        ),
        label    = c(
            "Mean Rank", "Top Rank",
            "ENCODE", "ReMap", "Literature",
            "ARCHS4", "GTEx",
            "Enrichr"
        ),
        description = c(
            "Average integrated ranks across libraries",
            "Top integrated rank across libraries",
            "Interactions mined from the ENCODE project",
            "Interactions mined from the ReMap project",
            "Interactions mined from the literature",
            "TF-target coexpression in the ARCHS4 dataset",
            "TF-target coexpression in the GTEx dataset",
            "TF-target co-occurrence in Enrichr queries"
        ),
        stringsAsFactors = FALSE
    )
}

# Internal: pretty print what's available
.chea3_print_available <- function(parsed) {
    tab <- .chea3_collection_table()
    have <- tab[tab$internal %in% names(parsed), , drop = FALSE]

    if (!nrow(have)) {
        message("No known ChEA3 collections detected in the response.")
        return(invisible(NULL))
    }

    tick   <- if (requireNamespace("cli", quietly = TRUE)) cli::symbol$tick else "\u2714"
    dash   <- if (requireNamespace("cli", quietly = TRUE)) cli::symbol$line else "\u2500"
    green  <- function(x) if (requireNamespace("crayon", quietly = TRUE)) crayon::green(x) else x
    bold   <- function(x) if (requireNamespace("crayon", quietly = TRUE)) crayon::bold(x) else x
    italic <- function(x) if (requireNamespace("crayon", quietly = TRUE)) crayon::italic(x) else x

    # --- New header
    cat(bold("Available results"), "\n")
    cat(paste0(paste(rep(dash, 30), collapse = "")), "\n")

    sections <- unique(have$section)
    for (sec in sections) {
        cat("  \u25BA ", bold(sec), "\n", sep = "")
        sec_rows <- have[have$section == sec, , drop = FALSE]
        for (i in seq_len(nrow(sec_rows))) {
            internal <- sec_rows$internal[i]
            cat("    ", green(tick), " ",
                sec_rows$label[i], " ",
                "\u2014 ", sec_rows$description[i], "\n", sep = "")
            cat("        ",
                italic(paste0("Use <your_result>[[\"", internal, "\"]]")),
                "\n", sep = "")
        }
        cat(paste0("  ", paste(rep(dash, 20), collapse = "")), "\n")
    }
    invisible(NULL)
}

#' @keywords internal
.rchea3_clean_all <- function(results) {
    stopifnot(is.list(results))
    out <- lapply(names(results), function(nm) .rchea3_clean(results[[nm]], nm))
    rlang::set_names(out, names(results))
}

#' @keywords internal
.rchea3_clean <- function(df, collection) {
    stopifnot(is.data.frame(df), is.character(collection), length(collection) == 1)

    if (collection %in% c("Integrated--meanRank", "Integrated--topRank")) {
        df <- dplyr::mutate(
            df,
            dplyr::across(tidyselect::any_of("Rank"),  as.integer),
            dplyr::across(tidyselect::any_of("Score"), as.numeric)
        )
    } else {
        df <- dplyr::mutate(
            df,
            dplyr::across(tidyselect::any_of(c("Rank", "Intersect", "Set length")),
                          as.integer),
            dplyr::across(tidyselect::any_of(c("Scaled Rank", "FET p-value",
                                               "FDR", "Odds Ratio")),
                          as.numeric)
        )
    }
    df
}

#' Query ChEA3 API for TF enrichment
#'
#'#' Sends a gene list to the ChEA3 web service to identify enriched
#' transcription factors using multiple evidence sources.
#' The gene list should consist of HGNC-approved gene symbols.
#'
#' @param genes Character vector of HGNC gene symbols.
#' @param query_name Optional query name (default: "rChEA3_query").
#' @param verbose Logical; if TRUE, print a grouped summary of available
#'   result collections (default: TRUE).
#'
#' @return A named list of data frames. Each element corresponds to a ChEA3
#'   collection and contains an enrichment table with transcription factors and
#'   their statistics. The expected names are:
#'   c("Integrated--meanRank", "Integrated--topRank",
#'     "GTEx--Coexpression", "ARCHS4--Coexpression",
#'     "ENCODE--ChIP-seq", "ReMap--ChIP-seq",
#'     "Literature--ChIP-seq", "Enrichr--Queries").
#' @export
#'
#' @examples
#' \donttest{
#'     results <- queryChEA3(c("SMAD9","FOXO1","MYC","STAT1","STAT3","SMAD3"))
#'     names(results)
#'     head(results[["Integrated--meanRank"]])
#' }
queryChEA3 <- function(genes, query_name = "rChEA3_query", verbose = TRUE) {
    stopifnot(is.character(genes), length(genes) > 0)

    url <- "https://maayanlab.cloud/chea3/api/enrich/"
    payload <- list(query_name = query_name, gene_set = unname(genes))

    resp <- tryCatch(
        httr::POST(url, body = payload, encode = "json"),
        error = function(e) {
            stop("Failed to connect to ChEA3 API. Please check your internet connection.",
                 call. = FALSE)
        }
    )

    if (httr::status_code(resp) != 200) {
        stop("ChEA3 API request failed with status ", httr::status_code(resp),
             ". Please try again later or check the API status at https://maayanlab.cloud/chea3/",
             call. = FALSE)
    }

    txt <- httr::content(resp, "text", encoding = "UTF-8")
    parsed <- jsonlite::fromJSON(txt)

    .check_chea3_collections(parsed)
    if (isTRUE(verbose)) {
        .chea3_print_available(parsed)
    }

    .rchea3_clean_all(parsed)
}