diff --git a/NAMESPACE b/NAMESPACE index 783ba21..e99e5b1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,7 @@ export(exportNetworkToHTML) export(filterSubnetworkByContext) export(getSubnetworkFromIndra) export(get_entity_properties) +export(get_evidence) export(get_network) export(indra_backend) export(prepare_entities) @@ -30,6 +31,7 @@ exportClasses(SubnetworkQuery) exportMethods(backend_capabilities) exportMethods(convert_ids) exportMethods(get_entity_properties) +exportMethods(get_evidence) exportMethods(get_network) importFrom(grDevices, colorRamp, diff --git a/NEWS.md b/NEWS.md index 8ca96ff..0f6a787 100644 --- a/NEWS.md +++ b/NEWS.md @@ -29,6 +29,8 @@ metabolites: other, with no other nodes added?". * `?network_queries` describes the questions a query can ask, with a glossary. `subnetwork_query()` is the first; more are planned. + * `get_evidence(backend, edges)` returns the evidence sentences and + PubMed IDs behind each edge, looked up by `statement_id`. * The S4 classes `NetworkBackend`, `IndraBackend`, `NetworkQuery`, and `SubnetworkQuery` are exported, so other packages can add backends. * New function `validate_network()` checks a `list(nodes, edges)` network @@ -45,6 +47,13 @@ fill. `entity_type` sets the node shape: hexagon for metabolites and lipids, diamond for drugs, octagon for complexes, barrel for families. The legend shows only the node styles, shapes, and edge types present, and covers every statement type of the contract. +* `filterSubnetworkByContext()`, `decomposeSubnetworkByTopic()`, +`decomposeSubnetworkIntoHierarchicalTopics()`, `compareTopicModels()`, and +`bootstrapTopicModels()` take a `backend` argument. By default each edge's +evidence comes from the backend named in its `backend_database` column, so a +network subset or rebuilt with `list(nodes =, edges =)` still works. Pass +`backend` to use one built with non-default settings, such as +`indra_backend(cogex_url = )`. ## Breaking changes @@ -154,6 +163,9 @@ hard-coded human taxon ID. the rows to query with `select_entities()`, and passes all rows to `get_network()`, which matches the nodes INDRA returns against every row. Like `get_network()`, it now prints the question it asks as a message. +* The context and topic functions get edge evidence through `get_evidence()`. +The INDRA evidence lookup now uses the backend's `cogex_url` in place of a +hard-coded URL. Its output is unchanged. # MSstatsBioNet 0.99.0 diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 440e7bb..ab5e914 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -173,6 +173,61 @@ setMethod("get_entity_properties", "NetworkBackend", call. = FALSE) }) +#' Get the evidence behind network edges +#' +#' Looks up the evidence sentences and their PubMed IDs for each edge, +#' using the edge's \code{statement_id}. Edges that share a +#' \code{statement_id} get the same evidence. +#' +#' For INDRA, the evidence comes from CoGEx. Evidence without text is left +#' out, and \code{pmid} is \code{""} for evidence from a source with no +#' PubMed ID. +#' +#' \code{\link{filterSubnetworkByContext}()} and the topic functions call +#' \code{get_evidence()} with the backend named in each edge's +#' \code{backend_database}, unless their \code{backend} argument is given. +#' +#' @param backend a \code{NetworkBackend}, e.g. from +#' \code{\link{indra_backend}()} +#' @param edges the \code{edges} of a network from +#' \code{\link{get_network}()}. Needs the columns \code{source}, +#' \code{target}, \code{interaction}, \code{site}, \code{evidence_url}, and +#' \code{statement_id}. +#' @param ... passed to methods +#' @return data.frame with one row per (edge, evidence sentence) pair and +#' the columns \code{source}, \code{target}, \code{interaction}, +#' \code{site}, \code{evidence_url}, \code{statement_id}, \code{text}, and +#' \code{pmid}. It has no rows, with a warning, when no edge has evidence +#' text. +#' @seealso \code{\link{filterSubnetworkByContext}()} +#' @export +#' @examples +#' \donttest{ +#' input <- data.table::fread(system.file( +#' "extdata/groupComparisonModel.csv", +#' package = "MSstatsBioNet" +#' )) +#' indra <- indra_backend() +#' entities <- prepare_entities(input, entity_type = "protein", +#' id_type = "uniprot") +#' entities <- convert_ids(indra, entities) +#' entities <- select_entities(entities, pvalue_cutoff = 0.05) +#' network <- get_network(indra, entities, interaction_types = "Complex") +#' evidence <- get_evidence(indra, head(network$edges, 2)) +#' head(evidence[, c("source", "target", "pmid", "text")]) +#' } +setGeneric("get_evidence", + function(backend, edges, ...) standardGeneric("get_evidence"), + signature = "backend") + +#' @rdname get_evidence +#' @export +setMethod("get_evidence", "NetworkBackend", + function(backend, edges, ...) { + stop(class(backend), " does not support get_evidence().", + call. = FALSE) + }) + #' What a backend supports #' #' Lists the queries, identifier conversions, entity properties, and diff --git a/R/backend-indra-cogex.R b/R/backend-indra-cogex.R index 38b0bd4..dcf784c 100644 --- a/R/backend-indra-cogex.R +++ b/R/backend-indra-cogex.R @@ -480,3 +480,72 @@ }) return(res) } + + +#' Query INDRA CoGEx for the evidence of statements +#' +#' Hashes that are missing from the response (unknown hashes, or a +#' batch whose request failed) are absent from the returned list. +#' +#' @param stmt_hashes Character vector of statement hash strings +#' @param cogex_url base URL of INDRA CoGEx +#' @param batch_size Number of hashes to request per API call +#' @param sleep Seconds to pause between API calls +#' @return Named list: statement_id -> list of evidence objects. Empty list when +#' no evidence could be retrieved. +#' @keywords internal +#' @noRd +#' @importFrom httr POST status_code content content_type_json +.query_indra_evidence <- function(stmt_hashes, cogex_url = INDRA_API_URL, + batch_size = 100, sleep = 1) { + url <- file.path(cogex_url, "api/get_evidences_for_stmt_hashes") + + stmt_hashes <- unique(as.character(stmt_hashes)) + if (length(stmt_hashes) == 0) return(list()) + + batches <- split(stmt_hashes, ceiling(seq_along(stmt_hashes) / batch_size)) + n_batches <- length(batches) + results <- list() + + cat(sprintf("Fetching evidence for %d hashes in %d batch(es) of up to %d...\n", + length(stmt_hashes), n_batches, batch_size)) + + for (i in seq_along(batches)) { + batch <- batches[[i]] + + parsed <- tryCatch({ + response <- POST( + url, + body = list(stmt_hashes = I(batch)), + encode = "json", + content_type_json() + ) + + if (status_code(response) != 200) { + warning(sprintf("API returned status %d for stmt_hashes: %s", + status_code(response), + paste(batch, collapse = ", "))) + NULL + } else { + content(response, as = "parsed") + } + }, error = function(e) { + warning(sprintf("Error querying stmt_hashes %s: %s", + paste(batch, collapse = ", "), e$message)) + return(NULL) + }) + + cat(sprintf("Progress: %d/%d batches (%.1f%%)\n", + i, n_batches, (i / n_batches) * 100)) + + if (!is.null(parsed)) { + matched <- intersect(names(parsed), batch) + results[matched] <- parsed[matched] + } + + if (i < n_batches) Sys.sleep(sleep) + } + + cat("Done fetching evidence!\n") + results +} diff --git a/R/backend-indra.R b/R/backend-indra.R index 83e2dd8..7881b57 100644 --- a/R/backend-indra.R +++ b/R/backend-indra.R @@ -91,6 +91,102 @@ setMethod("backend_capabilities", "IndraBackend", max_nodes = INDRA_MAX_NODES) }) +# INDRA evidence. Sends the unique statement hashes to CoGEx +# get_evidences_for_stmt_hashes and copies each evidence sentence onto every +# edge row with that hash. Network Search edges carry the same hashes, so +# this covers every INDRA query type. +#' @rdname get_evidence +#' @export +setMethod("get_evidence", "IndraBackend", + function(backend, edges, ...) { + .check_evidence_edge_columns(edges) + statement_ids <- unique(edges$statement_id) + cat(sprintf("Processing %d unique statement hashes...\n", + length(statement_ids))) + evidence_by_statement <- .query_indra_evidence(statement_ids, + backend@cogex_url) + .build_indra_evidence_table(edges, evidence_by_statement) + }) + +#' Edge columns that get_evidence() copies to its output +#' @keywords internal +#' @noRd +EVIDENCE_EDGE_COLUMNS <- c("source", "target", "interaction", "site", + "evidence_url", "statement_id") + +#' Check that edges have the columns get_evidence() needs +#' @param edges edges data.frame +#' @return \code{NULL}, invisibly; errors naming the missing columns +#' @keywords internal +#' @noRd +.check_evidence_edge_columns <- function(edges) { + missing_cols <- setdiff(EVIDENCE_EDGE_COLUMNS, names(edges)) + if (length(missing_cols) > 0) { + stop(sprintf("Missing required columns: %s", + paste(missing_cols, collapse = ", "))) + } + invisible(NULL) +} + +#' Build the evidence table from the CoGEx evidence of each statement +#' @param edges edges data.frame with \code{EVIDENCE_EDGE_COLUMNS} +#' @param evidence_by_statement named list from \code{.query_indra_evidence()} +#' @return data.frame with \code{EVIDENCE_EDGE_COLUMNS}, \code{text}, and +#' \code{pmid}; one row per (edge, evidence with text) pair +#' @keywords internal +#' @noRd +.build_indra_evidence_table <- function(edges, evidence_by_statement) { + results_list <- list() + result_count <- 0 + + for (statement_id in unique(edges$statement_id)) { + evidence_list <- evidence_by_statement[[as.character(statement_id)]] + if (is.null(evidence_list) || length(evidence_list) == 0) next + + matching_indices <- which(edges$statement_id == statement_id) + + for (evidence in evidence_list) { + if (!is.null(evidence[["text"]]) && nchar(evidence[["text"]]) > 0) { + for (idx in matching_indices) { + result_count <- result_count + 1 + results_list[[result_count]] <- data.frame( + source = edges$source[idx], + target = edges$target[idx], + interaction = edges$interaction[idx], + site = edges$site[idx], + evidence_url = edges$evidence_url[idx], + statement_id = edges$statement_id[idx], + text = evidence[["text"]], + pmid = if (is.null(evidence[["pmid"]])) "" else evidence[["pmid"]], + stringsAsFactors = FALSE + ) + } + } + } + } + + if (result_count == 0) { + warning("No evidence text found for any statement hash") + return(.build_empty_evidence_table()) + } + + results_df <- do.call(rbind, results_list) + cat(sprintf("\nComplete! Found %d evidence text entries.\n", nrow(results_df))) + results_df +} + +#' Evidence table with no rows +#' @return data.frame with the get_evidence() columns and no rows +#' @keywords internal +#' @noRd +.build_empty_evidence_table <- function() { + data.frame( + source = character(), target = character(), interaction = character(), + site = character(), evidence_url = character(), statement_id = character(), + text = character(), pmid = character(), stringsAsFactors = FALSE + ) +} + #' The question a subnetwork query asks, with the entity counts #' #' Printed by \code{get_network()}, e.g. "INDRA subnetwork: how are 42 diff --git a/R/backend-registry.R b/R/backend-registry.R new file mode 100644 index 0000000..51f2f46 --- /dev/null +++ b/R/backend-registry.R @@ -0,0 +1,87 @@ +#' Default backend for each backend_database value +#' +#' Used when a function that takes a finished network is called with +#' \code{backend = NULL}: each edge goes to the backend named in its +#' \code{backend_database}, built with default settings. +#' @keywords internal +#' @noRd +BACKEND_CONSTRUCTORS <- list( + INDRA = function() indra_backend() +) + +#' Check a backend argument +#' @param backend \code{NULL} or a \code{NetworkBackend} +#' @return \code{NULL}, invisibly; errors otherwise +#' @keywords internal +#' @noRd +.check_backend_argument <- function(backend) { + if (!is.null(backend) && !methods::is(backend, "NetworkBackend")) { + stop("`backend` must be NULL or a NetworkBackend, e.g. from ", + "indra_backend().", call. = FALSE) + } + invisible(NULL) +} + +#' Split edges by the backend that answers for them +#' +#' With \code{backend = NULL}, the edges are split by +#' \code{backend_database} and each group gets that value's default backend +#' from \code{BACKEND_CONSTRUCTORS}. A given \code{backend} takes all edges. +#' +#' @param edges edges data.frame +#' @param backend \code{NULL} or a \code{NetworkBackend} +#' @return list of \code{list(backend =, edges =)}, one per backend, in +#' order of first appearance in \code{edges} +#' @keywords internal +#' @noRd +.split_edges_by_backend <- function(edges, backend = NULL) { + .check_backend_argument(backend) + if (!is.null(backend)) { + return(list(list(backend = backend, edges = edges))) + } + if (!"backend_database" %in% names(edges)) { + stop("`edges` has no `backend_database` column, so the backend ", + "can't be chosen. Pass `backend`, e.g. ", + "`backend = indra_backend()`.", call. = FALSE) + } + databases <- as.character(edges$backend_database) + if (anyNA(databases) || any(!nzchar(databases))) { + stop("`backend_database` is missing for some edges. Pass ", + "`backend`, e.g. `backend = indra_backend()`.", call. = FALSE) + } + unknown <- setdiff(unique(databases), names(BACKEND_CONSTRUCTORS)) + if (length(unknown) > 0) { + stop("No default backend for backend_database ", + paste0("\"", unknown, "\"", collapse = ", "), + ". Pass `backend` to choose one.", call. = FALSE) + } + lapply(unique(databases), function(database) { + list(backend = BACKEND_CONSTRUCTORS[[database]](), + edges = edges[databases == database, , drop = FALSE]) + }) +} + +#' Get the evidence of edges from the backend of each edge +#' +#' Calls \code{get_evidence()} once per backend, see +#' \code{.split_edges_by_backend()}, and stacks the results. +#' +#' @param edges edges data.frame +#' @param backend \code{NULL} or a \code{NetworkBackend} +#' @return evidence data.frame, as from \code{get_evidence()} +#' @keywords internal +#' @noRd +.fetch_evidence <- function(edges, backend = NULL) { + groups <- .split_edges_by_backend(edges, backend) + if (length(groups) == 0) { + warning("No evidence text found for any statement hash") + return(.build_empty_evidence_table()) + } + evidence <- lapply(groups, function(group) { + get_evidence(group$backend, group$edges) + }) + if (length(evidence) == 1) { + return(evidence[[1]]) + } + do.call(rbind, evidence) +} diff --git a/R/bootstrapTopicModels.R b/R/bootstrapTopicModels.R index c0c997e..d99b299 100644 --- a/R/bootstrapTopicModels.R +++ b/R/bootstrapTopicModels.R @@ -30,6 +30,10 @@ #' @param tol relative-change tolerance for NMF early stopping. Default 1e-4. #' @param seed random seed for the reference fit, the resampling, and each #' bootstrap NMF. Default 1. +#' @param backend the backend to get the evidence from, e.g. +#' \code{\link{indra_backend}()}. \code{NULL} (default) uses the default +#' backend named in each edge's \code{backend_database}. See +#' \code{\link{get_evidence}()}. #' #' @return A list with #' \describe{ @@ -73,7 +77,8 @@ bootstrapTopicModels <- function(subnetwork, min_term_count = 2, max_iter = 200, tol = 1e-4, - seed = 1) { + seed = 1, + backend = NULL) { .validateDecomposeSubnetworkByTopicInput(subnetwork, n_topics, 0.2, include_ppi) @@ -82,9 +87,11 @@ bootstrapTopicModels <- function(subnetwork, stop("`n_boot` must be a single integer >= 2.") } n_boot <- as.integer(n_boot) + .check_backend_argument(backend) # Build the shared matrices once; keep the vocabulary fixed across resamples. - mats <- .buildTopicMatrices(subnetwork, n_topics, min_term_count) + mats <- .buildTopicMatrices(subnetwork, n_topics, min_term_count, + backend = backend) X_text <- mats$X_text X_edges <- mats$X_edges k <- mats$n_topics diff --git a/R/compareTopicModels.R b/R/compareTopicModels.R index 4476209..bcfd631 100644 --- a/R/compareTopicModels.R +++ b/R/compareTopicModels.R @@ -44,6 +44,10 @@ #' @param max_iter maximum number of NMF multiplicative-update iterations. #' Default 200. #' @param tol relative-change tolerance for NMF early stopping. Default 1e-4. +#' @param backend the backend to get the evidence from, e.g. +#' \code{\link{indra_backend}()}. \code{NULL} (default) uses the default +#' backend named in each edge's \code{backend_database}. See +#' \code{\link{get_evidence}()}. #' #' @return A list with #' \describe{ @@ -87,7 +91,8 @@ compareTopicModels <- function(subnetwork, unit = c("edges", "papers"), min_term_count = 2, max_iter = 200, - tol = 1e-4) { + tol = 1e-4, + backend = NULL) { unit <- match.arg(unit) # Reuse the decompose validator for subnetwork/n_topics structure. @@ -97,9 +102,11 @@ compareTopicModels <- function(subnetwork, stop("`seeds` must be a vector of at least two integer seeds.") } seeds <- as.integer(seeds) + .check_backend_argument(backend) # Build the shared matrices once; only the NMF is repeated per seed. - mats <- .buildTopicMatrices(subnetwork, n_topics, min_term_count) + mats <- .buildTopicMatrices(subnetwork, n_topics, min_term_count, + backend = backend) X_text <- mats$X_text X_edges <- mats$X_edges k <- mats$n_topics diff --git a/R/decomposeSubnetworkByTopic.R b/R/decomposeSubnetworkByTopic.R index cd46e31..58dff91 100644 --- a/R/decomposeSubnetworkByTopic.R +++ b/R/decomposeSubnetworkByTopic.R @@ -6,7 +6,8 @@ #' #' The procedure is: #' \enumerate{ -#' \item For every edge, the supporting INDRA evidence is retrieved and the +#' \item For every edge, the supporting evidence is retrieved from the +#' backend (see \code{\link{get_evidence}}) and the #' PubMed abstract of each referenced PMID is fetched. Papers (PMIDs) are #' the shared unit of analysis. #' \item Two matrices are built that share the same rows (papers): @@ -52,10 +53,14 @@ #' \code{attr(topics, "corpus")$evidence} from a previous call. It is subset #' to the edges of \code{subnetwork}, so the evidence gathered for a parent #' network can be reused for any of its topic subnetworks. When \code{NULL} -#' (default) the evidence is queried from INDRA. +#' (default) the evidence is queried from the backend. #' @param abstracts optional named character vector (or list) mapping PMID to #' abstract text, e.g. \code{attr(topics, "corpus")$abstracts}. Only PMIDs #' missing from it are fetched from PubMed. Default \code{NULL} fetches all. +#' @param backend the backend to get the evidence from, e.g. +#' \code{\link{indra_backend}()}. \code{NULL} (default) uses the default +#' backend named in each edge's \code{backend_database}. See +#' \code{\link{get_evidence}()}. #' #' @return A list of length \code{n_topics}, named \code{topic_1} ... #' \code{topic_k}. Each element is a topic-specific subnetwork: a list with @@ -93,7 +98,7 @@ #' topics$topic_1$topTerms #' exportNetworkToHTML(topics$topic_1$nodes, topics$topic_1$edges) #' -#' # Re-decompose a topic without re-querying INDRA / PubMed. +#' # Re-decompose a topic without re-querying the backend / PubMed. #' corpus <- attr(topics, "corpus") #' topics_deeper <- decomposeSubnetworkByTopic( #' topics$topic_1, n_topics = 5, @@ -110,15 +115,18 @@ decomposeSubnetworkByTopic <- function(subnetwork, seed = 1, include_ppi = TRUE, evidence = NULL, - abstracts = NULL) { + abstracts = NULL, + backend = NULL) { .validateDecomposeSubnetworkByTopicInput(subnetwork, n_topics, edge_topic_cutoff, include_ppi) .validateTopicCorpusInput(evidence, abstracts) + .check_backend_argument(backend) # 1-3. Build the shared paper-by-word and paper-by-edge matrices. mats <- .buildTopicMatrices(subnetwork, n_topics, min_term_count, - evidence = evidence, abstracts = abstracts) + evidence = evidence, abstracts = abstracts, + backend = backend) nodes <- mats$nodes edges <- mats$edges pmids <- mats$pmids diff --git a/R/decomposeSubnetworkIntoHierarchicalTopics.R b/R/decomposeSubnetworkIntoHierarchicalTopics.R index 06a0584..e6ea323 100644 --- a/R/decomposeSubnetworkIntoHierarchicalTopics.R +++ b/R/decomposeSubnetworkIntoHierarchicalTopics.R @@ -5,7 +5,7 @@ #' (at most \code{max_edges} edges), producing a topic tree: broad themes near #' the root and increasingly specific sub-themes towards the leaves. #' -#' INDRA evidence and PubMed abstracts are gathered once for the input +#' Edge evidence and PubMed abstracts are gathered once for the input #' subnetwork and reused for every sub-decomposition, so no further network #' requests are made during the recursion. Each sub-decomposition rebuilds its #' vocabulary and refits the NMF on only the papers supporting that branch's @@ -38,10 +38,14 @@ #' @param evidence optional pre-fetched evidence data.frame, e.g. #' \code{attr(topics, "corpus")$evidence} from #' \code{\link{decomposeSubnetworkByTopic}} or \code{result$corpus$evidence} -#' from a previous call of this function. Default \code{NULL} queries INDRA -#' once. +#' from a previous call of this function. Default \code{NULL} queries the +#' backend once. #' @param abstracts optional named character vector mapping PMID to abstract #' text. Only missing PMIDs are fetched from PubMed. Default \code{NULL}. +#' @param backend the backend to get the evidence from, e.g. +#' \code{\link{indra_backend}()}. \code{NULL} (default) uses the default +#' backend named in each edge's \code{backend_database}. See +#' \code{\link{get_evidence}()}. #' @param ... further arguments passed to #' \code{\link{decomposeSubnetworkByTopic}}, e.g. \code{n_top_terms}, #' \code{min_term_count}, \code{include_ppi}, \code{seed}. @@ -106,11 +110,13 @@ decomposeSubnetworkIntoHierarchicalTopics <- function(subnetwork, max_depth = 5, evidence = NULL, abstracts = NULL, + backend = NULL, ...) { .validateDecomposeSubnetworkByTopicInput(subnetwork, n_topics, edge_topic_cutoff) .validateTopicCorpusInput(evidence, abstracts) + .check_backend_argument(backend) if (!is.numeric(max_edges) || length(max_edges) != 1L || is.na(max_edges) || max_edges < 1) { stop("`max_edges` must be a single number >= 1.") @@ -122,7 +128,8 @@ decomposeSubnetworkIntoHierarchicalTopics <- function(subnetwork, } # Gather the corpus once; every sub-decomposition reuses it. - corpus <- .gatherTopicCorpus(subnetwork$edges, evidence, abstracts) + corpus <- .gatherTopicCorpus(subnetwork$edges, evidence, abstracts, + backend) root <- list(nodes = subnetwork$nodes, edges = subnetwork$edges, topTerms = character(0), pmids = character(0)) diff --git a/R/filterSubnetworkByContext.R b/R/filterSubnetworkByContext.R index d6fdc49..cb6ca9f 100644 --- a/R/filterSubnetworkByContext.R +++ b/R/filterSubnetworkByContext.R @@ -49,6 +49,11 @@ #' "colon" and "colon-specific" but not "colonize" or "colons"; list #' variants such as plurals explicitly. To exclude by keyword only, omit #' \code{query}. Default \code{NULL} excludes nothing. +#' @param backend the backend to get the evidence from, e.g. +#' \code{\link{indra_backend}()}. \code{NULL} (default) uses the default +#' backend named in each edge's \code{backend_database}. Pass a backend +#' built with non-default settings, such as a different URL, here. +#' See \code{\link{get_evidence}()}. #' #' @return A named list with four elements: #' \item{nodes}{Filtered nodes dataframe (only nodes present in kept edges)} @@ -62,7 +67,7 @@ #' The \code{evidence} and \code{abstracts} elements can be passed to the #' same-named arguments of \code{\link{decomposeSubnetworkByTopic}} or #' \code{\link{decomposeSubnetworkIntoHierarchicalTopics}}, together with the -#' returned list as \code{subnetwork}, so INDRA and PubMed are not queried +#' returned list as \code{subnetwork}, so the backend and PubMed are not queried #' again. #' #' @examples @@ -89,9 +94,11 @@ filterSubnetworkByContext <- function(nodes, query = NULL, cutoff = NULL, method = c("tag_count", "cosine"), - exclude_keywords = NULL) { + exclude_keywords = NULL, + backend = NULL) { method <- match.arg(method) + .check_backend_argument(backend) if (is.character(query)) query <- trimws(query) if (is.character(exclude_keywords)) exclude_keywords <- trimws(exclude_keywords) @@ -140,7 +147,7 @@ filterSubnetworkByContext <- function(nodes, )) } - evidence <- .extract_evidence_text(edges) + evidence <- .fetch_evidence(edges, backend) if (nrow(evidence) == 0) { evidence$score <- if (method == "tag_count") integer(0) else numeric(0) @@ -344,70 +351,6 @@ filterSubnetworkByContext <- function(nodes, -#' Extract evidence text from edges dataframe via INDRA API -#' @param df Edges dataframe with columns: source, target, interaction, site, -#' evidence_url, statement_id -#' @return Dataframe with additional columns: text, pmid -#' @keywords internal -#' @noRd -.extract_evidence_text <- function(df) { - - required_cols <- c("source", "target", "interaction", "site", "evidence_url", "statement_id") - missing_cols <- setdiff(required_cols, names(df)) - if (length(missing_cols) > 0) { - stop(sprintf("Missing required columns: %s", paste(missing_cols, collapse = ", "))) - } - - results_list <- list() - result_count <- 0 - unique_hashes <- unique(df$statement_id) - n_hashes <- length(unique_hashes) - - cat(sprintf("Processing %d unique statement hashes...\n", n_hashes)) - - evidence_by_hash <- .query_indra_evidence(unique_hashes) - - for (hash in unique_hashes) { - evidence_list <- evidence_by_hash[[as.character(hash)]] - if (is.null(evidence_list) || length(evidence_list) == 0) next - - matching_indices <- which(df$statement_id == hash) - - for (evidence in evidence_list) { - if (!is.null(evidence[["text"]]) && nchar(evidence[["text"]]) > 0) { - for (idx in matching_indices) { - result_count <- result_count + 1 - results_list[[result_count]] <- data.frame( - source = df$source[idx], - target = df$target[idx], - interaction = df$interaction[idx], - site = df$site[idx], - evidence_url = df$evidence_url[idx], - statement_id = df$statement_id[idx], - text = evidence[["text"]], - pmid = if (is.null(evidence[["pmid"]])) "" else evidence[["pmid"]], - stringsAsFactors = FALSE - ) - } - } - } - } - - if (result_count == 0) { - warning("No evidence text found for any statement hash") - return(data.frame( - source = character(), target = character(), interaction = character(), - site = character(), evidence_url = character(), statement_id = character(), - text = character(), pmid = character(), stringsAsFactors = FALSE - )) - } - - results_df <- do.call(rbind, results_list) - cat(sprintf("\nComplete! Found %d evidence text entries.\n", nrow(results_df))) - return(results_df) -} - - #' Fetch and clean PubMed abstracts via rentrez. #' #' PMIDs that are missing from the response (unknown IDs, or a batch whose @@ -495,71 +438,3 @@ filterSubnetworkByContext <- function(nodes, abstracts[!is.na(pmids) & nzchar(pmids)] } - - -#' Query INDRA API for evidence text -#' -#' Hashes that are missing from the response (unknown hashes, or a -#' batch whose request failed) are absent from the returned list. -#' -#' @param stmt_hashes Character vector of statement hash strings -#' @param batch_size Number of hashes to request per API call -#' @param sleep Seconds to pause between API calls -#' @return Named list: statement_id -> list of evidence objects. Empty list when -#' no evidence could be retrieved. -#' @keywords internal -#' @noRd -#' @importFrom httr POST status_code content content_type_json -#' @importFrom jsonlite fromJSON -.query_indra_evidence <- function(stmt_hashes, batch_size = 100, sleep = 1) { - url <- "https://discovery.indra.bio/api/get_evidences_for_stmt_hashes" - - stmt_hashes <- unique(as.character(stmt_hashes)) - if (length(stmt_hashes) == 0) return(list()) - - batches <- split(stmt_hashes, ceiling(seq_along(stmt_hashes) / batch_size)) - n_batches <- length(batches) - results <- list() - - cat(sprintf("Fetching evidence for %d hashes in %d batch(es) of up to %d...\n", - length(stmt_hashes), n_batches, batch_size)) - - for (i in seq_along(batches)) { - batch <- batches[[i]] - - parsed <- tryCatch({ - response <- POST( - url, - body = list(stmt_hashes = I(batch)), - encode = "json", - content_type_json() - ) - - if (status_code(response) != 200) { - warning(sprintf("API returned status %d for stmt_hashes: %s", - status_code(response), - paste(batch, collapse = ", "))) - NULL - } else { - content(response, as = "parsed") - } - }, error = function(e) { - warning(sprintf("Error querying stmt_hashes %s: %s", - paste(batch, collapse = ", "), e$message)) - return(NULL) - }) - - cat(sprintf("Progress: %d/%d batches (%.1f%%)\n", - i, n_batches, (i / n_batches) * 100)) - - if (!is.null(parsed)) { - matched <- intersect(names(parsed), batch) - results[matched] <- parsed[matched] - } - - if (i < n_batches) Sys.sleep(sleep) - } - - cat("Done fetching evidence!\n") - results -} \ No newline at end of file diff --git a/R/utils_decomposeSubnetworkByTopic.R b/R/utils_decomposeSubnetworkByTopic.R index 0644bf0..d6d9f92 100644 --- a/R/utils_decomposeSubnetworkByTopic.R +++ b/R/utils_decomposeSubnetworkByTopic.R @@ -58,7 +58,7 @@ #' #' Performs the data-preparation steps shared by #' \code{\link{decomposeSubnetworkByTopic}} and -#' \code{\link{compareTopicModels}}: extracts INDRA evidence, fetches and +#' \code{\link{compareTopicModels}}: gets the edge evidence, fetches and #' tokenises the PubMed abstracts, and builds the aligned \code{X_text} #' (papers x words) and \code{X_edges} (papers x edges) matrices. Factored out #' so the (network-bound) abstract fetch and matrix construction happen once and @@ -69,23 +69,25 @@ #' fewer papers than topics are available #' @param min_term_count minimum corpus term frequency to keep a word #' @param evidence optional pre-fetched evidence data.frame (as returned by -#' \code{.extract_evidence_text}); subset to the subnetwork's edges. When -#' NULL, evidence is queried from INDRA. +#' \code{get_evidence()}); subset to the subnetwork's edges. When +#' NULL, evidence is queried from the backend. #' @param abstracts optional named character vector (or list) mapping PMID to #' abstract text. Only PMIDs missing from it are fetched from PubMed. +#' @param backend NULL or a NetworkBackend, see \code{.fetch_evidence()} #' @return list with `nodes`, `edges`, `evidence`, `abstracts`, `pmids`, #' `edge_keys`, `X_text`, `X_edges`, and the (possibly reduced) `n_topics` #' @keywords internal #' @noRd .buildTopicMatrices <- function(subnetwork, n_topics, min_term_count = 2, - evidence = NULL, abstracts = NULL) { + evidence = NULL, abstracts = NULL, + backend = NULL) { nodes <- subnetwork$nodes edges <- subnetwork$edges n_topics <- as.integer(n_topics) # 1. Evidence (paper <-> edge links) for every edge and the abstracts of # the supporting papers, reusing any supplied evidence / abstracts. - corpus <- .gatherTopicCorpus(edges, evidence, abstracts) + corpus <- .gatherTopicCorpus(edges, evidence, abstracts, backend) evidence <- corpus$evidence abstracts <- corpus$abstracts if (nrow(evidence) == 0) { @@ -117,23 +119,25 @@ } -#' Gather the INDRA evidence and PubMed abstracts for a set of edges +#' Gather the edge evidence and PubMed abstracts for a set of edges #' #' Network-bound step shared by \code{\link{decomposeSubnetworkByTopic}} and #' \code{\link{decomposeSubnetworkIntoHierarchicalTopics}}. A supplied -#' `evidence` table is subset to `edges` instead of re-querying INDRA, and only +#' `evidence` table is subset to `edges` instead of re-querying the backend, and only #' PMIDs missing from `abstracts` are fetched from PubMed. #' #' @param edges edges data.frame #' @param evidence NULL or pre-fetched evidence data.frame #' @param abstracts NULL or named character vector / list of abstracts +#' @param backend NULL or a NetworkBackend, see \code{.fetch_evidence()} #' @return list with `evidence` (PMID-backed rows only) and `abstracts` #' (named character vector covering every PMID in `evidence`) #' @keywords internal #' @noRd -.gatherTopicCorpus <- function(edges, evidence = NULL, abstracts = NULL) { +.gatherTopicCorpus <- function(edges, evidence = NULL, abstracts = NULL, + backend = NULL) { if (is.null(evidence)) { - evidence <- .extract_evidence_text(edges) + evidence <- .fetch_evidence(edges, backend) } else { evidence <- .subsetEvidenceToEdges(evidence, edges) } @@ -159,8 +163,8 @@ #' Restrict a pre-fetched evidence table to the edges of a subnetwork #' #' Matches on the edge key (source, target, interaction) together with the -#' statement hash, so the result equals what \code{.extract_evidence_text} -#' would return for \code{edges} without re-querying INDRA. +#' statement hash, so the result equals what \code{get_evidence()} +#' would return for \code{edges} without re-querying the backend. #' #' @param evidence evidence data.frame with `source`, `target`, `interaction`, #' `statement_id`, and `pmid` columns @@ -255,7 +259,7 @@ #' Build the paper-by-edge matrix (X_edges) of evidence counts #' -#' @param evidence data.frame from \code{.extract_evidence_text}; one row per +#' @param evidence data.frame from \code{get_evidence()}; one row per #' evidence sentence with `pmid`, `source`, `target`, `interaction`. #' @param pmids character vector of PubMed IDs (rows of the matrix) #' @param edge_keys character vector of unique edge keys (columns of the matrix) diff --git a/man/bootstrapTopicModels.Rd b/man/bootstrapTopicModels.Rd index 5e4b640..19244d3 100644 --- a/man/bootstrapTopicModels.Rd +++ b/man/bootstrapTopicModels.Rd @@ -13,7 +13,8 @@ bootstrapTopicModels( min_term_count = 2, max_iter = 200, tol = 1e-04, - seed = 1 + seed = 1, + backend = NULL ) } \arguments{ @@ -41,6 +42,11 @@ Default 200.} \item{seed}{random seed for the reference fit, the resampling, and each bootstrap NMF. Default 1.} + +\item{backend}{the backend to get the evidence from, e.g. +\code{\link{indra_backend}()}. \code{NULL} (default) uses the default +backend named in each edge's \code{backend_database}. See +\code{\link{get_evidence}()}.} } \value{ A list with diff --git a/man/compareTopicModels.Rd b/man/compareTopicModels.Rd index 4831fe3..3d52084 100644 --- a/man/compareTopicModels.Rd +++ b/man/compareTopicModels.Rd @@ -11,7 +11,8 @@ compareTopicModels( unit = c("edges", "papers"), min_term_count = 2, max_iter = 200, - tol = 1e-04 + tol = 1e-04, + backend = NULL ) } \arguments{ @@ -34,6 +35,11 @@ building the text matrix. Default 2.} Default 200.} \item{tol}{relative-change tolerance for NMF early stopping. Default 1e-4.} + +\item{backend}{the backend to get the evidence from, e.g. +\code{\link{indra_backend}()}. \code{NULL} (default) uses the default +backend named in each edge's \code{backend_database}. See +\code{\link{get_evidence}()}.} } \value{ A list with diff --git a/man/decomposeSubnetworkByTopic.Rd b/man/decomposeSubnetworkByTopic.Rd index 8db14b0..06247c4 100644 --- a/man/decomposeSubnetworkByTopic.Rd +++ b/man/decomposeSubnetworkByTopic.Rd @@ -15,7 +15,8 @@ decomposeSubnetworkByTopic( seed = 1, include_ppi = TRUE, evidence = NULL, - abstracts = NULL + abstracts = NULL, + backend = NULL ) } \arguments{ @@ -51,11 +52,16 @@ text-learned topics, so the PPIs do not influence the topics themselves.} \code{attr(topics, "corpus")$evidence} from a previous call. It is subset to the edges of \code{subnetwork}, so the evidence gathered for a parent network can be reused for any of its topic subnetworks. When \code{NULL} -(default) the evidence is queried from INDRA.} +(default) the evidence is queried from the backend.} \item{abstracts}{optional named character vector (or list) mapping PMID to abstract text, e.g. \code{attr(topics, "corpus")$abstracts}. Only PMIDs missing from it are fetched from PubMed. Default \code{NULL} fetches all.} + +\item{backend}{the backend to get the evidence from, e.g. +\code{\link{indra_backend}()}. \code{NULL} (default) uses the default +backend named in each edge's \code{backend_database}. See +\code{\link{get_evidence}()}.} } \value{ A list of length \code{n_topics}, named \code{topic_1} ... @@ -82,7 +88,8 @@ unsupervised non-negative matrix factorization (NMF). \details{ The procedure is: \enumerate{ - \item For every edge, the supporting INDRA evidence is retrieved and the + \item For every edge, the supporting evidence is retrieved from the + backend (see \code{\link{get_evidence}}) and the PubMed abstract of each referenced PMID is fetched. Papers (PMIDs) are the shared unit of analysis. \item Two matrices are built that share the same rows (papers): @@ -120,7 +127,7 @@ topics <- decomposeSubnetworkByTopic(subnetwork, n_topics = 5) topics$topic_1$topTerms exportNetworkToHTML(topics$topic_1$nodes, topics$topic_1$edges) -# Re-decompose a topic without re-querying INDRA / PubMed. +# Re-decompose a topic without re-querying the backend / PubMed. corpus <- attr(topics, "corpus") topics_deeper <- decomposeSubnetworkByTopic( topics$topic_1, n_topics = 5, diff --git a/man/decomposeSubnetworkIntoHierarchicalTopics.Rd b/man/decomposeSubnetworkIntoHierarchicalTopics.Rd index d7b3d16..daf01ed 100644 --- a/man/decomposeSubnetworkIntoHierarchicalTopics.Rd +++ b/man/decomposeSubnetworkIntoHierarchicalTopics.Rd @@ -12,6 +12,7 @@ decomposeSubnetworkIntoHierarchicalTopics( max_depth = 5, evidence = NULL, abstracts = NULL, + backend = NULL, ... ) } @@ -34,12 +35,17 @@ edges. Lower values allow an edge to appear in several sibling topics.} \item{evidence}{optional pre-fetched evidence data.frame, e.g. \code{attr(topics, "corpus")$evidence} from \code{\link{decomposeSubnetworkByTopic}} or \code{result$corpus$evidence} -from a previous call of this function. Default \code{NULL} queries INDRA -once.} +from a previous call of this function. Default \code{NULL} queries the +backend once.} \item{abstracts}{optional named character vector mapping PMID to abstract text. Only missing PMIDs are fetched from PubMed. Default \code{NULL}.} +\item{backend}{the backend to get the evidence from, e.g. +\code{\link{indra_backend}()}. \code{NULL} (default) uses the default +backend named in each edge's \code{backend_database}. See +\code{\link{get_evidence}()}.} + \item{...}{further arguments passed to \code{\link{decomposeSubnetworkByTopic}}, e.g. \code{n_top_terms}, \code{min_term_count}, \code{include_ppi}, \code{seed}.} @@ -77,7 +83,7 @@ topic subnetworks until every branch is small enough to inspect by hand the root and increasingly specific sub-themes towards the leaves. } \details{ -INDRA evidence and PubMed abstracts are gathered once for the input +Edge evidence and PubMed abstracts are gathered once for the input subnetwork and reused for every sub-decomposition, so no further network requests are made during the recursion. Each sub-decomposition rebuilds its vocabulary and refits the NMF on only the papers supporting that branch's diff --git a/man/filterSubnetworkByContext.Rd b/man/filterSubnetworkByContext.Rd index e882ff1..7c70ca7 100644 --- a/man/filterSubnetworkByContext.Rd +++ b/man/filterSubnetworkByContext.Rd @@ -10,7 +10,8 @@ filterSubnetworkByContext( query = NULL, cutoff = NULL, method = c("tag_count", "cosine"), - exclude_keywords = NULL + exclude_keywords = NULL, + backend = NULL ) } \arguments{ @@ -43,6 +44,12 @@ removed, regardless of their score. For example, \code{"colon"} matches "colon" and "colon-specific" but not "colonize" or "colons"; list variants such as plurals explicitly. To exclude by keyword only, omit \code{query}. Default \code{NULL} excludes nothing.} + +\item{backend}{the backend to get the evidence from, e.g. +\code{\link{indra_backend}()}. \code{NULL} (default) uses the default +backend named in each edge's \code{backend_database}. Pass a backend +built with non-default settings, such as a different URL, here. +See \code{\link{get_evidence}()}.} } \value{ A named list with four elements: @@ -57,7 +64,7 @@ A named list with four elements: The \code{evidence} and \code{abstracts} elements can be passed to the same-named arguments of \code{\link{decomposeSubnetworkByTopic}} or \code{\link{decomposeSubnetworkIntoHierarchicalTopics}}, together with the - returned list as \code{subnetwork}, so INDRA and PubMed are not queried + returned list as \code{subnetwork}, so the backend and PubMed are not queried again. } \description{ diff --git a/man/get_evidence.Rd b/man/get_evidence.Rd new file mode 100644 index 0000000..030fe27 --- /dev/null +++ b/man/get_evidence.Rd @@ -0,0 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/backend-indra.R +\name{get_evidence} +\alias{get_evidence} +\alias{get_evidence,NetworkBackend-method} +\alias{get_evidence,IndraBackend-method} +\title{Get the evidence behind network edges} +\usage{ +get_evidence(backend, edges, ...) + +\S4method{get_evidence}{NetworkBackend}(backend, edges, ...) + +\S4method{get_evidence}{IndraBackend}(backend, edges, ...) +} +\arguments{ +\item{backend}{a \code{NetworkBackend}, e.g. from +\code{\link{indra_backend}()}} + +\item{edges}{the \code{edges} of a network from +\code{\link{get_network}()}. Needs the columns \code{source}, +\code{target}, \code{interaction}, \code{site}, \code{evidence_url}, and +\code{statement_id}.} + +\item{...}{passed to methods} +} +\value{ +data.frame with one row per (edge, evidence sentence) pair and +the columns \code{source}, \code{target}, \code{interaction}, +\code{site}, \code{evidence_url}, \code{statement_id}, \code{text}, and +\code{pmid}. It has no rows, with a warning, when no edge has evidence +text. +} +\description{ +Looks up the evidence sentences and their PubMed IDs for each edge, +using the edge's \code{statement_id}. Edges that share a +\code{statement_id} get the same evidence. +} +\details{ +For INDRA, the evidence comes from CoGEx. Evidence without text is left +out, and \code{pmid} is \code{""} for evidence from a source with no +PubMed ID. + +\code{\link{filterSubnetworkByContext}()} and the topic functions call +\code{get_evidence()} with the backend named in each edge's +\code{backend_database}, unless their \code{backend} argument is given. +} +\examples{ +\donttest{ +input <- data.table::fread(system.file( + "extdata/groupComparisonModel.csv", + package = "MSstatsBioNet" +)) +indra <- indra_backend() +entities <- prepare_entities(input, entity_type = "protein", + id_type = "uniprot") +entities <- convert_ids(indra, entities) +entities <- select_entities(entities, pvalue_cutoff = 0.05) +network <- get_network(indra, entities, interaction_types = "Complex") +evidence <- get_evidence(indra, head(network$edges, 2)) +head(evidence[, c("source", "target", "pmid", "text")]) +} +} +\seealso{ +\code{\link{filterSubnetworkByContext}()} +} diff --git a/tests/testthat/test-decomposeSubnetworkIntoHierarchicalTopics.R b/tests/testthat/test-decomposeSubnetworkIntoHierarchicalTopics.R index 0df53d5..47dbb3f 100644 --- a/tests/testthat/test-decomposeSubnetworkIntoHierarchicalTopics.R +++ b/tests/testthat/test-decomposeSubnetworkIntoHierarchicalTopics.R @@ -45,7 +45,7 @@ make_theme_corpus <- function(edges_per_theme = 15, papers_per_theme = 8) { forbid_network <- function(env = parent.frame()) { testthat::local_mocked_bindings( - .extract_evidence_text = function(...) stop("INDRA was queried"), + .fetch_evidence = function(...) stop("INDRA was queried"), .fetch_clean_abstracts_xml = function(...) stop("PubMed was queried"), .env = env ) @@ -171,7 +171,7 @@ describe("decomposeSubnetworkIntoHierarchicalTopics", { corpus <- make_theme_corpus() calls <- c(indra = 0, pubmed = 0) testthat::local_mocked_bindings( - .extract_evidence_text = function(df) { + .fetch_evidence = function(edges, backend = NULL) { calls[["indra"]] <<- calls[["indra"]] + 1 corpus$evidence }, diff --git a/tests/testthat/test-evidence.R b/tests/testthat/test-evidence.R new file mode 100644 index 0000000..ef3651e --- /dev/null +++ b/tests/testthat/test-evidence.R @@ -0,0 +1,259 @@ +# ----- get_evidence() and the backend_database registry (Phase 4b) ----- + +.make_evidence_edges <- function() { + data.frame( + source = c("A", "B", "A"), + target = c("B", "C", "B"), + interaction = c("Activation", "Inhibition", "Activation"), + site = c(NA, "S473", "T308"), + evidence_url = c("https://example.com/1", "https://example.com/2", + "https://example.com/1"), + statement_id = c("111", "222", "111"), + backend_database = "INDRA", + stringsAsFactors = FALSE + ) +} + +.make_indra_evidence <- function() { + list( + "111" = list(list(text = "A activates B.", pmid = "1001"), + list(text = "", pmid = "1002"), + list(text = "A binds B.")), + "222" = list(list(text = "B inhibits C.", pmid = "2001")) + ) +} + +# A second backend for the registry tests: its evidence names the backend. +setClass("TestEvidenceBackend", contains = "NetworkBackend", + representation(label = "character")) +setMethod("get_evidence", "TestEvidenceBackend", function(backend, edges, ...) { + data.frame(source = edges$source, target = edges$target, + interaction = edges$interaction, site = edges$site, + evidence_url = edges$evidence_url, + statement_id = edges$statement_id, + text = backend@label, pmid = "1", + stringsAsFactors = FALSE) +}) + +describe("get_evidence() for INDRA", { + + test_that("copies each evidence sentence onto every edge with its hash", { + local_mocked_bindings( + .query_indra_evidence = function(stmt_hashes, cogex_url, ...) { + .make_indra_evidence() + } + ) + evidence <- suppressMessages(capture.output( + result <- get_evidence(indra_backend(), .make_evidence_edges()) + )) + expect_equal(names(result), + c("source", "target", "interaction", "site", + "evidence_url", "statement_id", "text", "pmid")) + # hash 111: two sentences with text, on edge rows 1 and 3; hash 222: + # one sentence. The sentence with empty text is dropped. + expect_equal(nrow(result), 5) + expect_equal(result$text, + c("A activates B.", "A activates B.", "A binds B.", + "A binds B.", "B inhibits C.")) + expect_equal(result$site, c(NA, "T308", NA, "T308", "S473")) + expect_equal(result$pmid, c("1001", "1001", "", "", "2001")) + }) + + test_that("asks for each statement hash once, at the backend's cogex_url", { + requested <- NULL + local_mocked_bindings( + .query_indra_evidence = function(stmt_hashes, cogex_url, ...) { + requested <<- list(hashes = stmt_hashes, url = cogex_url) + .make_indra_evidence() + } + ) + backend <- indra_backend(cogex_url = "https://cogex.example.org") + capture.output(get_evidence(backend, .make_evidence_edges())) + expect_equal(requested$hashes, c("111", "222")) + expect_equal(requested$url, "https://cogex.example.org") + }) + + test_that(".query_indra_evidence() posts to the evidence endpoint under cogex_url", { + posted_url <- NULL + local_mocked_bindings( + POST = function(url, ...) { + posted_url <<- url + structure(list(), class = "response") + }, + status_code = function(x) 200, + content = function(x, ...) list() + ) + capture.output(.query_indra_evidence("111", "https://cogex.example.org")) + expect_equal(posted_url, + "https://cogex.example.org/api/get_evidences_for_stmt_hashes") + }) + + test_that("returns an empty table with a warning when there is no evidence", { + local_mocked_bindings( + .query_indra_evidence = function(stmt_hashes, cogex_url, ...) list() + ) + capture.output(expect_warning( + result <- get_evidence(indra_backend(), .make_evidence_edges()), + "No evidence text found" + )) + expect_equal(result, .build_empty_evidence_table()) + }) + + test_that("errors when edges lack a required column", { + edges <- .make_evidence_edges() + edges$evidence_url <- NULL + expect_error(get_evidence(indra_backend(), edges), + "Missing required columns: evidence_url") + }) +}) + +test_that("get_evidence() errors for a backend without a method", { + where <- environment() + setClass("NoEvidenceBackend", contains = "NetworkBackend", where = where) + on.exit(removeClass("NoEvidenceBackend", where = where), add = TRUE) + expect_error( + get_evidence(new("NoEvidenceBackend"), .make_evidence_edges()), + "NoEvidenceBackend does not support get_evidence()", fixed = TRUE + ) +}) + +describe(".fetch_evidence() backend resolution", { + + test_that("uses the INDRA backend for INDRA edges", { + used <- NULL + local_mocked_bindings( + .query_indra_evidence = function(stmt_hashes, cogex_url, ...) { + used <<- cogex_url + .make_indra_evidence() + } + ) + capture.output(result <- .fetch_evidence(.make_evidence_edges())) + expect_equal(used, "https://discovery.indra.bio") + expect_equal(nrow(result), 5) + }) + + test_that("splits a merged network by backend_database", { + edges <- .make_evidence_edges() + edges$backend_database <- c("First", "Second", "First") + local_mocked_bindings(BACKEND_CONSTRUCTORS = list( + First = function() new("TestEvidenceBackend", label = "first"), + Second = function() new("TestEvidenceBackend", label = "second") + )) + result <- .fetch_evidence(edges) + expect_equal(result$statement_id, c("111", "111", "222")) + expect_equal(result$text, c("first", "first", "second")) + }) + + test_that("an explicit backend takes every edge", { + edges <- .make_evidence_edges() + edges$backend_database <- c("INDRA", "Unknown", NA) + result <- .fetch_evidence( + edges, new("TestEvidenceBackend", label = "given")) + expect_equal(result$text, rep("given", 3)) + }) + + test_that("still resolves the backend after the network is rebuilt and subset", { + network <- list(nodes = data.frame(id = c("A", "B", "C")), + edges = .make_evidence_edges()) + rebuilt <- list(nodes = network$nodes, + edges = network$edges[network$edges$source == "B", ]) + local_mocked_bindings( + .query_indra_evidence = function(stmt_hashes, cogex_url, ...) { + .make_indra_evidence() + } + ) + capture.output(result <- .fetch_evidence(rebuilt$edges)) + expect_equal(result$text, "B inhibits C.") + }) + + test_that("errors naming a backend_database with no default backend", { + edges <- .make_evidence_edges() + edges$backend_database <- c("INDRA", "BioGRID", "OmniPath") + expect_error(.fetch_evidence(edges), + 'No default backend for backend_database "BioGRID", "OmniPath"', + fixed = TRUE) + }) + + test_that("errors when backend_database is missing", { + edges <- .make_evidence_edges() + edges$backend_database <- NULL + expect_error(.fetch_evidence(edges), "no `backend_database` column") + edges$backend_database <- c("INDRA", NA, "INDRA") + expect_error(.fetch_evidence(edges), "missing for some edges") + }) + + test_that("rejects a backend that is not a NetworkBackend", { + expect_error(.fetch_evidence(.make_evidence_edges(), "INDRA"), + "`backend` must be NULL or a NetworkBackend") + }) + + test_that("returns an empty table for edges with no rows", { + edges <- .make_evidence_edges()[0, ] + expect_warning(result <- .fetch_evidence(edges), "No evidence text found") + expect_equal(result, .build_empty_evidence_table()) + }) +}) + +describe("downstream functions pass backend to get_evidence()", { + + given <- new("TestEvidenceBackend", label = "given") + + test_that("filterSubnetworkByContext() uses the given backend", { + seen <- NULL + local_mocked_bindings( + .fetch_evidence = function(edges, backend = NULL) { + seen <<- backend + .build_empty_evidence_table() + } + ) + suppressWarnings(capture.output(filterSubnetworkByContext( + data.frame(id = c("A", "B", "C")), .make_evidence_edges(), + query = "kinase", backend = given))) + expect_identical(seen, given) + }) + + test_that("the topic functions pass backend to the corpus", { + seen <- list() + local_mocked_bindings( + .fetch_evidence = function(edges, backend = NULL) { + seen[[length(seen) + 1]] <<- backend + stop("stop after the evidence call") + } + ) + subnetwork <- list(nodes = data.frame(id = c("A", "B", "C")), + edges = .make_evidence_edges()) + expect_error(decomposeSubnetworkByTopic(subnetwork, n_topics = 2, + backend = given), + "stop after") + expect_error(compareTopicModels(subnetwork, seeds = 1:2, n_topics = 2, + backend = given), + "stop after") + expect_error(bootstrapTopicModels(subnetwork, n_boot = 2, n_topics = 2, + backend = given), + "stop after") + expect_error(decomposeSubnetworkIntoHierarchicalTopics( + subnetwork, n_topics = 2, backend = given), "stop after") + expect_length(seen, 4) + for (backend in seen) expect_identical(backend, given) + }) + + test_that("the downstream functions reject an invalid backend before any query", { + local_mocked_bindings( + .fetch_evidence = function(...) stop("evidence was queried") + ) + subnetwork <- list(nodes = data.frame(id = c("A", "B", "C")), + edges = .make_evidence_edges()) + message <- "`backend` must be NULL or a NetworkBackend" + expect_error(filterSubnetworkByContext( + subnetwork$nodes, subnetwork$edges, query = "kinase", + backend = "INDRA"), message) + expect_error(decomposeSubnetworkByTopic(subnetwork, backend = "INDRA"), + message) + expect_error(compareTopicModels(subnetwork, seeds = 1:2, + backend = "INDRA"), message) + expect_error(bootstrapTopicModels(subnetwork, n_boot = 2, + backend = "INDRA"), message) + expect_error(decomposeSubnetworkIntoHierarchicalTopics( + subnetwork, backend = "INDRA"), message) + }) +}) diff --git a/tests/testthat/test-filterSubnetworkByContext.R b/tests/testthat/test-filterSubnetworkByContext.R index 1257734..8fd3acf 100644 --- a/tests/testthat/test-filterSubnetworkByContext.R +++ b/tests/testthat/test-filterSubnetworkByContext.R @@ -120,31 +120,6 @@ describe(".score_by_cosine", { }) -describe(".extract_evidence_text", { - - test_that("stops when required columns are missing from the edges dataframe", { - bad_df <- data.frame(source = "A", target = "B", stringsAsFactors = FALSE) - expect_error( - .extract_evidence_text(bad_df), - regexp = "Missing required columns" - ) - }) - - test_that("returns an empty dataframe with correct columns when the INDRA API returns nothing", { - edges <- make_edges() - - # Mock .query_indra_evidence to always return NULL - mockery::stub(.extract_evidence_text, ".query_indra_evidence", NULL) - - result <- suppressWarnings(.extract_evidence_text(edges)) - expect_s3_class(result, "data.frame") - expect_true(all(c("source", "target", "interaction", "site", - "evidence_url", "statement_id", "text", "pmid") %in% names(result))) - expect_equal(nrow(result), 0) - }) - -}) - describe(".fetch_clean_abstracts_xml", { test_that("returns an empty list when given an empty pmids vector", { @@ -245,7 +220,7 @@ describe("filterSubnetworkByContext", { nodes <- make_nodes() edges <- make_edges() - # --- mock .extract_evidence_text --- + # --- mock .fetch_evidence --- mock_evidence <- data.frame( source = c("A", "B"), target = c("B", "C"), @@ -260,7 +235,7 @@ describe("filterSubnetworkByContext", { pmid = c("11111111", "22222222"), stringsAsFactors = FALSE ) - mockery::stub(filterSubnetworkByContext, ".extract_evidence_text", mock_evidence) + mockery::stub(filterSubnetworkByContext, ".fetch_evidence", mock_evidence) # --- mock .fetch_clean_abstracts_xml --- mock_abstracts <- list( @@ -294,7 +269,7 @@ describe("filterSubnetworkByContext", { }) test_that("returns the abstracts of the PMIDs in the kept evidence", { - mockery::stub(filterSubnetworkByContext, ".extract_evidence_text", + mockery::stub(filterSubnetworkByContext, ".fetch_evidence", make_mock_evidence()) mockery::stub(filterSubnetworkByContext, ".fetch_clean_abstracts_xml", make_mock_abstracts()) @@ -310,7 +285,7 @@ describe("filterSubnetworkByContext", { }) test_that("exclude_keywords drops abstracts containing any keyword", { - mockery::stub(filterSubnetworkByContext, ".extract_evidence_text", + mockery::stub(filterSubnetworkByContext, ".fetch_evidence", make_mock_evidence()) mockery::stub(filterSubnetworkByContext, ".fetch_clean_abstracts_xml", make_mock_abstracts()) @@ -328,7 +303,7 @@ describe("filterSubnetworkByContext", { }) test_that("exclude_keywords takes precedence over a passing score", { - mockery::stub(filterSubnetworkByContext, ".extract_evidence_text", + mockery::stub(filterSubnetworkByContext, ".fetch_evidence", make_mock_evidence()) mockery::stub(filterSubnetworkByContext, ".fetch_clean_abstracts_xml", make_mock_abstracts()) @@ -344,7 +319,7 @@ describe("filterSubnetworkByContext", { }) test_that("exclude_keywords works with the cosine method", { - mockery::stub(filterSubnetworkByContext, ".extract_evidence_text", + mockery::stub(filterSubnetworkByContext, ".fetch_evidence", make_mock_evidence()) mockery::stub(filterSubnetworkByContext, ".fetch_clean_abstracts_xml", make_mock_abstracts()) @@ -358,7 +333,7 @@ describe("filterSubnetworkByContext", { }) test_that("filters by exclude_keywords alone when query is omitted", { - mockery::stub(filterSubnetworkByContext, ".extract_evidence_text", + mockery::stub(filterSubnetworkByContext, ".fetch_evidence", make_mock_evidence()) mockery::stub(filterSubnetworkByContext, ".fetch_clean_abstracts_xml", make_mock_abstracts()) @@ -373,7 +348,7 @@ describe("filterSubnetworkByContext", { }) test_that("keeps every abstract when no exclude keyword matches", { - mockery::stub(filterSubnetworkByContext, ".extract_evidence_text", + mockery::stub(filterSubnetworkByContext, ".fetch_evidence", make_mock_evidence()) mockery::stub(filterSubnetworkByContext, ".fetch_clean_abstracts_xml", make_mock_abstracts()) @@ -423,7 +398,7 @@ describe("filterSubnetworkByContext", { }) test_that("trims padded query and exclude_keywords terms", { - mockery::stub(filterSubnetworkByContext, ".extract_evidence_text", + mockery::stub(filterSubnetworkByContext, ".fetch_evidence", make_mock_evidence()) mockery::stub(filterSubnetworkByContext, ".fetch_clean_abstracts_xml", make_mock_abstracts()) @@ -438,7 +413,7 @@ describe("filterSubnetworkByContext", { }) test_that("returns empty abstracts when no evidence is found", { - mockery::stub(filterSubnetworkByContext, ".extract_evidence_text", + mockery::stub(filterSubnetworkByContext, ".fetch_evidence", make_mock_evidence()[0, ]) result <- suppressWarnings(filterSubnetworkByContext( @@ -485,7 +460,7 @@ describe("filterSubnetworkByContext", { edges <- do.call(rbind, edges) nodes <- data.frame(id = unique(c(edges$source, edges$target)), stringsAsFactors = FALSE) - mockery::stub(filterSubnetworkByContext, ".extract_evidence_text", + mockery::stub(filterSubnetworkByContext, ".fetch_evidence", do.call(rbind, evidence)) mockery::stub(filterSubnetworkByContext, ".fetch_clean_abstracts_xml", abstracts) @@ -496,7 +471,7 @@ describe("filterSubnetworkByContext", { expect_false(any(grepl("^G3_", filtered$edges$source))) testthat::local_mocked_bindings( - .extract_evidence_text = function(...) stop("INDRA was queried"), + .fetch_evidence = function(...) stop("INDRA was queried"), .fetch_clean_abstracts_xml = function(...) stop("PubMed was queried") ) hierarchy <- decomposeSubnetworkIntoHierarchicalTopics(