pub_covid_hosp_facility supports epiweeks and days

`pub_covid_hosp_facility` says and implies it takes weeks for the arg `collection_weeks`, but it actually only takes days (corresponding to weeks)
and will error if given weeks. Given the misleading name and behavior,
and differing behavior compared to other endpoints with weekly data,
allow users to supply weeks -- these will be converted to dates.

Author: nmdefries

R/endpoints.R

@@ -161,14 +161,22 @@ pub_covid_hosp_facility_lookup <- function(
 #'   hospital_pks = "100075",
 #'   collection_weeks = epirange(20200101, 20200501)
 #' )
+#'
+#' pub_covid_hosp_facility(
+#'   hospital_pks = "100075",
+#'   collection_weeks = epirange(202001, 202005)
+#' )
 #' }
 #' @param hospital_pks character. Facility identifiers.
-#' @param collection_weeks [`timeset`]. Epiweeks to fetch. Defaults to all ("*") dates.
+#' @param collection_weeks [`timeset`]. Dates (corresponding to epiweeks) to
+#'  fetch. Defaults to all ("*") dates.
 #' @param ... not used for values, forces later arguments to bind by name
 #' @param publication_dates [`timeset`]. Publication dates to fetch.
 #' @param fetch_args [`fetch_args`]. Additional arguments to pass to `fetch()`.
 #' @return [`tibble::tibble`]
 #'
+#' @importFrom checkmate test_class
+#'
 #' @seealso [`pub_covid_hosp_facility()`], [`epirange()`]
 #' @keywords endpoint
 #' @export
@@ -181,14 +189,21 @@ pub_covid_hosp_facility <- function(
     fetch_args = fetch_args_list()) {
   rlang::check_dots_empty()
 
-  collection_weeks <- get_wildcard_equivalent_dates(collection_weeks, "week")
+  collection_weeks <- get_wildcard_equivalent_dates(collection_weeks, "day")
 
   assert_character_param("hospital_pks", hospital_pks)
   assert_timeset_param("collection_weeks", collection_weeks)
   assert_timeset_param("publication_dates", publication_dates, required = FALSE)
   collection_weeks <- parse_timeset_input(collection_weeks)
   publication_dates <- parse_timeset_input(publication_dates)
 
+  # 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")
+  }
+
   create_epidata_call(
     "covid_hosp_facility/",
     list(
@@ -1047,6 +1062,7 @@ pub_covidcast <- function(
 #' }
 #' @param system character. System name to fetch.
 #' @param epiweek [`timeset`]. Epiweek to fetch. Does not support multiple dates.
+#'  Make separate calls to fetch data for multiple epiweeks.
 #' @param fetch_args [`fetch_args`]. Additional arguments to pass to `fetch()`.
 #' @return [`list`]
 #' @keywords endpoint

R/model.R

@@ -61,6 +61,37 @@ epirange <- function(from, to) {
   structure(list(from = from, to = to), class = "EpiRange")
 }
 
+#' helper to reformat an epirange from week to day or vice versa
+#'
+#' @keywords internal
+convert_epirange_format <- 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)
+    }
+  }
+
+  return(epirange)
+}
 
 #' Timeset formats for specifying dates
 #'