warn about week conversion; handle single week date

refactor reformat_epirange; add date_to_epiweek helper fn

better collection_weeks message

Author: nmdefries

NAMESPACE

@@ -48,6 +48,7 @@ export(save_api_key)
 export(set_cache)
 import(cachem)
 import(glue)
+importFrom(MMWRweek,MMWRweek)
 importFrom(MMWRweek,MMWRweek2Date)
 importFrom(checkmate,assert)
 importFrom(checkmate,assert_character)

R/endpoints.R

@@ -175,7 +175,7 @@ pub_covid_hosp_facility_lookup <- function(
 #' @param fetch_args [`fetch_args`]. Additional arguments to pass to `fetch()`.
 #' @return [`tibble::tibble`]
 #'
-#' @importFrom checkmate test_class
+#' @importFrom checkmate test_class test_integerish test_character
 #'
 #' @seealso [`pub_covid_hosp_facility()`], [`epirange()`]
 #' @keywords endpoint
@@ -200,8 +200,19 @@ pub_covid_hosp_facility <- function(
   # Confusingly, the endpoint expects `collection_weeks` to be in day format,
   # but correspond to epiweeks. Allow `collection_weeks` to be provided in
   # either day or week format.
-  if (test_class(collection_weeks, "EpiRange")) {
-    collection_weeks <- convert_epirange_format(collection_weeks, to_type = "day")
+  coercion_msg <- c(
+    "`collection_weeks` is in week format but `pub_covid_hosp_facility`
+       expects day format; dates will be converted to day format but may not
+       correspond exactly to desired time range"
+  )
+  if (test_class(collection_weeks, "EpiRange") && nchar(collection_weeks$from) == 6) {
+    cli::cli_warn(coercion_msg, class = "epidatr__epirange_week_coercion")
+    collection_weeks <- reformat_epirange(collection_weeks, to_type = "day")
+    # Single week date.
+  } else if ((test_integerish(collection_weeks) || test_character(collection_weeks)) &&
+    nchar(collection_weeks) == 6) {
+    cli::cli_warn(coercion_msg, class = "epidatr__single_week_coercion")
+    collection_weeks <- parse_api_week(collection_weeks)
   }
 
   create_epidata_call(

R/model.R

@@ -64,30 +64,17 @@ epirange <- function(from, to) {
 #' helper to reformat an epirange from week to day or vice versa
 #'
 #' @keywords internal
-convert_epirange_format <- function(epirange, to_type = c("day", "week")) {
+reformat_epirange <- function(epirange, to_type = c("day", "week")) {
   to_type <- match.arg(to_type)
 
-  # Day format
-  if (nchar(epirange$from) == 8) {
-    if (to_type == "week") {
-      from_components <- MMWRweek::MMWRweek(as.Date(as.character(epirange$from), "%Y%m%d"))
-      to_components <- MMWRweek::MMWRweek(as.Date(as.character(epirange$to), "%Y%m%d"))
-
-      epirange$from <- as.numeric(paste0(
-        from_components$MMWRyear,
-        formatC(from_components$MMWRweek, width = 2, flag = 0)
-      ))
-      epirange$to <- as.numeric(paste0(
-        to_components$MMWRyear,
-        formatC(to_components$MMWRweek, width = 2, flag = 0)
-      ))
-    }
-  # Week format
-  } else {
-    if (to_type == "day") {
-      epirange$from <- parse_api_week(epirange$from)
-      epirange$to <- parse_api_week(epirange$to)
-    }
+  # Day format -> week
+  if (nchar(epirange$from) == 8 && to_type == "week") {
+    epirange$from <- date_to_epiweek(epirange$from)
+    epirange$to <- date_to_epiweek(epirange$to)
+    # Week format -> day
+  } else if (nchar(epirange$from) == 6 && to_type == "day") {
+    epirange$from <- parse_api_week(epirange$from)
+    epirange$to <- parse_api_week(epirange$to)
   }
 
   return(epirange)
@@ -203,6 +190,20 @@ parse_data_frame <- function(epidata_call, df, disable_date_parsing = FALSE) {
   df
 }
 
+#' Converts a date (integer or character) to an epiweek
+#' @param value date (integer or character, with format YYYYMMDD) to be converted to an epiweek
+#' @return an integer representing an epiweek, in the format YYYYWW
+#' @importFrom MMWRweek MMWRweek
+#' @keywords internal
+date_to_epiweek <- function(value) {
+  date_components <- MMWRweek::MMWRweek(as.Date(as.character(value), "%Y%m%d"))
+  as.numeric(paste0(
+    date_components$MMWRyear,
+    # Pad with zeroes up to 2 digits (x -> 0x)
+    formatC(date_components$MMWRweek, width = 2, flag = 0)
+  ))
+}
+
 #' @keywords internal
 parse_api_date <- function(value) {
   as.Date(as.character(value), tryFormats = c("%Y%m%d", "%Y-%m-%d"))