# 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) })