diff --git a/R/autoplot.R b/R/autoplot.R index c193e01f..34bf55e0 100644 --- a/R/autoplot.R +++ b/R/autoplot.R @@ -58,33 +58,37 @@ autoplot.epi_df <- function( # --- check for numeric variables allowed <- purrr::map_lgl(object[non_key_cols], is.numeric) allowed <- allowed[allowed] - if (length(allowed) == 0) { - cli::cli_abort("No numeric variables were available to plot automatically.") + if (length(allowed) == 0 && rlang::dots_n(...) == 0L) { + cli::cli_abort("No numeric variables were available to plot automatically.", + class = "epiprocess__no_numeric_vars_available") } vars <- tidyselect::eval_select(rlang::expr(c(...)), object) if (rlang::is_empty(vars)) { # find them automatically if unspecified vars <- tidyselect::eval_select(names(allowed)[1], object) cli::cli_warn( - "Plot variable was unspecified. Automatically selecting {.var {names(allowed)[1]}}." + "Plot variable was unspecified. Automatically selecting {.var {names(allowed)[1]}}.", + class = "epiprocess__unspecified_plot_var" ) } else { # if variables were specified, ensure that they are numeric ok <- names(vars) %in% names(allowed) if (!any(ok)) { cli::cli_abort( - "None of the requested variables {.var {names(vars)}} are numeric." + "None of the requested variables {.var {names(vars)}} are numeric.", + class = "epiprocess__all_requested_vars_not_numeric" ) } else if (!all(ok)) { cli::cli_warn(c( "Only the requested variables {.var {names(vars)[ok]}} are numeric.", i = "`autoplot()` cannot display {.var {names(vars)[!ok]}}." - )) + ), + class = "epiprocess__some_requested_vars_not_numeric") vars <- vars[ok] } } # --- create a viable df to plot pos <- tidyselect::eval_select( - rlang::expr(c("time_value", geo_and_other_keys, names(vars))), object + rlang::expr(c("time_value", tidyselect::all_of(geo_and_other_keys), names(vars))), object ) if (length(vars) > 1) { object <- tidyr::pivot_longer( diff --git a/R/utils-arg.R b/R/utils-arg.R deleted file mode 100644 index b48a3642..00000000 --- a/R/utils-arg.R +++ /dev/null @@ -1,73 +0,0 @@ -handle_arg_list <- function(..., tests) { - values <- list(...) - names <- eval(substitute(alist(...))) - names <- purrr::map(names, deparse) - - purrr::walk2(names, values, tests) -} - -arg_is_scalar <- function(..., allow_null = FALSE, allow_na = FALSE) { - handle_arg_list( - ..., - tests = function(name, value) { - if (length(value) > 1 | (!allow_null & length(value) == 0)) { - cli::cli_abort("Argument {.val {name}} must be of length 1.") - } - if (!is.null(value)) { - if (is.na(value) & !allow_na) { - cli::cli_abort( - "Argument {.val {name}} must not be a missing value ({.val {NA}})." - ) - } - } - } - ) -} - -arg_is_numeric <- function(..., allow_null = FALSE) { - handle_arg_list( - ..., - tests = function(name, value) { - if (!(is.numeric(value) | (is.null(value) & allow_null))) { - cli::cli_abort("All {.val {name}} must numeric.") - } - } - ) -} - -arg_is_int <- function(..., allow_null = FALSE) { - arg_is_numeric(..., allow_null = allow_null) - handle_arg_list( - ..., - tests = function(name, value) { - if (!(all(value %% 1 == 0) | (is.null(value) & allow_null))) { - cli::cli_abort("All {.val {name}} must be whole positive number(s).") - } - } - ) -} - -arg_is_chr <- function(..., allow_null = FALSE, allow_na = FALSE, allow_empty = FALSE) { - handle_arg_list( - ..., - tests = function(name, value) { - if (is.null(value) & !allow_null) { - cli::cli_abort("Argument {.val {name}} may not be `NULL`.") - } - if (any(is.na(value)) & !allow_na) { - cli::cli_abort("Argument {.val {name}} must not contain any missing values ({.val {NA}}).") - } - if (!is.null(value) & (length(value) == 0L & !allow_empty)) { - cli::cli_abort("Argument {.val {name}} must have length > 0.") - } - if (!(is.character(value) | is.null(value) | all(is.na(value)))) { - cli::cli_abort("Argument {.val {name}} must be of character type.") - } - } - ) -} - -arg_is_chr_scalar <- function(..., allow_null = FALSE, allow_na = FALSE) { - arg_is_chr(..., allow_null = allow_null, allow_na = allow_na) - arg_is_scalar(..., allow_null = allow_null, allow_na = allow_na) -} diff --git a/tests/testthat/test-autoplot.R b/tests/testthat/test-autoplot.R new file mode 100644 index 00000000..ba3f8d53 --- /dev/null +++ b/tests/testthat/test-autoplot.R @@ -0,0 +1,87 @@ +library(dplyr) + +d <- as.Date("2020-01-01") + +raw_df_chr <- dplyr::bind_rows( + dplyr::tibble(geo_value = "ak", time_value = d + 1:5, value = "a"), + dplyr::tibble(geo_value = "al", time_value = d + 1:5, value = "d") +) +ungrouped_chr <- as_epi_df(raw_df_chr, as_of = d + 6) +grouped_chr <- ungrouped_chr %>% + group_by(geo_value) + +raw_df_num <- dplyr::bind_rows( + dplyr::tibble(geo_value = "ak", time_value = d + 1:5, value = 11:15), + dplyr::tibble(geo_value = "al", time_value = d + 1:5, value = 1:5) +) +ungrouped_num <- as_epi_df(raw_df_num, as_of = d + 6) +grouped_num <- ungrouped_num %>% + group_by(geo_value) + +test_that("autoplot fails if no non-key columns are numeric", { + expect_error(autoplot(ungrouped_chr), + class = "epiprocess__no_numeric_vars_available" + ) + + # Multiple non-numeric columns + testdf <- mutate(ungrouped_chr, value2 = "d") + expect_error(autoplot(testdf), + class = "epiprocess__no_numeric_vars_available" + ) + + expect_error(autoplot(grouped_chr), + class = "epiprocess__no_numeric_vars_available" + ) + + # A numeric column is available, but is a key not a value. + testdf <- mutate(raw_df_chr, key1 = c(1:5, 5:9)) %>% + as_tsibble(index = time_value, key = c(geo_value, key1)) %>% + as_epi_df(as_of = d + 6) + expect_error(autoplot(testdf), + class = "epiprocess__no_numeric_vars_available" + ) +}) + +test_that("autoplot warns when a variable is not specified, and lists the auto-selected column", { + expect_warning(autoplot(ungrouped_num), + regexp = ".*selecting `value`[.]", + class = "epiprocess__unspecified_plot_var" + ) + + expect_warning(autoplot(grouped_num), + regexp = ".*selecting `value`[.]", + class = "epiprocess__unspecified_plot_var" + ) +}) + +test_that("autoplot errors when all specified columns are not numeric, and lists column names", { + expect_error(autoplot(ungrouped_chr, value), + regexp = ".*value.*", + class = "epiprocess__all_requested_vars_not_numeric" + ) + + testdf <- mutate(ungrouped_chr, value2 = "d") + expect_error(autoplot(testdf, value, value2), + regexp = ".*variables `value` and `value2` are.*", + class = "epiprocess__all_requested_vars_not_numeric" + ) + + expect_error(autoplot(grouped_chr, value), + regexp = ".*variables `value` are.*", + class = "epiprocess__all_requested_vars_not_numeric" + ) +}) + +test_that("autoplot warns when some specified columns are not numeric, and lists column names", { + testdf <- mutate(ungrouped_num, value2 = "d") + expect_warning(autoplot(testdf, value, value2), + regexp = ".*`value` are numeric.*cannot display `value2`.*", + class = "epiprocess__some_requested_vars_not_numeric" + ) + + testdf <- mutate(grouped_num, value2 = "d") + expect_warning(autoplot(testdf, value, value2), + regexp = ".*`value` are numeric.*cannot display `value2`.*", + class = "epiprocess__some_requested_vars_not_numeric" + ) +})