tests/testthat/test-likely_symbol.R

In convertid: Convert Gene IDs Between Each Other and Fetch Annotations from Biomart

# Tests for likely_symbol()
#
# Key behaviours tested:
#   - Character vector and data frame input
#   - output = "likely", "symbols", "all" return correct columns
#   - Symbol resolution: current, alias, previous, unrecognised
#   - alias_sym and prev_sym flags
#   - index_threshold: correct path selection, identical results from both paths
#   - Session cache: reused on second call, bypassed when hgnc supplied
#   - refresh = TRUE forces re-download and updates cache timestamp
#   - Stale cache (> 3 days) emits a warning message
#   - Unsupported organism returns input unchanged
#   - verbose = TRUE / FALSE
#
# All unit tests supply a minimal hgnc fixture or manipulate the package cache
# directly to avoid any network calls.

# ---------------------------------------------------------------------------
# Minimal HGNC fixture
#   ACTB  - current symbol, no aliases, no previous
#   KYAT1 - alias CCBL1, previous symbol KAAT1
#   BRCA1 - alias RNF53
# ---------------------------------------------------------------------------
hgnc_fixture <- data.frame(
  symbol        = c("ACTB",  "KYAT1", "BRCA1"),
  alias_symbol  = c("",      "CCBL1", "RNF53"),
  prev_symbol   = c("",      "KAAT1", ""),
  stringsAsFactors = FALSE
)

# Helper: clear the package cache before tests that depend on cache state
clear_cache <- function() {
  if (exists("hgnc", envir = .likely_symbol_cache, inherits = FALSE))
    rm("hgnc", "downloaded_at", envir = .likely_symbol_cache)
}

# ---------------------------------------------------------------------------
# Input types
# ---------------------------------------------------------------------------
testthat::test_that("likely_symbol accepts a character vector", {
  result <- likely_symbol("ACTB", hgnc = hgnc_fixture, verbose = FALSE)
  testthat::expect_s3_class(result, "data.frame")
  testthat::expect_true("input_symbol"  %in% names(result))
  testthat::expect_true("likely_symbol" %in% names(result))
})

testthat::test_that("likely_symbol accepts a data frame with Material, org, sp columns", {
  dat <- data.frame(Material = 1L, org = "human", sp = "ACTB",
                    stringsAsFactors = FALSE)
  result <- likely_symbol(dat, hgnc = hgnc_fixture, verbose = FALSE)
  testthat::expect_s3_class(result, "data.frame")
})

testthat::test_that("likely_symbol errors on data frame missing required columns", {
  dat <- data.frame(wrong = "ACTB", stringsAsFactors = FALSE)
  testthat::expect_error(
    likely_symbol(dat, hgnc = hgnc_fixture, verbose = FALSE),
    "Need the following columns"
  )
})

# ---------------------------------------------------------------------------
# output options
# ---------------------------------------------------------------------------
testthat::test_that("output = 'likely' returns likely_symbol and input_symbol only", {
  result <- likely_symbol("ACTB", hgnc = hgnc_fixture,
                          output = "likely", verbose = FALSE)
  testthat::expect_equal(sort(names(result)), sort(c("likely_symbol", "input_symbol")))
})

testthat::test_that("output = 'symbols' returns correct columns", {
  result <- likely_symbol("ACTB", hgnc = hgnc_fixture,
                          output = "symbols", verbose = FALSE)
  testthat::expect_equal(sort(names(result)),
    sort(c("current_symbols", "likely_symbol", "input_symbol", "all_symbols")))
})

testthat::test_that("output = 'all' returns correct columns", {
  result <- likely_symbol("ACTB", hgnc = hgnc_fixture,
                          output = "all", verbose = FALSE)
  testthat::expect_equal(sort(names(result)),
    sort(c("current_symbols", "likely_symbol", "previous_symbol",
           "input_symbol", "all_symbols")))
})

# ---------------------------------------------------------------------------
# Symbol resolution logic
# ---------------------------------------------------------------------------
testthat::test_that("current symbol resolves to itself", {
  result <- likely_symbol("ACTB", hgnc = hgnc_fixture,
                          output = "likely", verbose = FALSE)
  testthat::expect_equal(result$input_symbol,  "ACTB")
  testthat::expect_equal(result$likely_symbol, "ACTB")
})

testthat::test_that("alias resolves to current symbol", {
  result <- likely_symbol("CCBL1", hgnc = hgnc_fixture,
                          output = "likely", verbose = FALSE)
  testthat::expect_equal(result$input_symbol,  "CCBL1")
  testthat::expect_equal(result$likely_symbol, "KYAT1")
})

testthat::test_that("previous symbol resolves to current symbol", {
  result <- likely_symbol("KAAT1", hgnc = hgnc_fixture,
                          output = "likely", verbose = FALSE)
  testthat::expect_equal(result$input_symbol,  "KAAT1")
  testthat::expect_equal(result$likely_symbol, "KYAT1")
})

testthat::test_that("unrecognised symbol returns input unchanged", {
  result <- likely_symbol("NOTAREAL1", hgnc = hgnc_fixture,
                          output = "likely", verbose = FALSE)
  testthat::expect_equal(result$input_symbol,  "NOTAREAL1")
  testthat::expect_equal(result$likely_symbol, "NOTAREAL1")
})

testthat::test_that("multiple symbols are all resolved correctly", {
  result <- likely_symbol(c("ACTB", "CCBL1", "KAAT1"),
                          hgnc = hgnc_fixture, output = "likely", verbose = FALSE)
  testthat::expect_equal(nrow(result), 3L)
  testthat::expect_equal(result$likely_symbol[result$input_symbol == "CCBL1"], "KYAT1")
  testthat::expect_equal(result$likely_symbol[result$input_symbol == "KAAT1"], "KYAT1")
  testthat::expect_equal(result$likely_symbol[result$input_symbol == "ACTB"],  "ACTB")
})

# ---------------------------------------------------------------------------
# alias_sym and prev_sym flags
# ---------------------------------------------------------------------------
testthat::test_that("alias_sym = FALSE prevents alias lookup", {
  result <- likely_symbol("CCBL1", hgnc = hgnc_fixture,
                          alias_sym = FALSE, prev_sym = FALSE,
                          output = "likely", verbose = FALSE)
  testthat::expect_equal(result$likely_symbol, "CCBL1")
})

testthat::test_that("prev_sym = FALSE prevents previous symbol lookup", {
  result <- likely_symbol("KAAT1", hgnc = hgnc_fixture,
                          alias_sym = FALSE, prev_sym = FALSE,
                          output = "likely", verbose = FALSE)
  testthat::expect_equal(result$likely_symbol, "KAAT1")
})

# ---------------------------------------------------------------------------
# index_threshold
# ---------------------------------------------------------------------------
testthat::test_that("row-scan used below index_threshold (no index message)", {
  testthat::expect_no_message(
    likely_symbol("ACTB", hgnc = hgnc_fixture,
                  index_threshold = 10L, verbose = TRUE),
    message = "Building alias symbol index"
  )
})

testthat::test_that("index built at or above index_threshold", {
  testthat::expect_message(
    likely_symbol("ACTB", hgnc = hgnc_fixture,
                  index_threshold = 1L, verbose = TRUE),
    regexp = "Building alias symbol index"
  )
})

testthat::test_that("both paths produce identical results for alias lookup", {
  r_scan  <- likely_symbol("CCBL1", hgnc = hgnc_fixture,
                            index_threshold = 99L, output = "likely", verbose = FALSE)
  r_index <- likely_symbol("CCBL1", hgnc = hgnc_fixture,
                            index_threshold = 1L,  output = "likely", verbose = FALSE)
  testthat::expect_equal(r_scan, r_index)
})

testthat::test_that("both paths produce identical results for previous symbol lookup", {
  r_scan  <- likely_symbol("KAAT1", hgnc = hgnc_fixture,
                            index_threshold = 99L, output = "likely", verbose = FALSE)
  r_index <- likely_symbol("KAAT1", hgnc = hgnc_fixture,
                            index_threshold = 1L,  output = "likely", verbose = FALSE)
  testthat::expect_equal(r_scan, r_index)
})

testthat::test_that("both paths produce identical results for batch input", {
  syms    <- c("ACTB", "CCBL1", "KAAT1", "NOTAREAL1")
  r_scan  <- likely_symbol(syms, hgnc = hgnc_fixture,
                            index_threshold = 99L, output = "likely", verbose = FALSE)
  r_index <- likely_symbol(syms, hgnc = hgnc_fixture,
                            index_threshold = 1L,  output = "likely", verbose = FALSE)
  r_scan  <- r_scan[order(r_scan$input_symbol), ]
  r_index <- r_index[order(r_index$input_symbol), ]
  testthat::expect_equal(r_scan, r_index)
})

# ---------------------------------------------------------------------------
# Session cache
# ---------------------------------------------------------------------------
testthat::test_that("hgnc table is cached after first call", {
  clear_cache()
  mockery::stub(likely_symbol, "read.delim", function(...) hgnc_fixture)
  likely_symbol("ACTB", verbose = FALSE)
  testthat::expect_true(
    exists("hgnc", envir = .likely_symbol_cache, inherits = FALSE))
  testthat::expect_true(
    exists("downloaded_at", envir = .likely_symbol_cache, inherits = FALSE))
})

testthat::test_that("second call reuses cache without downloading", {
  clear_cache()
  # Seed the cache
  .likely_symbol_cache$hgnc          <- hgnc_fixture
  .likely_symbol_cache$downloaded_at <- Sys.time()
  # read.delim should never be called on second use
  mockery::stub(likely_symbol, "read.delim", function(...) {
    stop("Should not download when cache is available")
  })
  testthat::expect_no_error(
    likely_symbol("ACTB", verbose = FALSE)
  )
})

testthat::test_that("cache reuse emits message when verbose = TRUE", {
  clear_cache()
  .likely_symbol_cache$hgnc          <- hgnc_fixture
  .likely_symbol_cache$downloaded_at <- Sys.time()
  testthat::expect_message(
    likely_symbol("ACTB", verbose = TRUE),
    regexp = "Reusing cached HGNC table"
  )
})

testthat::test_that("stale cache (> 3 days) emits staleness warning", {
  clear_cache()
  .likely_symbol_cache$hgnc          <- hgnc_fixture
  .likely_symbol_cache$downloaded_at <- Sys.time() - (4 * 24 * 3600)
  testthat::expect_message(
    likely_symbol("ACTB", verbose = TRUE),
    regexp = "may be outdated"
  )
})

testthat::test_that("supplying hgnc bypasses cache entirely", {
  clear_cache()
  # Seed cache with a different table that would give wrong results
  wrong_hgnc <- data.frame(symbol = "WRONG", alias_symbol = "ACTB",
                            prev_symbol = "", stringsAsFactors = FALSE)
  .likely_symbol_cache$hgnc          <- wrong_hgnc
  .likely_symbol_cache$downloaded_at <- Sys.time()
  # Supplying hgnc directly should ignore the cache
  result <- likely_symbol("ACTB", hgnc = hgnc_fixture,
                           output = "likely", verbose = FALSE)
  testthat::expect_equal(result$likely_symbol, "ACTB")
})

testthat::test_that("supplying hgnc emits 'Using supplied' message when verbose", {
  testthat::expect_message(
    likely_symbol("ACTB", hgnc = hgnc_fixture, verbose = TRUE),
    regexp = "Using supplied HGNC table"
  )
})

# ---------------------------------------------------------------------------
# refresh = TRUE
# ---------------------------------------------------------------------------
testthat::test_that("refresh = TRUE triggers re-download even when cache exists", {
  clear_cache()
  .likely_symbol_cache$hgnc          <- hgnc_fixture
  .likely_symbol_cache$downloaded_at <- Sys.time()
  download_called <- FALSE
  mockery::stub(likely_symbol, "read.delim", function(...) {
    download_called <<- TRUE
    hgnc_fixture
  })
  likely_symbol("ACTB", refresh = TRUE, verbose = FALSE)
  testthat::expect_true(download_called)
})

testthat::test_that("refresh = TRUE updates the cache timestamp", {
  clear_cache()
  old_time <- Sys.time() - (2 * 24 * 3600)
  .likely_symbol_cache$hgnc          <- hgnc_fixture
  .likely_symbol_cache$downloaded_at <- old_time
  mockery::stub(likely_symbol, "read.delim", function(...) hgnc_fixture)
  likely_symbol("ACTB", refresh = TRUE, verbose = FALSE)
  testthat::expect_gt(
    as.numeric(.likely_symbol_cache$downloaded_at),
    as.numeric(old_time)
  )
})

testthat::test_that("refresh = TRUE emits refreshing message when verbose", {
  clear_cache()
  .likely_symbol_cache$hgnc          <- hgnc_fixture
  .likely_symbol_cache$downloaded_at <- Sys.time()
  mockery::stub(likely_symbol, "read.delim", function(...) hgnc_fixture)
  testthat::expect_message(
    likely_symbol("ACTB", refresh = TRUE, verbose = TRUE),
    regexp = "Refreshing HGNC table"
  )
})

# ---------------------------------------------------------------------------
# Organism handling
# ---------------------------------------------------------------------------
testthat::test_that("unsupported organism returns input unchanged", {
  result <- likely_symbol("Actb", orgnsm = "rat",
                          output = "likely", verbose = FALSE)
  testthat::expect_equal(result$input_symbol, "Actb")
})

testthat::test_that("NULL orgnsm is treated as empty string without error", {
  testthat::expect_no_error(
    likely_symbol("ACTB", orgnsm = NULL, hgnc = hgnc_fixture, verbose = FALSE)
  )
})

# ---------------------------------------------------------------------------
# verbose
# ---------------------------------------------------------------------------
testthat::test_that("verbose = TRUE emits symbol alias message", {
  testthat::expect_message(
    likely_symbol("ACTB", hgnc = hgnc_fixture, output = "likely", verbose = TRUE),
    regexp = "Getting symbol aliases"
  )
})

testthat::test_that("verbose = FALSE suppresses all messages", {
  testthat::expect_no_message(
    likely_symbol("ACTB", hgnc = hgnc_fixture, output = "likely", verbose = FALSE)
  )
})

# ---------------------------------------------------------------------------
# Integration tests: real HGNC download (skipped on CRAN)
# ---------------------------------------------------------------------------
testthat::test_that("likely_symbol resolves known alias with live HGNC download", {
  testthat::skip_on_cran()
  testthat::skip_if_offline()
  clear_cache()
  result <- likely_symbol("CCBL1", output = "likely", verbose = FALSE)
  testthat::expect_s3_class(result, "data.frame")
  testthat::expect_equal(result$input_symbol,  "CCBL1")
  testthat::expect_equal(result$likely_symbol, "KYAT1")
})

testthat::test_that("second live call reuses cache without re-downloading", {
  testthat::skip_on_cran()
  testthat::skip_if_offline()
  # First call populates cache
  likely_symbol("CCBL1", output = "likely", verbose = FALSE)
  # Second call should reuse cache — stub read.delim to confirm no download
  mockery::stub(likely_symbol, "read.delim", function(...) {
    stop("Should not download on second call")
  })
  testthat::expect_no_error(
    likely_symbol("KAAT1", output = "likely", verbose = FALSE)
  )
})

testthat::test_that("index and row-scan paths agree with live HGNC download", {
  testthat::skip_on_cran()
  testthat::skip_if_offline()
  syms    <- c("CCBL1", "KAAT1", "ACTB", "NOTAREAL1")
  r_scan  <- likely_symbol(syms, index_threshold = 99L,
                            output = "likely", verbose = FALSE)
  r_index <- likely_symbol(syms, index_threshold = 1L,
                            output = "likely", verbose = FALSE)
  r_scan  <- r_scan[order(r_scan$input_symbol), ]
  r_index <- r_index[order(r_index$input_symbol), ]
  testthat::expect_equal(r_scan, r_index)
})