More tests, ... tidyselect, doc as_epi_df, more values

R/archive.R

@@ -453,8 +453,9 @@ as_epi_archive <- function(
     additional_metadata = NULL,
     compactify = NULL,
     clobberable_versions_start = NULL,
-    versions_end = NULL) {
+    versions_end = NULL, ...) {
   assert_data_frame(x)
+  x <- rename(x, ...)
   x <- guess_time_column_name(x)
   x <- guess_geo_column_name(x)
   x <- guess_version_column_name(x)

R/epi_df.R

@@ -249,12 +249,16 @@ as_epi_df.epi_df <- function(x, ...) {
 
 #' @method as_epi_df tbl_df
 #' @describeIn as_epi_df The input tibble `x` must contain the columns
-#'   `geo_value` and `time_value`. All other columns will be preserved as is,
-#'   and treated as measured variables. If `as_of` is missing, then the function
-#'   will try to guess it from an `as_of`, `issue`, or `version` column of `x`
-#'   (if any of these are present), or from as an `as_of` field in its metadata
-#'   (stored in its attributes); if this fails, then the current day-time will
-#'   be used.
+#'   `geo_value` and `time_value`, or column names that uniquely map onto these
+#'   (e.g. `date` or `province`). Alternatively, you can specify the conversion
+#'   explicitly (`time_value = someWeirdColumnName`). All other columns not
+#'   specified as `other_keys` will be preserved as is, and treated as measured
+#'   variables.
+#'
+#'  If `as_of` is missing, then the function will try to guess it from an
+#'   `as_of`, `issue`, or `version` column of `x` (if any of these are present),
+#'   or from as an `as_of` field in its metadata (stored in its attributes); if
+#'   this fails, then the current day-time will be used.
 #' @importFrom rlang .data
 #' @importFrom tidyselect any_of
 #' @importFrom cli cli_inform
@@ -263,11 +267,12 @@ as_epi_df.tbl_df <- function(x, geo_type, time_type, as_of,
                              additional_metadata = list(),
                              ...) {
   # possible standard substitutions for time_value
+  x <- rename(x, ...)
   x <- guess_time_column_name(x)
   x <- guess_geo_column_name(x)
   if (!test_subset(c("geo_value", "time_value"), names(x))) {
     cli_abort(
-      "Columns `geo_value` and `time_value` must be present in `x`."
+      "Either columns `geo_value` and `time_value` must be present in `x`, or related columns (see the internal functions `guess_time_column_name()` and/or `guess_geo_column_name()` for a complete list)."
     )
   }
 

R/utils.R

@@ -459,7 +459,7 @@ upcase_snake_case <- function(x) {
   c(x, X)
 }
 
-#' given an arbitrary
+#' rename potential time_value columns
 #' @keywords internal
 guess_time_column_name <- function(x, substitutions = NULL) {
   if (!("time_value" %in% names(x))) {
@@ -473,12 +473,14 @@ guess_time_column_name <- function(x, substitutions = NULL) {
         time_value = "forecast_date",
         time_value = "target_date",
         time_value = "week",
-        time_value = "day",
         time_value = "epiweek",
         time_value = "month",
+        time_value = "mon",
         time_value = "year",
         time_value = "yearmon",
+        time_value = "yearmonth",
         time_value = "yearMon",
+        time_value = "yearMonth",
         time_value = "dates",
         time_value = "time_values",
         time_value = "forecast_dates",
@@ -495,7 +497,9 @@ guess_time_column_name <- function(x, substitutions = NULL) {
 Either `rename` some yourself or drop some.")
       }
     )
-    cli_inform("inferring `time_value` column.")
+    if (any(substitutions != "")) {
+      cli_inform("inferring `time_value` column.")
+    }
   }
   return(x)
 }
@@ -529,7 +533,9 @@ guess_geo_column_name <- function(x, substitutions = NULL) {
 Either `rename` some yourself or drop some.")
       }
     )
-    cli_inform("inferring `time_value` column.")
+    if (any(substitutions != "")) {
+      cli_inform("inferring `geo_value` column.")
+    }
   }
   return(x)
 }
@@ -545,11 +551,13 @@ guess_version_column_name <- function(x, substitutions = NULL) {
     }
     x <- tryCatch(x %>% rename(any_of(substitutions)),
       error = function(cond) {
-        cli_abort("There are multiple `geo_value` candidate columns.
+        cli_abort("There are multiple `version` candidate columns.
 Either `rename` some yourself or drop some.")
       }
     )
-    cli_inform("inferring `time_value` column.")
+    if (any(substitutions != "")) {
+      cli_inform("inferring `version` column.")
+    }
   }
   return(x)
 }

tests/testthat/test-epi_df.R

@@ -53,6 +53,13 @@ test_that("as_epi_df works for nonstandard input", {
     geo_value = rep(c("ca", "hi"), each = 5)
   )
   expect_message(expect_no_error(tib_epi_df <- tib %>% as_epi_df()))
+  expect_no_error(tib_epi_df <- tib %>% as_epi_df(time_value = date, geo_value = geo_value))
+  expect_error(expect_message(
+    tib %>% rename(awefa = geo_value) %>% as_epi_df(),
+  regexp = "inferring `time_value` column."))
+  expect_no_error(expect_message(
+    tib %>% rename(awefa = geo_value) %>% as_epi_df(geo_value = awefa),
+  regexp = "inferring `time_value` column."))
 
   tib <- tib %>% rename(forecast_date = date)
   expect_message(expect_no_error(tib_epi_df <- tib %>% as_epi_df()))