tests/testthat/test-data_generation.R

In pathfindR: Enrichment Analysis Utilizing Active Subnetworks

library(httr)
library(ggkegg)

test_that("safe_get_content returns parsed content on success", {
  fake_res <- structure(list(), class = "response")

  fake_GET <- function(url, ...) fake_res
  fake_http_error <- function(res) FALSE
  fake_content <- function(res, ...) "<html>hello world</html>"

  with_mocked_bindings(
    {
      result <- safe_get_content("http://example.com")
      expect_equal(result, "<html>hello world</html>")
    },
    GET = fake_GET,
    http_error = fake_http_error,
    content = fake_content
  )
})

test_that("safe_get_content handles GET error via mocking", {
  fake_GET <- function(...) stop("Simulated connection failure")

  with_mocked_bindings(
    {
      expect_error(
        safe_get_content("http://example.com"),
        regexp = "Failed to retrieve resource"
      )
    },
    GET = fake_GET
  )
})

test_that("safe_get_content handles HTTP error via mocking", {
  fake_GET <- function(...) {
    structure(
      list(status_code = 500L),
      class = "response"
    )
  }

  with_mocked_bindings(
    {
      expect_error(
        safe_get_content("http://example.com"),
        regexp = "unavailable"
      )
    },
    GET = fake_GET
  )
})

test_that("safe_get_content handles content parsing failure via mocking", {
  fake_GET <- function(...) {
    structure(
      list(status_code = 200L),
      class = "response"
    )
  }

  fake_content <- function(...) stop("Simulated parsing failure")

  with_mocked_bindings(
    {
      expect_error(
        safe_get_content("http://example.com"),
        regexp = "Failed to parse content"
      )
    },
    GET = fake_GET,
    content = fake_content
  )
})


set.seed(123)
gene_pool <- paste0("Gene", 1:100)
toy_biogrid_pin <- data.frame(A = sample(gene_pool, 25), B = sample(gene_pool, 25))
colnames(toy_biogrid_pin) <- c("Official Symbol Interactor A", "Official Symbol Interactor B")

test_that("`process_pin()` -- removes self-interactions and duplicated interactions", {
  input_pin_df <- toy_biogrid_pin
  colnames(input_pin_df) <- c("Interactor_A", "Interactor_B")
  input_pin_df <- rbind(input_pin_df, data.frame(
    Interactor_A = input_pin_df$Interactor_B[1:5],
    Interactor_B = input_pin_df$Interactor_A[1:5]
  ))

  processed_df <- process_pin(input_pin_df)

  expect_true(nrow(processed_df) < nrow(input_pin_df))
})

test_that("`get_biogrid_pin()` -- returns a path to a valid PIN file", {
  mockery::stub(get_biogrid_pin, "utils::download.file", NULL)
  mockery::stub(get_biogrid_pin, "utils::unzip", list(Name = "BIOGRID-ORGANISM-Homo_sapiens-4.4.211.tab3.txt"))
  mockery::stub(get_biogrid_pin, "utils::read.delim", toy_biogrid_pin)

  expected_biogrid_pin_df <- toy_biogrid_pin
  colnames(expected_biogrid_pin_df) <- c("Interactor_A", "Interactor_B")
  expected_biogrid_pin_df <- process_pin(expected_biogrid_pin_df)
  expected_biogrid_pin_df <- data.frame(
    V1 = expected_biogrid_pin_df$Interactor_A,
    V2 = "pp", V3 = expected_biogrid_pin_df$Interactor_B
  )

  pin_path <- get_biogrid_pin(release = "4.4.211")
  pin_df <- read.delim(pin_path, header = FALSE)
  expect_true(ncol(pin_df) == 3)
  expect_true(all(pin_df[, 2] == "pp"))
  expect_identical(pin_df, expected_biogrid_pin_df)
})

test_that("`get_biogrid_pin()` -- determines and downloads the latest version", {
  mockery::stub(get_biogrid_pin, "safe_get_content", "<h2>BioGRID Release 3.5.183")
  mockery::stub(get_biogrid_pin, "utils::download.file", NULL)
  mockery::stub(get_biogrid_pin, "utils::unzip", list(Name = "BIOGRID-ORGANISM-Homo_sapiens-X.X.X.tab3.txt"))
  mockery::stub(get_biogrid_pin, "utils::read.delim", toy_biogrid_pin)

  expected_biogrid_pin_df <- toy_biogrid_pin
  colnames(expected_biogrid_pin_df) <- c("Interactor_A", "Interactor_B")
  expected_biogrid_pin_df <- process_pin(expected_biogrid_pin_df)
  expected_biogrid_pin_df <- data.frame(
    V1 = expected_biogrid_pin_df$Interactor_A,
    V2 = "pp", V3 = expected_biogrid_pin_df$Interactor_B
  )

  pin_path <- get_biogrid_pin()
  pin_df <- read.delim(pin_path, header = FALSE)
  expect_true(ncol(pin_df) == 3)
  expect_true(all(pin_df[, 2] == "pp"))
  expect_identical(pin_df, expected_biogrid_pin_df)
})

test_that("`get_biogrid_pin()` -- error check works", {
  # invalid organism error
  expect_error(get_biogrid_pin(org = "Hsapiens"), paste(
    "Hsapiens is not a valid Biogrid organism.",
    "Available organisms are listed on: https://wiki.thebiogrid.org/doku.php/statistics"
  ))
})

test_that("`get_pin_file()` -- works as expected", {
  with_mocked_bindings(
    {
      pin_path <- get_pin_file()
      expect_identical(pin_path, "/path/to/some/PIN/file")
    },
    get_biogrid_pin = function(...) "/path/to/some/PIN/file",
    .package = "pathfindR"
  )

  expect_error(get_pin_file(source = "STRING"), "As of this version, this function is implemented to get data from BioGRID only")
})

test_that("`gset_list_from_gmt()` -- works as expected", {
  gmt_list <- list(GSA = sample(gene_pool, 80), GSB = sample(gene_pool, 100), GSC = sample(
    gene_pool,
    33
  ))
  description_vec <- c(GSA = "gene set A", GSB = "gene set B", GSC = "gene set C")

  gmt_df <- c()
  for (gset in names(gmt_list)) {
    tmp <- c(gset, description_vec[gset])
    tmp <- c(tmp, gmt_list[[gset]], rep("", 100 - length(gmt_list[[gset]])))
    gmt_df <- rbind(gmt_df, tmp)
  }

  path2gmt <- tempfile()
  write.table(gmt_df, path2gmt,
    sep = "\t", col.names = FALSE, row.names = FALSE,
    quote = FALSE
  )

  expect_is(res <- gset_list_from_gmt(path2gmt), "list")
  expect_identical(res$gene_sets, gmt_list)
  expect_identical(res$descriptions, description_vec)
})


test_that("`get_kegg_gsets()` -- works as expected", {
  mock_response <- "pathway1\tdescription\npathway2\tdescription2"

  mock_pw_graph1 <- igraph::graph_from_data_frame(
    data.frame(from = c("A", "B"), to = c("B", "C")),
    vertices = data.frame(
      name = c("A", "B", "C"),
      type = c("gene", "not_gene", "gene")
    )
  )

  mock_pw_graph2 <- igraph::graph_from_data_frame(
    data.frame(from = c("D", "F"), to = c("E", "G")),
    vertices = data.frame(
      name = c("D", "E", "F", "G"),
      type = c("gene", "gene", "not_gene", "gene")
    )
  )

  mock_pathway <- function(pid, ...) {
    if (pid == "pathway1") {
      return(mock_pw_graph1)
    } else if (pid == "pathway2") {
      return(mock_pw_graph2)
    } else {
      stop("Unknown pid")
    }
  }

  with_mocked_bindings(
    {
      expect_is(toy_eco_kegg <- pathfindR:::get_kegg_gsets(), "list")
    },
    safe_get_content = function(...) mock_response,
    pathway = mock_pathway
  )

  expect_length(toy_eco_kegg, 2)
  expect_true(all(names(toy_eco_kegg) == c("gene_sets", "descriptions")))
  expect_true(all(names(toy_eco_kegg[["gene_sets"]]) %in% names(toy_eco_kegg[["descriptions"]])))
  expect_length(toy_eco_kegg[["gene_sets"]], 2)
  expect_length(toy_eco_kegg[["descriptions"]], 2)

  expect_true(toy_eco_kegg[["descriptions"]]["pathway1"] == "description")
  expect_true(toy_eco_kegg[["descriptions"]]["pathway2"] == "description2")

  expect_identical(toy_eco_kegg[["gene_sets"]][["pathway1"]], c("A", "C"))
  expect_identical(toy_eco_kegg[["gene_sets"]][["pathway2"]], c("D", "E", "G"))
})

test_that("`get_reactome_gsets()` -- works as expected", {
  pw1 <- "Pathway1"
  pw2 <- "Pathway2"
  desc1 <- "Description1"
  desc2 <- "Description2"
  genes1 <- c("GeneA", "GeneB")
  genes2 <- c("GeneC", "GeneD", "GeneE")

  gmt_content <- paste(
    c(
      paste(c(desc1, pw1, genes1), collapse = "\t"),
      paste(c(desc2, pw2, genes2), collapse = "\t")
    ),
    collapse = "\n"
  )

  mockery::stub(get_reactome_gsets, "utils::download.file", NULL)

  unz_mock <- function(zipfile, filename, ...) {
    textConnection(gmt_content)
  }
  mockery::stub(get_reactome_gsets, "unz", unz_mock)

  expected_gsets <- list(genes1, genes2)
  names(expected_gsets) <- c(pw1, pw2)
  expect_descriptions <- c(desc1, desc2)
  names(expect_descriptions) <- c(pw1, pw2)

  expect_is(reactome <- get_reactome_gsets(), "list")
  expect_length(reactome, 2)
  expect_length(reactome$gene_sets, 2)
  expect_length(reactome$descriptions, 2)
  expect_equal(names(reactome$gene_sets), names(reactome$descriptions))
  expect_equal(reactome$gene_sets, expected_gsets)
  expect_equal(reactome$descriptions, expect_descriptions)
})

test_that("`get_mgsigdb_gsets()` -- works as expected", {
  toy_msigdb_df <- c()
  for (gs_idx in 1:5) {
    toy_msigdb_df <- rbind(toy_msigdb_df, data.frame(gene_symbol = sample(
      gene_pool,
      sample(25:75, 1)
    ), gs_id = paste0("GS", gs_idx), gs_name = paste(
      "Gene Set",
      gs_idx
    )))
  }
  mockery::stub(get_mgsigdb_gsets, "msigdbr::msigdbr", toy_msigdb_df)

  expect_is(res_msig_db <- get_mgsigdb_gsets(collection = "C1"), "list")
  expect_length(res_msig_db, 2)
  expect_true(all(names(res_msig_db) == c("gene_sets", "descriptions")))
  expect_true(all(names(res_msig_db[["gene_sets"]] %in% names(res_msig_db[["descriptions"]]))))
})

test_that("`get_gene_sets_list()` works", {
  expect_error(gsets <- get_gene_sets_list("Wiki"), "As of this version, this function is implemented to get data from KEGG, Reactome and MSigDB only")

  mockery::stub(get_gene_sets_list, "get_kegg_gsets", NULL)
  mockery::stub(get_gene_sets_list, "get_reactome_gsets", NULL)
  mockery::stub(get_gene_sets_list, "get_mgsigdb_gsets", NULL)
  expect_silent(kegg <- get_gene_sets_list(org_code = "vcn"))
  expect_message(rctm <- get_gene_sets_list("Reactome"))
  expect_silent(msig <- get_gene_sets_list("MSigDB",
    species = "Mus musculus", db_species = "MS",
    collection = "C3", subcollection = "MIR:MIR_Legacy"
  ))
})