tests/testthat/test-visualization.R

In LBDiscover: Literature-Based Discovery Tools for Biomedical Research

# Test file for visualization.R
# Tests for all visualization functions in the LBDiscover package

library(testthat)

# Helper function to create mock ABC results data
create_mock_abc_results <- function(n_results = 10) {
  set.seed(123)  # For reproducible results

  data.frame(
    a_term = rep("migraine", n_results),
    b_term = paste0("b_term_", 1:n_results),
    c_term = paste0("c_term_", 1:n_results),
    a_b_score = runif(n_results, 0.1, 0.8),
    b_c_score = runif(n_results, 0.1, 0.8),
    abc_score = runif(n_results, 0.01, 0.5),
    a_type = rep("disease", n_results),
    b_type = sample(c("protein", "gene", "chemical"), n_results, replace = TRUE),
    c_type = sample(c("drug", "disease", "protein"), n_results, replace = TRUE),
    p_value = runif(n_results, 0.01, 0.2),
    significant = sample(c(TRUE, FALSE), n_results, replace = TRUE),
    stringsAsFactors = FALSE
  )
}

# Helper function to create mock co-occurrence matrix
create_mock_co_matrix <- function() {
  set.seed(123)

  # Create a small co-occurrence matrix
  terms <- c("migraine", "serotonin", "sumatriptan", "headache", "pain",
             "receptor", "neuron", "brain", "medication", "treatment")

  matrix_data <- matrix(runif(100, 0, 1), nrow = 10, ncol = 10)
  rownames(matrix_data) <- terms
  colnames(matrix_data) <- terms

  # Make diagonal zero (no self co-occurrence)
  diag(matrix_data) <- 0

  # Add entity types as attribute
  entity_types <- c(
    "migraine" = "disease",
    "serotonin" = "chemical",
    "sumatriptan" = "drug",
    "headache" = "symptom",
    "pain" = "symptom",
    "receptor" = "protein",
    "neuron" = "cell",
    "brain" = "anatomy",
    "medication" = "drug",
    "treatment" = "therapeutic_procedure"
  )

  attr(matrix_data, "entity_types") <- entity_types

  return(matrix_data)
}

# Helper function to suppress all output (messages, warnings, prints)
suppress_all <- function(expr) {
  suppressMessages(suppressWarnings(capture.output(expr, type = "message")))
  invisible()
}

# Test vis_abc_network function
test_that("vis_abc_network works correctly", {
  skip_if_not_installed("igraph")

  abc_results <- create_mock_abc_results(15)

  # Test basic functionality
  expect_error(suppress_all(vis_abc_network(abc_results)), NA)

  # Test with different parameters
  expect_error(suppress_all(vis_abc_network(abc_results, top_n = 10, min_score = 0.05)), NA)

  # Test with color_by parameter
  expect_error(suppress_all(vis_abc_network(abc_results, color_by = "type")), NA)

  # Test with custom title
  expect_error(suppress_all(vis_abc_network(abc_results, title = "Test Network")), NA)

  # Test error handling - empty results
  empty_results <- abc_results[0, ]
  expect_error(vis_abc_network(empty_results), "ABC results are empty")

  # Test error handling - no results after filtering
  low_score_results <- abc_results
  low_score_results$abc_score <- rep(0.001, nrow(low_score_results))
  expect_error(vis_abc_network(low_score_results, min_score = 0.1),
               "No results remain after filtering")
})

# Test export_network function
test_that("export_network works correctly", {
  skip_if_not_installed("igraph")

  abc_results <- create_mock_abc_results(20)
  temp_file <- tempfile(fileext = ".html")

  # Test basic export
  result <- suppressMessages(export_network(abc_results, output_file = temp_file, open = FALSE))
  expect_true(file.exists(temp_file))
  expect_equal(result, temp_file)

  # Test with different parameters
  temp_file2 <- tempfile(fileext = ".html")
  result2 <- suppressMessages(export_network(abc_results, output_file = temp_file2,
                                             top_n = 25, min_score = 0.05, open = FALSE))
  expect_true(file.exists(temp_file2))

  # Clean up
  unlink(c(temp_file, temp_file2))

  # Test error handling - now properly provide output_file parameter
  empty_results <- abc_results[0, ]
  temp_file3 <- tempfile(fileext = ".html")
  expect_error(export_network(empty_results, output_file = temp_file3), "ABC results are empty")

  # Clean up temp file if it was created
  if (file.exists(temp_file3)) {
    unlink(temp_file3)
  }
})

# Test vis_heatmap function
test_that("vis_heatmap works correctly", {
  abc_results <- create_mock_abc_results(20)

  # Test basic functionality - expect some messages from heatmap function
  expect_error(suppressMessages(vis_heatmap(abc_results)), NA)

  # Test with different parameters
  expect_error(suppressMessages(vis_heatmap(abc_results, top_n = 15, min_score = 0.05)), NA)

  # Test with different color palettes
  expect_error(suppressMessages(vis_heatmap(abc_results, color_palette = "reds")), NA)
  expect_error(suppressMessages(vis_heatmap(abc_results, color_palette = "greens")), NA)
  expect_error(suppressMessages(vis_heatmap(abc_results, color_palette = "rainbow")), NA)

  # Test with significance display
  expect_error(suppressMessages(vis_heatmap(abc_results, show_significance = TRUE)), NA)

  # Test with entity types
  expect_error(suppressMessages(vis_heatmap(abc_results, show_entity_types = TRUE)), NA)

  # Test custom title
  expect_error(suppressMessages(vis_heatmap(abc_results, title = "Custom Heatmap Title")), NA)

  # Test error handling
  empty_results <- abc_results[0, ]
  expect_error(vis_heatmap(empty_results), "ABC results are empty")
})

# Test vis_network function
test_that("vis_network works correctly", {
  skip_if_not_installed("igraph")

  abc_results <- create_mock_abc_results(15)

  # Test basic functionality
  expect_error(suppressMessages(suppressWarnings(vis_network(abc_results))), NA)

  # Test with different parameters
  expect_error(suppressMessages(suppressWarnings(vis_network(abc_results, top_n = 10, min_score = 0.05))), NA)

  # Test with different node size factors
  expect_error(suppressMessages(suppressWarnings(vis_network(abc_results, node_size_factor = 3))), NA)
  expect_error(suppressMessages(suppressWarnings(vis_network(abc_results, node_size_factor = 7))), NA)

  # Test with different color_by options
  expect_error(suppressMessages(suppressWarnings(vis_network(abc_results, color_by = "type"))), NA)
  expect_error(suppressMessages(suppressWarnings(vis_network(abc_results, color_by = "role"))), NA)

  # Test with significance display
  expect_error(suppressMessages(suppressWarnings(vis_network(abc_results, show_significance = TRUE))), NA)

  # Test with entity types
  expect_error(suppressMessages(suppressWarnings(vis_network(abc_results, show_entity_types = TRUE))), NA)

  # Test with different label sizes
  expect_error(suppressMessages(suppressWarnings(vis_network(abc_results, label_size = 0.8))), NA)
  expect_error(suppressMessages(suppressWarnings(vis_network(abc_results, label_size = 1.2))), NA)

  # Test custom title
  expect_error(suppressMessages(suppressWarnings(vis_network(abc_results, title = "Custom Network Title"))), NA)

  # Test error handling
  empty_results <- abc_results[0, ]
  expect_error(vis_network(empty_results), "ABC results are empty")
})

# Test export_chord_diagram function
test_that("export_chord_diagram works correctly", {
  abc_results <- create_mock_abc_results(25)
  temp_file <- tempfile(fileext = ".html")

  # Test basic export
  result <- suppressMessages(export_chord_diagram(abc_results, output_file = temp_file, open = FALSE))
  expect_true(file.exists(temp_file))
  expect_equal(result, temp_file)

  # Test with different parameters
  temp_file2 <- tempfile(fileext = ".html")
  result2 <- suppressMessages(export_chord_diagram(abc_results, output_file = temp_file2,
                                                   top_n = 30, min_score = 0.05, open = FALSE))
  expect_true(file.exists(temp_file2))

  # Clean up
  unlink(c(temp_file, temp_file2))

  # Test error handling - properly provide output_file parameter
  empty_results <- abc_results[0, ]
  temp_file3 <- tempfile(fileext = ".html")
  expect_error(export_chord_diagram(empty_results, output_file = temp_file3), "ABC results are empty")

  # Clean up temp file if it was created
  if (file.exists(temp_file3)) {
    unlink(temp_file3)
  }

  # Test with missing required fields
  incomplete_results <- abc_results
  incomplete_results$a_term <- NULL
  temp_file4 <- tempfile(fileext = ".html")
  expect_error(export_chord_diagram(incomplete_results, output_file = temp_file4))

  # Clean up temp file if it was created
  if (file.exists(temp_file4)) {
    unlink(temp_file4)
  }
})

# Test create_report function
test_that("create_report works correctly", {
  # Create mock data
  abc_results <- create_mock_abc_results(20)
  results_list <- list(abc = abc_results)

  # Mock articles data
  articles <- data.frame(
    pmid = paste0("PMID", 1:10),
    title = paste0("Article Title ", 1:10),
    publication_year = sample(2015:2023, 10, replace = TRUE),
    stringsAsFactors = FALSE
  )

  temp_file <- tempfile(fileext = ".html")

  # Test basic report creation
  result <- create_report(results_list, output_file = temp_file)
  expect_true(file.exists(temp_file))
  expect_equal(result, temp_file)

  # Test with visualizations
  temp_viz_file <- tempfile(fileext = ".html")
  suppressMessages(export_network(abc_results, output_file = temp_viz_file, open = FALSE))

  visualizations <- list(
    network = temp_viz_file,
    heatmap = "mock_heatmap.png"
  )

  temp_file2 <- tempfile(fileext = ".html")
  result2 <- create_report(results_list, visualizations = visualizations,
                           articles = articles, output_file = temp_file2)
  expect_true(file.exists(temp_file2))

  # Clean up
  unlink(c(temp_file, temp_file2, temp_viz_file))

  # Test with empty results
  empty_results_list <- list(abc = abc_results[0, ])
  temp_file3 <- tempfile(fileext = ".html")
  expect_error(create_report(empty_results_list, output_file = temp_file3), NA)
  expect_true(file.exists(temp_file3))
  unlink(temp_file3)
})

# Test helper functions and edge cases
test_that("visualization helper functions work correctly", {
  skip_if_not_installed("igraph")

  abc_results <- create_mock_abc_results(5)

  # Test with results that have missing entity type information
  abc_results_no_types <- abc_results
  abc_results_no_types$a_type <- NULL
  abc_results_no_types$b_type <- NULL
  abc_results_no_types$c_type <- NULL

  # These may produce warnings about missing entity types, which is expected
  expect_error(suppressMessages(suppressWarnings(vis_network(abc_results_no_types))), NA)
  expect_error(suppressMessages(suppressWarnings(vis_heatmap(abc_results_no_types))), NA)
})

# Test parameter validation and warnings
test_that("visualization functions handle invalid parameters correctly", {
  abc_results <- create_mock_abc_results(10)

  # Test vis_heatmap with missing significance information
  abc_results_no_sig <- abc_results
  abc_results_no_sig$significant <- NULL
  abc_results_no_sig$p_value <- NULL

  expect_warning(vis_heatmap(abc_results_no_sig, show_significance = TRUE),
                 "Significance information not found")

  # Test vis_network with missing significance information
  expect_warning(vis_network(abc_results_no_sig, show_significance = TRUE),
                 "Significance information not found")

  # Test vis_heatmap with missing entity types
  abc_results_no_types <- abc_results
  abc_results_no_types$a_type <- NULL
  abc_results_no_types$b_type <- NULL
  abc_results_no_types$c_type <- NULL

  expect_warning(vis_heatmap(abc_results_no_types, show_entity_types = TRUE),
                 "Entity types not found")

  expect_warning(vis_network(abc_results_no_types, show_entity_types = TRUE),
                 "Entity types not found")
})

# Test with larger datasets to check performance
test_that("visualization functions handle larger datasets", {
  skip_if_not_installed("igraph")

  # Create a larger dataset
  large_abc_results <- create_mock_abc_results(100)

  # Test that functions complete without error
  expect_error(suppressMessages(vis_heatmap(large_abc_results, top_n = 50)), NA)
  expect_error(suppressMessages(suppressWarnings(vis_network(large_abc_results, top_n = 50))), NA)

  # Test export functions with larger datasets
  temp_file <- tempfile(fileext = ".html")
  expect_error(suppressMessages(export_network(large_abc_results, output_file = temp_file,
                                               top_n = 75, open = FALSE)), NA)
  expect_true(file.exists(temp_file))
  unlink(temp_file)

  temp_file2 <- tempfile(fileext = ".html")
  expect_error(suppressMessages(export_chord_diagram(large_abc_results, output_file = temp_file2,
                                                     top_n = 75, open = FALSE)), NA)
  expect_true(file.exists(temp_file2))
  unlink(temp_file2)
})

# Test color palette functionality
test_that("color palettes work correctly in visualizations", {
  abc_results <- create_mock_abc_results(15)

  # Test all available color palettes for heatmap
  palettes <- c("blues", "reds", "greens", "purples", "rainbow")

  for (palette in palettes) {
    expect_error(suppressMessages(vis_heatmap(abc_results, color_palette = palette)), NA)
  }

  # Test default palette behavior
  expect_error(suppressMessages(vis_heatmap(abc_results, color_palette = "invalid_palette")), NA)
})

# Test network layout and rendering
test_that("network layout and rendering works correctly", {
  skip_if_not_installed("igraph")

  abc_results <- create_mock_abc_results(12)

  # Test with different node size factors
  node_sizes <- c(1, 3, 5, 8, 10)

  for (size in node_sizes) {
    expect_error(suppressMessages(suppressWarnings(vis_network(abc_results, node_size_factor = size))), NA)
  }

  # Test with different color schemes
  color_options <- c("type", "role")

  for (color_opt in color_options) {
    expect_error(suppressMessages(suppressWarnings(vis_network(abc_results, color_by = color_opt))), NA)
  }
})

# Test file I/O operations
test_that("file operations work correctly", {
  skip_if_not_installed("igraph")

  abc_results <- create_mock_abc_results(15)

  # Test HTML export with different file extensions
  temp_files <- c(
    tempfile(fileext = ".html"),
    tempfile(fileext = ".htm")
  )

  for (temp_file in temp_files) {
    result <- suppressMessages(export_network(abc_results, output_file = temp_file, open = FALSE))
    expect_true(file.exists(temp_file))
    expect_equal(result, temp_file)
  }

  # Clean up
  unlink(temp_files)

  # Test chord diagram export
  temp_chord <- tempfile(fileext = ".html")
  result_chord <- suppressMessages(export_chord_diagram(abc_results, output_file = temp_chord, open = FALSE))
  expect_true(file.exists(temp_chord))
  expect_equal(result_chord, temp_chord)
  unlink(temp_chord)
})

# Test edge cases and boundary conditions
test_that("visualization functions handle edge cases", {
  # Test with single result
  single_result <- create_mock_abc_results(1)
  expect_error(suppressMessages(vis_heatmap(single_result)), NA)
  expect_error(suppressMessages(suppressWarnings(vis_network(single_result))), NA)

  # Test with results having identical scores
  identical_scores <- create_mock_abc_results(5)
  identical_scores$abc_score <- rep(0.5, 5)
  identical_scores$a_b_score <- rep(0.3, 5)
  identical_scores$b_c_score <- rep(0.4, 5)

  expect_error(suppressMessages(vis_heatmap(identical_scores)), NA)
  expect_error(suppressMessages(suppressWarnings(vis_network(identical_scores))), NA)

  # Test with very low scores
  low_scores <- create_mock_abc_results(8)
  low_scores$abc_score <- rep(0.001, 8)

  expect_error(suppressMessages(vis_heatmap(low_scores, min_score = 0.0001)), NA)
  expect_error(suppressMessages(suppressWarnings(vis_network(low_scores, min_score = 0.0001))), NA)
})

# Test report generation with different data combinations
test_that("report generation works with various data combinations", {
  abc_results <- create_mock_abc_results(10)

  # Test with multiple result types
  results_list <- list(
    abc = abc_results,
    anc = abc_results[1:5, ],
    lsi = abc_results[6:10, ]
  )

  temp_file <- tempfile(fileext = ".html")
  result <- create_report(results_list, output_file = temp_file)
  expect_true(file.exists(temp_file))
  unlink(temp_file)

  # Test with NULL articles
  temp_file2 <- tempfile(fileext = ".html")
  result2 <- create_report(results_list, articles = NULL, output_file = temp_file2)
  expect_true(file.exists(temp_file2))
  unlink(temp_file2)

  # Test with empty articles
  empty_articles <- data.frame(
    pmid = character(0),
    title = character(0),
    publication_year = numeric(0),
    stringsAsFactors = FALSE
  )

  temp_file3 <- tempfile(fileext = ".html")
  result3 <- create_report(results_list, articles = empty_articles, output_file = temp_file3)
  expect_true(file.exists(temp_file3))
  unlink(temp_file3)
})

# Test memory efficiency and cleanup
test_that("visualization functions clean up properly", {
  abc_results <- create_mock_abc_results(20)

  # Test that functions don't leave temporary files
  temp_dir_before <- list.files(tempdir(), full.names = TRUE)

  # Run visualizations
  suppressMessages(vis_heatmap(abc_results))
  suppressMessages(suppressWarnings(vis_network(abc_results)))

  temp_dir_after <- list.files(tempdir(), full.names = TRUE)

  # Should not have created new temporary files (allowing for some variance in temp files)
  expect_true(length(temp_dir_after) - length(temp_dir_before) <= 2)
})

# Test integration with different data formats
test_that("visualizations work with different data formats", {
  # Test with data.table format (if available)
  abc_results <- create_mock_abc_results(10)

  # Only test if data.table is available and loaded
  if (requireNamespace("data.table", quietly = TRUE) && "data.table" %in% loadedNamespaces()) {
    dt_results <- data.table::as.data.table(abc_results)
    expect_error(suppressMessages(vis_heatmap(as.data.frame(dt_results))), NA)
    expect_error(suppressMessages(suppressWarnings(vis_network(as.data.frame(dt_results)))), NA)
  }

  # Only test if tibble is available and loaded
  if (requireNamespace("tibble", quietly = TRUE) && "tibble" %in% loadedNamespaces()) {
    tbl_results <- tibble::as_tibble(abc_results)
    expect_error(suppressMessages(vis_heatmap(as.data.frame(tbl_results))), NA)
    expect_error(suppressMessages(suppressWarnings(vis_network(as.data.frame(tbl_results)))), NA)
  }
})

# Test console output and messages
test_that("visualization functions handle output appropriately", {
  abc_results <- create_mock_abc_results(15)

  # Test that functions can be called (may produce messages, which we suppress in practice)
  expect_error(suppressMessages(vis_heatmap(abc_results)), NA)
  expect_error(suppressMessages(suppressWarnings(vis_network(abc_results))), NA)

  # Test that export functions work
  temp_file <- tempfile(fileext = ".html")
  expect_error(suppressMessages(export_network(abc_results, output_file = temp_file, open = FALSE)), NA)
  unlink(temp_file)
})

# Final cleanup function
cleanup_test_files <- function() {
  # Clean up any remaining temporary files
  temp_files <- list.files(tempdir(), pattern = "^file.*\\.(html|png)$", full.names = TRUE)
  if (length(temp_files) > 0) {
    unlink(temp_files)
  }
}

# Run cleanup
cleanup_test_files()

# Test completion message
test_that("all visualization tests completed successfully", {
  expect_true(TRUE)
})