tests/testthat/test-queries.R

In LBDiscover: Literature-Based Discovery Tools for Biomedical Research

# Mock data and helper functions
create_mock_abc_results <- function(n = 5) {
  set.seed(123) # For reproducibility

  # Sample terms
  a_terms <- c("Diabetes", "Hypertension", "Obesity", "Asthma", "Cancer")
  b_terms_list <- list(
    c("Insulin", "Glucose"),
    c("Blood pressure", "Sodium"),
    c("Diet", "Exercise"),
    c("Inflammation", "Bronchodilator"),
    c("Tumor", "Metastasis")
  )
  c_terms <- c("Kidney disease", "Stroke", "Heart disease", "COPD", "Mortality")

  # Generate sample data
  indices <- sample(1:5, n, replace = TRUE)

  data.frame(
    a_term = a_terms[indices],
    b_terms = sapply(indices, function(i) paste(b_terms_list[[i]], collapse = ", ")),
    c_term = c_terms[indices],
    score = runif(n, 0.5, 1.0),
    stringsAsFactors = FALSE
  )
}

# Test for query_umls function
test_that("query_umls handles API calls correctly", {
  # Skip if not interactive (to avoid real API calls during automated testing)
  skip_if_not(interactive())

  # For interactive testing with a real API key:
  # api_key <- "your_actual_api_key"
  # result <- query_umls("Diabetes", api_key)
  # expect_s3_class(result, "data.frame")

  # Mock testing
  # Mock the initial authentication POST
  mock_auth_response <- mock(
    list(
      status_code = 201,
      headers = list(location = "https://mockurl.com/tgt")
    )
  )

  # Mock the ticket response
  mock_ticket_response <- mock(
    list(
      content = function(...) "ST-mock-ticket"
    )
  )

  # Mock the search response
  mock_search_response <- mock(
    list(
      content = function(...) list(
        result = list(
          results = list(
            list(
              ui = "C0011849",
              name = "Diabetes Mellitus"
            )
          )
        )
      )
    )
  )

  # Mock the concept response
  mock_concept_response <- mock(
    list(
      content = function(...) list(
        result = list(
          ui = "C0011849",
          name = "Diabetes Mellitus"
        )
      )
    )
  )

  # Mock the semantics response
  mock_semantics_response <- mock(
    list(
      content = function(...) list(
        result = list(
          list(name = "Disease or Syndrome")
        )
      )
    )
  )

  # Mock the definitions response
  mock_definitions_response <- mock(
    list(
      content = function(...) list(
        result = list(
          list(value = "A metabolic disorder characterized by high blood sugar.")
        )
      )
    )
  )

  # Create a mock stubs for httr functions
  mockery::stub(query_umls, "httr::POST", mock_auth_response, 1)
  mockery::stub(query_umls, "httr::POST", mock_ticket_response, 2)
  mockery::stub(query_umls, "httr::GET", mock_search_response, 1)
  mockery::stub(query_umls, "httr::GET", mock_concept_response, 2)
  mockery::stub(query_umls, "httr::GET", mock_semantics_response, 3)
  mockery::stub(query_umls, "httr::GET", mock_definitions_response, 4)

  # Test with mocked responses
  result <- query_umls("Diabetes", api_key = "mock_api_key")

  # Check the result structure
  expect_s3_class(result, "data.frame")
  expect_equal(ncol(result), 5)
  expect_equal(nrow(result), 1)

  # Check column names
  expected_cols <- c("cui", "term", "semantic_type", "source", "definition")
  expect_true(all(expected_cols %in% colnames(result)))

  # Check content
  expect_equal(result$cui, "C0011849")
  expect_equal(result$term, "Diabetes Mellitus")
  expect_equal(result$semantic_type, "Disease or Syndrome")
  expect_equal(result$source, "UMLS")
  expect_equal(result$definition, "A metabolic disorder characterized by high blood sugar.")

  # Test with NULL API key
  expect_error(query_umls("Diabetes", api_key = NULL), "UMLS API key is required")
})

# Test for query_mesh function
test_that("query_mesh handles API calls correctly", {
  # Skip if not interactive or if rentrez is not available
  skip_if_not(interactive() && requireNamespace("rentrez", quietly = TRUE))

  # For interactive testing:
  # result <- query_mesh("Diabetes")
  # expect_s3_class(result, "data.frame")

  # Mock testing
  # Create a mock stub for rentrez::entrez_search
  mock_mesh_search <- mock(
    list(
      count = 1,
      ids = "68003920"
    )
  )

  # Create a mock response for rentrez::entrez_fetch
  mock_mesh_text <- "
DescriptorUI: D003920
DescriptorName: Diabetes Mellitus
Tree Number: C18.452.297
Tree Number: C19.246
Scope Note: A metabolic disorder characterized by high blood glucose levels.
  "

  mock_mesh_fetch <- mock(mock_mesh_text)

  # Create stubs for rentrez functions
  mockery::stub(query_mesh, "rentrez::entrez_search", mock_mesh_search)
  mockery::stub(query_mesh, "rentrez::entrez_fetch", mock_mesh_fetch)
  mockery::stub(query_mesh, "requireNamespace", TRUE)

  # Test with mocked responses
  result <- query_mesh("Diabetes")

  # Check the result structure
  expect_s3_class(result, "data.frame")
  expect_equal(ncol(result), 4)
  expect_equal(nrow(result), 1)

  # Check column names
  expected_cols <- c("mesh_id", "term", "tree_number", "scope_note")
  expect_true(all(expected_cols %in% colnames(result)))

  # Check content
  expect_equal(result$mesh_id, "D003920")
  expect_equal(result$term, "Diabetes Mellitus")
  expect_equal(result$tree_number, "C18.452.297, C19.246")
  expect_true(grepl("metabolic disorder", result$scope_note))

  # Test with no mesh terms found
  mock_no_results <- mock(list(count = 0))
  mockery::stub(query_mesh, "rentrez::entrez_search", mock_no_results)

  result_no_match <- query_mesh("NonExistentTermXYZ")
  expect_true(is.na(result_no_match$mesh_id))
  expect_equal(result_no_match$term, "NonExistentTermXYZ")
  expect_true(grepl("No MeSH term found", result_no_match$scope_note))

  # Test when rentrez is not available
  mockery::stub(query_mesh, "requireNamespace", FALSE)
  result_no_rentrez <- query_mesh("Diabetes")
  expect_true(is.na(result_no_rentrez$mesh_id))
  expect_equal(result_no_rentrez$term, "Diabetes")
})

# Test for enhance_abc_kb function
test_that("enhance_abc_kb enhances results correctly", {
  # Create mock ABC results
  abc_results <- create_mock_abc_results(3)

  # Create a mock version of query_umls that returns predictable results
  mock_query_umls <- function(term, api_key, version = "current") {
    semantic_types <- list(
      "Diabetes" = "Disease or Syndrome",
      "Hypertension" = "Disease or Syndrome",
      "Obesity" = "Disease or Syndrome",
      "Insulin" = "Pharmacologic Substance",
      "Glucose" = "Biologically Active Substance",
      "Blood pressure" = "Physiologic Function",
      "Sodium" = "Element, Ion, or Isotope",
      "Diet" = "Therapeutic or Preventive Procedure",
      "Exercise" = "Therapeutic or Preventive Procedure",
      "Kidney disease" = "Disease or Syndrome",
      "Stroke" = "Disease or Syndrome",
      "Heart disease" = "Disease or Syndrome"
    )

    cui_values <- list(
      "Diabetes" = "C0011849",
      "Hypertension" = "C0020538",
      "Obesity" = "C0028754",
      "Insulin" = "C0021641",
      "Glucose" = "C0017725",
      "Blood pressure" = "C0005823",
      "Sodium" = "C0037570",
      "Diet" = "C0012155",
      "Exercise" = "C0015259",
      "Kidney disease" = "C0022658",
      "Stroke" = "C0038454",
      "Heart disease" = "C0018799"
    )

    sem_type <- if (term %in% names(semantic_types)) semantic_types[[term]] else "Unknown"
    cui <- if (term %in% names(cui_values)) cui_values[[term]] else NA_character_

    data.frame(
      cui = cui,
      term = term,
      semantic_type = sem_type,
      source = "UMLS",
      definition = paste("Mock definition for", term),
      stringsAsFactors = FALSE
    )
  }

  # Create a mock version of query_mesh that returns predictable results
  mock_query_mesh <- function(term, api_key = NULL) {
    mesh_ids <- list(
      "Diabetes" = "D003920",
      "Hypertension" = "D006973",
      "Obesity" = "D009765",
      "Insulin" = "D007328",
      "Glucose" = "D005947",
      "Blood pressure" = "D001794",
      "Sodium" = "D012964",
      "Diet" = "D004032",
      "Exercise" = "D015444",
      "Kidney disease" = "D007674",
      "Stroke" = "D020521",
      "Heart disease" = "D006331"
    )

    tree_numbers <- list(
      "Diabetes" = "C18.452.297",
      "Hypertension" = "C14.907.489",
      "Obesity" = "C18.654.726",
      "Insulin" = "D08.811.277",
      "Glucose" = "D09.400.105",
      "Blood pressure" = "E01.370.600",
      "Sodium" = "D01.552.197",
      "Diet" = "G07.203.650",
      "Exercise" = "G11.427.410",
      "Kidney disease" = "C12.777.419",
      "Stroke" = "C14.907.253",
      "Heart disease" = "C14.280"
    )

    mesh_id <- if (term %in% names(mesh_ids)) mesh_ids[[term]] else NA_character_
    tree_number <- if (term %in% names(tree_numbers)) tree_numbers[[term]] else NA_character_

    data.frame(
      mesh_id = mesh_id,
      term = term,
      tree_number = tree_number,
      scope_note = paste("Mock scope note for", term),
      stringsAsFactors = FALSE
    )
  }

  # Test enhance_abc_kb with UMLS
  mockery::stub(enhance_abc_kb, "query_umls", mock_query_umls)
  enhanced_umls <- enhance_abc_kb(abc_results, knowledge_base = "umls", api_key = "mock_key")

  # Check that the function returns a data frame with expected columns
  expect_s3_class(enhanced_umls, "data.frame")
  expect_true(all(c("a_cui", "a_semantic_type", "c_cui", "c_semantic_type") %in% colnames(enhanced_umls)))
  expect_equal(nrow(enhanced_umls), nrow(abc_results))

  # Check enhancement content for UMLS
  for (i in 1:nrow(enhanced_umls)) {
    a_term <- enhanced_umls$a_term[i]
    c_term <- enhanced_umls$c_term[i]

    expect_equal(enhanced_umls$a_cui[i], mock_query_umls(a_term, api_key = "mock_key")$cui)
    expect_equal(enhanced_umls$a_semantic_type[i], mock_query_umls(a_term, api_key = "mock_key")$semantic_type)
    expect_equal(enhanced_umls$c_cui[i], mock_query_umls(c_term, api_key = "mock_key")$cui)
    expect_equal(enhanced_umls$c_semantic_type[i], mock_query_umls(c_term, api_key = "mock_key")$semantic_type)
  }

  # Test enhance_abc_kb with MeSH
  mockery::stub(enhance_abc_kb, "query_mesh", mock_query_mesh)
  enhanced_mesh <- enhance_abc_kb(abc_results, knowledge_base = "mesh")

  # Check that the function returns a data frame with expected columns
  expect_s3_class(enhanced_mesh, "data.frame")
  expect_true(all(c("a_mesh_id", "a_tree_number", "c_mesh_id", "c_tree_number") %in% colnames(enhanced_mesh)))
  expect_equal(nrow(enhanced_mesh), nrow(abc_results))

  # Check enhancement content for MeSH
  for (i in 1:nrow(enhanced_mesh)) {
    a_term <- enhanced_mesh$a_term[i]
    c_term <- enhanced_mesh$c_term[i]

    expect_equal(enhanced_mesh$a_mesh_id[i], mock_query_mesh(a_term)$mesh_id)
    expect_equal(enhanced_mesh$a_tree_number[i], mock_query_mesh(a_term)$tree_number)
    expect_equal(enhanced_mesh$c_mesh_id[i], mock_query_mesh(c_term)$mesh_id)
    expect_equal(enhanced_mesh$c_tree_number[i], mock_query_mesh(c_term)$tree_number)
  }

  # Test with empty results
  empty_results <- abc_results[0, ]
  enhanced_empty <- enhance_abc_kb(empty_results, knowledge_base = "umls", api_key = "mock_key")
  expect_equal(nrow(enhanced_empty), 0)

  # Test with invalid knowledge base (should use the default)
  expect_error(
    enhance_abc_kb(abc_results, knowledge_base = "invalid", api_key = "mock_key"),
    "'arg' should be one of"
  )
})