diff --git a/NAMESPACE b/NAMESPACE
index ab462d3..aa2226a 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -45,4 +45,5 @@ importFrom(tidyr,pivot_wider)
importFrom(utils,browseURL)
importFrom(xml2,read_xml)
importFrom(xml2,xml_find_all)
+importFrom(xml2,xml_find_first)
importFrom(xml2,xml_text)
diff --git a/R/filterSubnetworkByContext.R b/R/filterSubnetworkByContext.R
index e0618e3..9b4cd6c 100644
--- a/R/filterSubnetworkByContext.R
+++ b/R/filterSubnetworkByContext.R
@@ -252,15 +252,13 @@ filterSubnetworkByContext <- function(nodes,
n_hashes <- length(unique_hashes)
cat(sprintf("Processing %d unique statement hashes...\n", n_hashes))
-
- for (i in seq_along(unique_hashes)) {
- stmt_hash <- unique_hashes[i]
-
- if (i %% 10 == 0) cat(sprintf("Progress: %d/%d\n", i, n_hashes))
-
- evidence_list <- .query_indra_evidence(stmt_hash)
+
+ evidence_by_hash <- .query_indra_evidence(unique_hashes)
+
+ for (stmt_hash in unique_hashes) {
+ evidence_list <- evidence_by_hash[[as.character(stmt_hash)]]
if (is.null(evidence_list) || length(evidence_list) == 0) next
-
+
matching_indices <- which(df$stmt_hash == stmt_hash)
for (evidence in evidence_list) {
@@ -298,83 +296,158 @@ filterSubnetworkByContext <- function(nodes,
}
-#' Fetch and clean PubMed abstracts via rentrez
-#' @param pmids Character vector of PubMed IDs
+#' Fetch and clean PubMed abstracts via rentrez.
+#'
+#' PMIDs that are missing from the response (unknown IDs, or a batch whose
+#' request failed) are returned with an empty abstract.
+#'
+#' @param pmids Character vector of PubMed IDs
+#' @param batch_size Number of PMIDs to request per efetch call
#' @return Named list: pmid -> abstract text
#' @keywords internal
#' @noRd
#' @importFrom rentrez entrez_fetch
-#' @importFrom xml2 read_xml xml_find_all xml_text
-.fetch_clean_abstracts_xml <- function(pmids) {
- results <- list()
- total <- length(pmids)
-
- cat(sprintf("Fetching %d abstracts...\n", total))
-
- for (i in seq_along(pmids)) {
- pmid <- pmids[i]
-
+.fetch_clean_abstracts_xml <- function(pmids, batch_size = 200) {
+ pmids <- as.character(pmids)
+ total <- length(pmids)
+
+ if (total == 0) return(list())
+
+ results <- as.list(rep("", total))
+ names(results) <- pmids
+
+ batches <- split(pmids, ceiling(seq_along(pmids) / batch_size))
+ n_batches <- length(batches)
+
+ cat(sprintf("Fetching %d abstracts in %d batch(es) of up to %d...\n",
+ total, n_batches, batch_size))
+
+ for (i in seq_along(batches)) {
+ batch <- batches[[i]]
+
record <- tryCatch(
- entrez_fetch(db = "pubmed", id = pmid, rettype = "xml"),
+ entrez_fetch(db = "pubmed", id = batch, rettype = "xml"),
error = function(e) {
- cat(sprintf("Error fetching PMID %s at %d/%d: %s\n", pmid, i, total, e$message))
+ cat(sprintf("Error fetching batch %d/%d (%d PMIDs): %s\n",
+ i, n_batches, length(batch), conditionMessage(e)))
NULL
}
)
-
- if (is.null(record)) {
- results[[pmid]] <- ""
- next
- }
-
- doc <- read_xml(record)
- abstract_nodes <- xml_find_all(doc, ".//AbstractText")
-
- if (length(abstract_nodes) > 0) {
- results[[pmid]] <- paste(trimws(xml_text(abstract_nodes)), collapse = " ")
- } else {
- results[[pmid]] <- ""
- }
-
- if (i %% 10 == 0 || i == total) {
- cat(sprintf("Progress: %d/%d (%.1f%%)\n", i, total, (i / total) * 100))
+
+ if (!is.null(record)) {
+ fetched <- .parse_pubmed_abstracts(record)
+ matched <- intersect(names(fetched), batch)
+ results[matched] <- fetched[matched]
}
-
- Sys.sleep(0.34)
+
+ cat(sprintf("Progress: %d/%d batches (%.1f%%)\n",
+ i, n_batches, (i / n_batches) * 100))
+
+ # NCBI allows 3 requests/second without an API key
+ if (i < n_batches) Sys.sleep(0.34)
}
-
+
cat("Done fetching abstracts!\n")
return(results)
}
+#' Parse abstracts out of a PubMed efetch XML response
+#' @param record Character string of XML returned by efetch
+#' @return Named list: pmid -> abstract text (empty string when no abstract)
+#' @keywords internal
+#' @noRd
+#' @importFrom xml2 read_xml xml_find_all xml_find_first xml_text
+.parse_pubmed_abstracts <- function(record) {
+ doc <- read_xml(record)
+ articles <- xml_find_all(doc, ".//PubmedArticle | .//PubmedBookArticle")
+
+ if (length(articles) == 0) return(list())
+
+ pmids <- vapply(
+ articles,
+ function(article) {
+ xml_text(xml_find_first(
+ article, "./MedlineCitation/PMID | ./BookDocument/PMID"
+ ))
+ },
+ character(1)
+ )
+
+ abstracts <- lapply(articles, function(article) {
+ nodes <- xml_find_all(article, ".//Abstract/AbstractText")
+ if (length(nodes) == 0) return("")
+ paste(trimws(xml_text(nodes)), collapse = " ")
+ })
+ names(abstracts) <- pmids
+
+ abstracts[!is.na(pmids) & nzchar(pmids)]
+}
+
+
#' Query INDRA API for evidence text
-#' @param stmt_hash A statement hash string
-#' @return A list of evidence objects from the API, or NULL if error
+#'
+#' 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: stmt_hash -> 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_hash) {
- url <- "https://discovery.indra.bio/api/get_evidences_for_stmt_hash"
-
- tryCatch({
- response <- POST(
- url,
- body = list(stmt_hash = stmt_hash),
- encode = "json",
- content_type_json()
- )
-
- if (status_code(response) != 200) {
- warning(sprintf("API returned status %d for stmt_hash: %s",
- status_code(response), stmt_hash))
+.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]
}
-
- content(response, as = "parsed")
- }, error = function(e) {
- warning(sprintf("Error querying stmt_hash %s: %s", stmt_hash, e$message))
- return(NULL)
- })
+
+ if (i < n_batches) Sys.sleep(sleep)
+ }
+
+ cat("Done fetching evidence!\n")
+ results
}
\ No newline at end of file
diff --git a/tests/testthat/test-filterSubnetworkByContext.R b/tests/testthat/test-filterSubnetworkByContext.R
index 4f77b03..baa1d5f 100644
--- a/tests/testthat/test-filterSubnetworkByContext.R
+++ b/tests/testthat/test-filterSubnetworkByContext.R
@@ -18,6 +18,18 @@ make_nodes <- function() {
)
}
+make_pubmed_xml <- function(pmids) {
+ articles <- vapply(pmids, function(pmid) {
+ sprintf(paste0(
+ "%s",
+ "Abstract for %s.",
+ ""
+ ), pmid, pmid)
+ }, character(1))
+
+ paste0("", paste(articles, collapse = ""), "")
+}
+
describe(".score_by_tag_count", {
test_that("returns 0 for an abstract that contains none of the tags", {
@@ -94,7 +106,80 @@ describe(".fetch_clean_abstracts_xml", {
expect_true("99999999" %in% names(result))
expect_equal(result[["99999999"]], "")
})
-
+
+ test_that("requests PMIDs in batches and keeps every PMID in the result", {
+ requested <- list()
+ mockery::stub(
+ .fetch_clean_abstracts_xml,
+ "entrez_fetch",
+ function(db, id, rettype) {
+ requested[[length(requested) + 1]] <<- id
+ make_pubmed_xml(id)
+ }
+ )
+ pmids <- c("11111111", "11111112", "11111113", "11111114", "11111115")
+ result <- suppressMessages(
+ .fetch_clean_abstracts_xml(pmids, batch_size = 2)
+ )
+
+ expect_equal(
+ requested,
+ list(c("11111111", "11111112"), c("11111113", "11111114"), "11111115")
+ )
+ expect_equal(names(result), pmids)
+ expect_equal(result[["11111113"]], "Abstract for 11111113.")
+ })
+
+ test_that("returns an empty string for a PMID missing from the response", {
+ mockery::stub(
+ .fetch_clean_abstracts_xml,
+ "entrez_fetch",
+ function(db, id, rettype) make_pubmed_xml(setdiff(id, "22222222"))
+ )
+ result <- suppressMessages(
+ .fetch_clean_abstracts_xml(c("11111111", "22222222"))
+ )
+ expect_equal(result[["11111111"]], "Abstract for 11111111.")
+ expect_equal(result[["22222222"]], "")
+ })
+
+})
+
+describe(".parse_pubmed_abstracts", {
+
+ test_that("joins multi-section abstracts and ignores cited reference PMIDs", {
+ record <- paste0(
+ "",
+ "11111111",
+ "",
+ " First part. ",
+ "Second part.",
+ "",
+ "",
+ "99999999",
+ "",
+ ""
+ )
+ result <- .parse_pubmed_abstracts(record)
+ expect_equal(names(result), "11111111")
+ expect_equal(result[["11111111"]], "First part. Second part.")
+ })
+
+ test_that("returns an empty string for an article with no abstract", {
+ record <- paste0(
+ "",
+ "11111111T",
+ ""
+ )
+ expect_equal(.parse_pubmed_abstracts(record)[["11111111"]], "")
+ })
+
+ test_that("returns an empty list when the response has no articles", {
+ result <- .parse_pubmed_abstracts("")
+ expect_true(is.list(result))
+ expect_length(result, 0)
+ })
+
})
describe("filterSubnetworkByContext", {