diff --git a/tests/testthat/test-plot_tree.R b/tests/testthat/test-plot_tree.R index 2931518..9ed7596 100644 --- a/tests/testthat/test-plot_tree.R +++ b/tests/testthat/test-plot_tree.R @@ -1,3 +1,13 @@ +get_default_filepaths <- function(dir_path, base_name) { + filepaths <- c( + noninteractive = file.path(dir_path, glue::glue("{base_name}.svg")), + interactive_html = file.path(dir_path, glue::glue("{base_name}.html")), + interactive_rds = file.path(dir_path, glue::glue("{base_name}.rds")) + ) + + filepaths +} + describe("save_trees", { tree_list <- list( noninteractive = ggplot2::ggplot(), @@ -6,36 +16,41 @@ describe("save_trees", { interactive = ggplot2::ggplot() ) branch_col <- "logistic_growth_rate" + default_base_name <- glue::glue("tree-{branch_col}") + dated_base_name <- glue::glue("tree-{branch_col}-{Sys.Date()}") it("creates .svg / .rds / .html files - default: without the current date", { td <- withr::local_tempdir(pattern = "no-date-svg") - output_rds <- file.path(td, glue::glue("tree-{branch_col}.rds")) - output_html <- file.path(td, glue::glue("tree-{branch_col}.html")) - output_svg <- file.path(td, glue::glue("tree-{branch_col}.svg")) + + filetypes <- list( + expected = c("noninteractive", "interactive_html", "interactive_rds"), + unexpected = character(0) + ) + + default_files <- get_default_filepaths(td, default_base_name) + expected_files <- default_files[filetypes$expected] + unexpected_files <- default_files[filetypes$unexpected] created_files <- save_trees( tree_list, branch_col = branch_col, output_dir = td, n_leaves = 100 ) - expect_mapequal( - created_files, - c( - "noninteractive" = output_svg, - "interactive_rds" = output_rds, - "interactive_html" = output_html - ) - ) - expect_true(file.exists(output_svg)) - expect_true(file.exists(output_html)) - expect_true(file.exists(output_rds)) + expect_mapequal(created_files, expected_files) + expect_true(all(file.exists(expected_files))) }) it("creates interactive html plot 'only' based on output_format argument", { td <- withr::local_tempdir(pattern = "no-date-svg") - output_html <- file.path(td, glue::glue("tree-{branch_col}.html")) - output_svg <- file.path(td, glue::glue("tree-{branch_col}.svg")) - unexpected_rds <- file.path(td, glue::glue("tree-{branch_col}.rds")) + + filetypes <- list( + expected = c("noninteractive", "interactive_html"), + unexpected = "interactive_rds" + ) + + default_files <- get_default_filepaths(td, default_base_name) + expected_files <- default_files[filetypes$expected] + unexpected_files <- default_files[filetypes$unexpected] created_files <- save_trees( tree_list, @@ -43,20 +58,22 @@ describe("save_trees", { output_format = "html" ) - expect_mapequal( - created_files, - c("noninteractive" = output_svg, "interactive_html" = output_html) - ) - expect_true(file.exists(output_svg)) - expect_true(file.exists(output_html)) - expect_false(file.exists(unexpected_rds)) + expect_mapequal(created_files, expected_files) + expect_true(all(file.exists(expected_files))) + expect_false(any(file.exists(unexpected_files))) }) it("creates interactive rds plot 'only' based on output_format argument", { td <- withr::local_tempdir(pattern = "no-date-svg") - output_rds <- file.path(td, glue::glue("tree-{branch_col}.rds")) - output_svg <- file.path(td, glue::glue("tree-{branch_col}.svg")) - unexpected_html <- file.path(td, glue::glue("tree-{branch_col}.html")) + + filetypes <- list( + expected = c("noninteractive", "interactive_rds"), + unexpected = "interactive_html" + ) + + default_files <- get_default_filepaths(td, default_base_name) + expected_files <- default_files[filetypes$expected] + unexpected_files <- default_files[filetypes$unexpected] created_files <- save_trees( tree_list, @@ -64,36 +81,30 @@ describe("save_trees", { output_format = "rds" ) - expect_mapequal( - created_files, - c("noninteractive" = output_svg, "interactive_rds" = output_rds) - ) - expect_true(file.exists(output_svg)) - expect_true(file.exists(output_rds)) - expect_false(file.exists(unexpected_html)) + expect_mapequal(created_files, expected_files) + expect_true(all(file.exists(expected_files))) + expect_false(any(file.exists(unexpected_files))) }) it("creates .svg / .rds / .html files - optionally including the current date", { td <- withr::local_tempdir(pattern = "noninteractive-svg") - output_rds <- file.path(td, glue::glue("tree-{branch_col}-{Sys.Date()}.rds")) - output_html <- file.path(td, glue::glue("tree-{branch_col}-{Sys.Date()}.html")) - output_svg <- file.path(td, glue::glue("tree-{branch_col}-{Sys.Date()}.svg")) + + filetypes <- list( + expected = c("noninteractive", "interactive_html", "interactive_rds"), + unexpected = character(0) + ) + + default_files <- get_default_filepaths(td, dated_base_name) + expected_files <- default_files[filetypes$expected] + unexpected_files <- default_files[filetypes$unexpected] created_files <- save_trees( tree_list, branch_col = branch_col, output_dir = td, n_leaves = 100, include_date = TRUE ) - expect_equal( - created_files, - c( - "noninteractive" = output_svg, - "interactive_rds" = output_rds, - "interactive_html" = output_html - ) - ) - expect_true(file.exists(output_svg)) - expect_true(file.exists(output_rds)) - expect_true(file.exists(output_html)) + expect_mapequal(created_files, expected_files) + expect_true(all(file.exists(expected_files))) + expect_false(any(file.exists(unexpected_files))) }) })