diff --git a/NAMESPACE b/NAMESPACE index 1362b15c..5d7f92ef 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -100,6 +100,7 @@ importFrom(checkmate,test_subset) importFrom(checkmate,vname) importFrom(cli,cat_line) importFrom(cli,cli_abort) +importFrom(cli,cli_inform) importFrom(cli,cli_vec) importFrom(cli,cli_warn) importFrom(cli,format_message) diff --git a/R/epi_df.R b/R/epi_df.R index f4df1604..6ac1b7db 100644 --- a/R/epi_df.R +++ b/R/epi_df.R @@ -256,9 +256,34 @@ as_epi_df.epi_df <- function(x, ...) { #' (stored in its attributes); if this fails, then the current day-time will #' be used. #' @importFrom rlang .data +#' @importFrom cli cli_inform #' @export as_epi_df.tbl_df <- function(x, geo_type, time_type, as_of, - additional_metadata = list(), ...) { + additional_metadata = list(), + substitutions = NULL, ...) { + # possible standard substitutions + if (!("time_value" %in% names(x))) { + if (("forecast_date" %in% names(x)) && ("target_date" %in% names(x))) { + cli_abort("both `forecast_date` and `target_date` are present without a `time_value` +column, so it is ambiguous which to choose as `time_value`.") + } + name_substitutions <- substitutions %||% c( + time_value = "date", + time_value = "forecast_date", + time_value = "target_date", + time_value = "dates", + time_value = "time_values", + time_value = "forecast_dates", + time_value = "target_dates" + ) + x <- tryCatch(x %>% rename(any_of(name_substitutions)), + error = function(cond) { + cli_abort("There are multiple `time_value` candidate columns. +Either `rename` on yourself or drop some.") + } + ) + cli_inform("inferring `time_value` column.") + } if (!test_subset(c("geo_value", "time_value"), names(x))) { cli_abort( "Columns `geo_value` and `time_value` must be present in `x`." diff --git a/man/as_epi_df.Rd b/man/as_epi_df.Rd index 40c0a1c5..82bd8882 100644 --- a/man/as_epi_df.Rd +++ b/man/as_epi_df.Rd @@ -12,7 +12,15 @@ as_epi_df(x, ...) \method{as_epi_df}{epi_df}(x, ...) -\method{as_epi_df}{tbl_df}(x, geo_type, time_type, as_of, additional_metadata = list(), ...) +\method{as_epi_df}{tbl_df}( + x, + geo_type, + time_type, + as_of, + additional_metadata = list(), + substitutions = NULL, + ... +) \method{as_epi_df}{data.frame}(x, geo_type, time_type, as_of, additional_metadata = list(), ...) diff --git a/tests/testthat/test-epi_df.R b/tests/testthat/test-epi_df.R index 8cfb4408..8ffc9820 100644 --- a/tests/testthat/test-epi_df.R +++ b/tests/testthat/test-epi_df.R @@ -46,6 +46,22 @@ test_that("as_epi_df errors when additional_metadata is not a list", { ) }) +test_that("as_epi_df works for nonstandard input", { + tib <- tibble::tibble( + x = 1:10, y = 1:10, + date = rep(seq(as.Date("2020-01-01"), by = 1, length.out = 5), times = 2), + geo_value = rep(c("ca", "hi"), each = 5) + ) + expect_message(expect_no_error(tib_epi_df <- tib %>% as_epi_df())) + + tib <- tib %>% rename(forecast_date = date) + expect_message(expect_no_error(tib_epi_df <- tib %>% as_epi_df())) + tib %>% rename(any_of(name_substitutions)) + + tib <- tib %>% mutate(target_date = 20 + forecast_date) + expect_error(tib_epi_df <- tib %>% as_epi_df()) +}) + # select fixes tib <- tibble::tibble(