diff --git a/R/utils_plot.R b/R/utils_plot.R index a7ddac99..278ed8b7 100644 --- a/R/utils_plot.R +++ b/R/utils_plot.R @@ -766,6 +766,7 @@ filter_data <- function( # Check if there are multiple module_names present if (length(unique(plot_data$module_name)) > 1) { + module_names <- unique(plot_data$module_name) if (!is.null(module)) { plot_data <- plot_data |> dplyr::filter( @@ -776,30 +777,31 @@ filter_data <- function( } else { cli::cli_alert_warning("Multiple module names found in data. \n") options <- c() - for (i in seq_along(unique(plot_data$module_name))) { + for (i in seq_along(module_names)) { # options <- paste0(options, " ", i, ") ", unique(plot_data$module_name)[i], "\n") - options[i] <- paste0(unique(plot_data$module_name)[i]) + options[i] <- paste0(module_names[i]) } if (interactive()) { if (interactive) { question1 <- utils::select.list( options, multiple = TRUE, + preselect = options[1], title = "Select one or more of the following module names" ) # use <<- to export module to environment for use with key quantity calc - selected_module <<- intersect( - unique(plot_data$module_name), - question1 - ) + selected_module <<- intersect(module_names, question1) + if (length(selected_module) < 1) { + selected_module <<- module_names[1] + } } else { # use <<- to export module to environment for use with key quantity calc - selected_module <<- unique(plot_data$module_name)[1] + selected_module <<- module_names[1] cli::cli_alert_info("Selection bypassed. Filtering by {selected_module}.") } } else { # use <<- to export module to environment for use with key quantity calc - selected_module <<- unique(plot_data$module_name)[1] + selected_module <<- module_names[1] cli::cli_alert_info(glue::glue("Environment not interactive. Selecting {selected_module}.")) } if (length(selected_module) > 0) { diff --git a/tests/testthat/test-utils_plot.R b/tests/testthat/test-utils_plot.R index dfe4e857..7ac228cb 100644 --- a/tests/testthat/test-utils_plot.R +++ b/tests/testthat/test-utils_plot.R @@ -13,6 +13,21 @@ make_utils_plot_data <- function() { ) } +make_utils_plot_multimodule_data <- function() { + tibble::tibble( + label = c("biomass", "biomass", "biomass", "biomass"), + estimate = c(100, 120, 80, 90), + module_name = c("TIME_SERIES", "TIME_SERIES", "AGE_SERIES", "AGE_SERIES"), + year = c(2000, 2001, 2000, 2001), + fleet = c("fleet_a", "fleet_a", "fleet_a", "fleet_a"), + age = c(1, 1, 1, 1), + season = c("spring", "spring", "spring", "spring"), + uncertainty = c(10, 10, 10, 10), + uncertainty_label = c("se", "se", "se", "se"), + era = c("time", "time", "time", "time") + ) +} + test_that("filter_data handles data frames and lists", { dat <- make_utils_plot_data() @@ -36,6 +51,37 @@ test_that("filter_data handles data frames and lists", { expect_setequal(unique(filtered_list$group_var), c("model_one", "model_two")) }) +test_that("filter_data uses the first module when selection is empty", { + testthat::local_mocked_bindings( + interactive = function() TRUE, + .package = "base" + ) + testthat::local_mocked_bindings( + select.list = function(...) character(0), + .package = "utils" + ) + + filtered <- filter_data( + dat = make_utils_plot_multimodule_data(), + label_name = "biomass", + geom = "line", + interactive = TRUE + ) + + expect_equal(unique(filtered$module_name), "TIME_SERIES") +}) + +test_that("filter_data uses the first module in non-interactive mode", { + filtered <- filter_data( + dat = make_utils_plot_multimodule_data(), + label_name = "biomass", + geom = "line", + interactive = FALSE + ) + + expect_equal(unique(filtered$module_name), "TIME_SERIES") +}) + test_that("plot_timeseries and plot_error return expected layers", { dat <- filter_data( dat = make_utils_plot_data(),