refactor reformat_epirange; add date_to_epiweek helper fn

Author: nmdefries

NAMESPACE

@@ -48,7 +48,9 @@ export(save_api_key)
 export(set_cache)
 import(cachem)
 import(glue)
+importFrom(MMWRweek,MMWRweek)
 importFrom(MMWRweek,MMWRweek2Date)
+importFrom(MMWRweek,MMWRyear)
 importFrom(checkmate,assert)
 importFrom(checkmate,assert_character)
 importFrom(checkmate,assert_integerish)
@@ -65,6 +67,7 @@ importFrom(checkmate,test_class)
 importFrom(checkmate,test_date)
 importFrom(checkmate,test_integerish)
 importFrom(checkmate,test_list)
+importFrom(glue,glue)
 importFrom(httr,RETRY)
 importFrom(httr,content)
 importFrom(httr,http_error)

R/endpoints.R

@@ -176,6 +176,7 @@ pub_covid_hosp_facility_lookup <- function(
 #' @return [`tibble::tibble`]
 #'
 #' @importFrom checkmate test_class test_integerish test_character
+#' @importFrom glue glue
 #'
 #' @seealso [`pub_covid_hosp_facility()`], [`epirange()`]
 #' @keywords endpoint
@@ -200,27 +201,20 @@ 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") && nchar(collection_weeks$to) == 6) {
-    cli::cli_warn(
-      c(
-        "`collection_weeks` {collection_weeks} is in week format but
-        `pub_covid_hosp_facility` expects day format; dates will be automatically
-        converted to day format"
-      ),
-      class = "epidatr__epirange_week_coercion"
+  coercion_msg <- glue::glue(
+    c(
+      "`collection_weeks` {collection_weeks} is in week format but
+    `pub_covid_hosp_facility` expects day format; dates will be automatically
+    converted to day format"
     )
-    collection_weeks <- convert_epirange_format(collection_weeks, to_type = "day")
+  )
+  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(
-      c(
-        "`collection_weeks` {collection_weeks} is in week format but
-        `pub_covid_hosp_facility` expects day format; dates will be automatically
-        converted to day format"
-      ),
-      class = "epidatr__single_week_coercion"
-    )
+    cli::cli_warn(coercion_msg, class = "epidatr__single_week_coercion")
     collection_weeks <- parse_api_week(collection_weeks)
   }
 

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 MMWRyear 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"))