Reinstating Bioplanet with a graceful fail

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: fenr
 Title: Fast functional enrichment for interactive applications
-Version: 1.1.2
+Version: 1.1.3
 Authors@R: person(
     given = "Marek",
     family = "Gierlinski",
@@ -12,9 +12,10 @@ Description: Perform fast functional enrichment on feature lists (like genes
     or proteins) using the hypergeometric distribution. Tailored for speed,
     this package is ideal for interactive platforms such as Shiny. It supports
     the retrieval of functional data from sources like GO, KEGG, Reactome,
-    and WikiPathways. By downloading and preparing data first, it allows for
-    rapid successive tests on various feature selections without the need
-    for repetitive, time-consuming preparatory steps typical of other packages. 
+    Bioplanet and WikiPathways. By downloading and preparing data first, it
+    allows for rapid successive tests on various feature selections without
+    the need for repetitive, time-consuming preparatory steps typical of other
+    packages. 
 URL: https://github.com/bartongroup/fenr
 BugReports: https://github.com/bartongroup/fenr/issues
 Depends: R (>= 4.3.0)

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(enrichment_interactive)
+export(fetch_bp)
 export(fetch_go)
 export(fetch_go_species)
 export(fetch_kegg)

NEWS.md

@@ -129,3 +129,8 @@
 
  - Bug fixes, examples need on_error = "warn"
 
+## Version 1.1.3
+
+ - Reinstated Bioplanet access, this time with graceful fail when the website is down.
+ - Minor code changes.
+

R/bioplanet.R

@@ -0,0 +1,48 @@
+#' URL of Bioplanet pathway file
+#'
+#' @return A string with URL.
+#' @noRd
+get_bioplanet_pathway_file <- function() {
+  getOption("BIOPLANET_PATHWAY_FILE", "https://tripod.nih.gov/bioplanet/download/pathway.csv")
+}
+
+#' Get functional term data from BioPlanet
+#'
+#' Download term information (term ID and name) and gene-pathway mapping
+#' (NCBI gene ID, gene symbol and pathway ID) from BioPlanet.
+#'
+#' @param use_cache Logical, if TRUE, the remote file will be cached locally.
+#' @param on_error A character vector specifying the error handling method. It
+#'   can take values `"stop"` or `"warn"`. The default is `"stop"`. `"stop"`
+#'   will halt the function execution and throw an error, while `"warn"` will
+#'   issue a warning and return `NULL`.
+#' @return A list with \code{terms} and \code{mapping} tibbles.
+#' @export
+#' @examples
+#' bioplanet_data <- fetch_bp(on_error = "warn")
+fetch_bp <- function(use_cache = TRUE, on_error = c("stop", "warn")) {
+  on_error <- match.arg(on_error)
+
+  # Binding variables from non-standard evaluation locally
+  PATHWAY_ID <- PATHWAY_NAME <- GENE_ID <- GENE_SYMBOL <- NULL
+
+  pathway_file <- get_bioplanet_pathway_file()
+  if(!assert_url_path(pathway_file, on_error))
+    return(NULL)
+
+  lpath <- cached_url_path("bioplanet_pathway", pathway_file, use_cache)
+  paths <- readr::read_csv(lpath, show_col_types = FALSE)
+
+  terms <- paths |>
+    dplyr::select(term_id = PATHWAY_ID, term_name = PATHWAY_NAME) |>
+    dplyr::distinct()
+
+  mapping <- paths |>
+    dplyr::select(term_id = PATHWAY_ID, ncbi_id = GENE_ID, gene_symbol = GENE_SYMBOL) |>
+    dplyr::distinct()
+
+  list(
+    terms = terms,
+    mapping = mapping
+  )
+}

R/kegg.R

@@ -20,6 +20,8 @@ get_kegg_url <- function() {
 #' @examples
 #' spe <- fetch_kegg_species(on_error = "warn")
 fetch_kegg_species <- function(on_error = c("stop", "warn")) {
+  on_error <- match.arg(on_error)
+
   qry <- api_query(get_kegg_url(), "list/organism")
   if(qry$is_error)
     return(catch_error("KEGG", qry$response, on_error))
@@ -176,6 +178,8 @@ fetch_kegg_mapping <- function(pathways, batch_size, on_error = "stop") {
 #' @examples
 #' kegg_data <- fetch_kegg("mge", on_error = "warn")
 fetch_kegg <- function(species, batch_size = 10, on_error = c("stop", "warn")) {
+  on_error <- match.arg(on_error)
+
   assert_that(!missing(species), msg = "Argument 'species' is missing.")
   assert_that(is.count(batch_size))
   assert_that(batch_size <= 10, msg = "batch_size needs to be between 1 and 10")

R/reactome.R

@@ -33,6 +33,8 @@ get_reactome_gaf_file <- function() {
 #' @examples
 #' re <- fetch_reactome_species(on_error = "warn")
 fetch_reactome_species <- function(on_error = c("stop", "warn")) {
+  on_error <- match.arg(on_error)
+
   # Binding variables from non-standard evaluation locally
   dbId <- displayName <- taxId <- NULL
 

tests/testthat/test_bp.R

@@ -0,0 +1,31 @@
+expected_mapping <- tibble::tribble(
+  ~term_id, ~gene_symbol,
+  "bioplanet_1025", "CDK1",
+  "bioplanet_120", "IL1A",
+  "bioplanet_1755", "RPL6",
+  "bioplanet_1121", "POLR1A"
+)
+
+test_that("Bioplanet mapping makes sense", {
+  bp <- fetch_bp(on_error = "warn")
+  if(!is.null(bp)) {
+    expect_is(bp, "list")
+    expect_setequal(names(bp), c("terms", "mapping"))
+    mapping <- bp$mapping
+
+    merged <- expected_mapping |>
+      dplyr::left_join(mapping, by = c("term_id", "gene_symbol")) |>
+      tidyr::drop_na()
+
+    expect_equal(nrow(expected_mapping), nrow(merged))
+  }
+})
+
+
+test_that("Expected behaviour from a non-responsive server", {
+  httr2::with_mocked_responses(
+    mock = mocked_500,
+    code = {
+      test_unresponsive_server(fetch_bp, use_cache = FALSE)
+    })
+})