Merge pull request #326 from cmu-delphi/ds/parse-week

hotfix: epiweeks handling and hsa_nci

Author: dsweber2

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: epidatr
 Title: Client for Delphi's 'Epidata' API
-Version: 1.2.1
+Version: 1.2.2
 Authors@R: c(
     person("Logan", "Brooks", , "lcbrooks@andrew.cmu.edu", role = "aut"),
     person("Dmitry", "Shemetov", , "dshemeto@andrew.cmu.edu", role = "aut"),

NEWS.md

@@ -1,4 +1,21 @@
+# epidatr 1.2.2
+
+## Changes
+
+- Add `reference_week_day` argument to `fetch_args_list` and `fetch` functions.
+
+## Patches
+
+- Validate that `time_type` is one of "day" or "week" in `pub_covidcast`.
+- Validate that `time_type` is "week" when source is "nssp" in `pub_covidcast`.
+- Allow `hsa_nci` as a `geo_type` in `pub_covidcast`.
+- Allow `hsa_nci` as a `geo_type` in `pub_covidcast_meta`.
+- `pub_covidcast_meta` now returns `min_time`, `max_time`, `max_issue` as
+  integers rather than Dates. Because these fields can mix YYYYMMDD and YYYYWW
+  values, we recommend you parse them yourself.
+
 # epidatr 1.2.1
+
 ## Patches
 - Fix so that `covidcast_epidata()` will still print if fields are missing.
 

R/endpoints.R

@@ -910,17 +910,17 @@ pub_covidcast_meta <- function(fetch_args = fetch_args_list()) {
       create_epidata_field_info(
         "geo_type",
         "categorical",
-        categories = c("nation", "msa", "hrr", "hhs", "state", "county", "dma")
+        categories = c("nation", "msa", "hrr", "hhs", "state", "county", "dma", "hsa_nci")
       ),
-      create_epidata_field_info("min_time", "date"),
-      create_epidata_field_info("max_time", "date"),
+      create_epidata_field_info("min_time", "int"),
+      create_epidata_field_info("max_time", "int"),
       create_epidata_field_info("num_locations", "int"),
       create_epidata_field_info("min_value", "float"),
       create_epidata_field_info("max_value", "float"),
       create_epidata_field_info("mean_value", "float"),
       create_epidata_field_info("stdev_value", "float"),
       create_epidata_field_info("last_update", "int"),
-      create_epidata_field_info("max_issue", "date"),
+      create_epidata_field_info("max_issue", "int"),
       create_epidata_field_info("min_lag", "int"),
       create_epidata_field_info("max_lag", "int")
     )
@@ -1040,6 +1040,17 @@ pub_covidcast <- function(
     )
   }
 
+  if (source == "nssp" && time_type != "week") {
+    cli::cli_abort(
+      "{source} data is only available at the week level",
+      class = "epidatr__nchs_week_only"
+    )
+  }
+
+  # TODO: This should probably be done in the create_epidata_call function. But
+  # this is a quick fix for now.
+  checkmate::assert_subset(time_type, c("day", "week"))
+
   create_epidata_call(
     "covidcast/",
     list(
@@ -1059,7 +1070,7 @@ pub_covidcast <- function(
       create_epidata_field_info(
         "geo_type",
         "categorical",
-        categories = c("nation", "msa", "hrr", "hhs", "state", "county")
+        categories = c("nation", "msa", "hrr", "hhs", "state", "county", "dma", "hsa_nci")
       ),
       create_epidata_field_info("time_type", "categorical",
         categories =

R/epidatacall.R

@@ -44,11 +44,11 @@
 #' @importFrom purrr map_chr map_lgl
 create_epidata_call <- function(endpoint, params, meta = NULL,
                                 only_supports_classic = FALSE) {
-  stopifnot(is.character(endpoint), length(endpoint) == 1)
-  stopifnot(is.list(params))
-  stopifnot(is.null(meta) || is.list(meta))
-  stopifnot(all(map_lgl(meta, ~ inherits(.x, "EpidataFieldInfo"))))
-  stopifnot(is.logical(only_supports_classic), length(only_supports_classic) == 1)
+  checkmate::assert_character(endpoint, len = 1)
+  checkmate::assert_list(params)
+  checkmate::assert_list(meta, null.ok = TRUE)
+  checkmate::assert_logical(only_supports_classic, len = 1)
+  checkmate::assert_true(all(map_lgl(meta, ~ inherits(.x, "EpidataFieldInfo"))))
 
   if (length(unique(meta)) != length(meta)) {
     cli::cli_abort(
@@ -73,6 +73,10 @@ create_epidata_call <- function(endpoint, params, meta = NULL,
     )
   }
 
+  # TODO: Check the categories in the future? We set up the categories
+  # but we don't actually validate them yet?
+  # use checkmate::assert_subset or something like that
+
   if (is.null(meta)) {
     meta <- list()
   }
@@ -155,7 +159,10 @@ print.epidata_call <- function(x, ...) {
 #' @param format_type the format to request from the API, one of classic, json,
 #'   csv; this is only used by `fetch_debug`, and by default is `"json"`
 #' @param refresh_cache if `TRUE`, ignore the cache, fetch the data from the
-#' API, and update the cache, if it is enabled
+#'   API, and update the cache, if it is enabled
+#' @param reference_week_day the day of the week to use as the reference day
+#'   when parsing epiweeks to dates (happens if `disable_date_parsing` is `FALSE`)
+#'   Defaults to 1 Sunday (the first day of the week).
 #' @return A `fetch_args` object containing all the specified options
 #' @export
 #' @aliases fetch_args
@@ -171,7 +178,8 @@ fetch_args_list <- function(
   dry_run = FALSE,
   debug = FALSE,
   format_type = c("json", "classic", "csv"),
-  refresh_cache = FALSE
+  refresh_cache = FALSE,
+  reference_week_day = 1
 ) {
   rlang::check_dots_empty()
 
@@ -185,6 +193,7 @@ fetch_args_list <- function(
   assert_logical(debug, null.ok = FALSE, len = 1L, any.missing = FALSE)
   format_type <- match.arg(format_type)
   assert_logical(refresh_cache, null.ok = FALSE, len = 1L, any.missing = FALSE)
+  assert_numeric(reference_week_day, null.ok = FALSE, len = 1L, any.missing = FALSE)
 
   structure(
     list(
@@ -197,7 +206,8 @@ fetch_args_list <- function(
       dry_run = dry_run,
       debug = debug,
       format_type = format_type,
-      refresh_cache = refresh_cache
+      refresh_cache = refresh_cache,
+      reference_week_day = reference_week_day
     ),
     class = "fetch_args"
   )
@@ -270,7 +280,12 @@ fetch <- function(epidata_call, fetch_args = fetch_args_list()) {
     if (fetch_args$return_empty && length(response_content) == 0) {
       fetched <- tibble()
     } else {
-      fetched <- parse_data_frame(epidata_call, response_content, fetch_args$disable_date_parsing) %>% as_tibble()
+      fetched <- parse_data_frame(
+        epidata_call,
+        response_content,
+        fetch_args$disable_date_parsing,
+        fetch_args$reference_week_day
+      ) %>% as_tibble()
     }
   })
 

R/model.R

@@ -132,21 +132,18 @@ create_epidata_field_info <- function(name,
                                       type,
                                       description = "",
                                       categories = c()) {
-  stopifnot(is.character(name) && length(name) == 1)
-  stopifnot(
-    is.character(type) &&
-      length(type) == 1 &&
-      type %in% c(
-        "text",
-        "int",
-        "float",
-        "date",
-        "epiweek",
-        "categorical",
-        "bool"
-      )
-  )
-  stopifnot(is.character(description) && length(description) == 1)
+  checkmate::assert_character(name, len = 1)
+  checkmate::assert_character(type, len = 1)
+  checkmate::assert_subset(type, c(
+    "text",
+    "int",
+    "float",
+    "date",
+    "epiweek",
+    "categorical",
+    "bool"
+  ))
+  checkmate::assert_character(description, len = 1)
   structure(
     list(
       name = name,
@@ -166,15 +163,15 @@ print.EpidataFieldInfo <- function(x, ...) {
 }
 
 #' @importFrom stats na.omit
-parse_value <- function(info, value, disable_date_parsing = FALSE) {
+parse_value <- function(info, value, disable_date_parsing = FALSE, reference_week_day = 1) {
   stopifnot(inherits(info, "EpidataFieldInfo"))
 
   if (is.null(value)) {
     return(value)
   } else if (info$type == "date" && !disable_date_parsing && !inherits(value, "Date")) {
     return(parse_api_date(value))
   } else if (info$type == "epiweek" && !disable_date_parsing && !inherits(value, "Date")) {
-    return(parse_api_week(value))
+    return(parse_api_week(value, reference_week_day = reference_week_day))
   } else if (info$type == "bool") {
     return(as.logical(value))
   } else if (info$type == "int") {
@@ -200,7 +197,7 @@ parse_value <- function(info, value, disable_date_parsing = FALSE) {
 }
 
 #' @importFrom purrr map_chr
-parse_data_frame <- function(epidata_call, df, disable_date_parsing = FALSE) {
+parse_data_frame <- function(epidata_call, df, disable_date_parsing = FALSE, reference_week_day = 1) {
   stopifnot(inherits(epidata_call, "epidata_call"))
   meta <- epidata_call$meta
   df <- as.data.frame(df)
@@ -227,7 +224,12 @@ parse_data_frame <- function(epidata_call, df, disable_date_parsing = FALSE) {
   for (i in seq_len(length(meta))) {
     info <- meta[[i]]
     if (info$name %in% columns) {
-      df[[info$name]] <- parse_value(info, df[[info$name]], disable_date_parsing = disable_date_parsing)
+      df[[info$name]] <- parse_value(
+        info,
+        df[[info$name]],
+        disable_date_parsing = disable_date_parsing,
+        reference_week_day = reference_week_day
+      )
     }
   }
   df
@@ -254,14 +256,15 @@ parse_api_date <- function(value) {
 
 #' parse_api_week converts an integer to a date
 #' @param value value to be converted to an epiweek
+#' @param reference_week_day the day of the week to use as the reference day. Defaults to Sunday.
 #' @return a date
 #' @importFrom MMWRweek MMWRweek2Date
 #' @keywords internal
-parse_api_week <- function(value) {
+parse_api_week <- function(value, reference_week_day = 1) {
   v <- as.integer(value)
   years <- floor(v / 100)
   weeks <- v - (years * 100)
-  MMWRweek::MMWRweek2Date(years, weeks)
+  MMWRweek::MMWRweek2Date(years, weeks, MMWRday = reference_week_day)
 }
 
 #' @importFrom checkmate test_character test_class test_date test_integerish test_list

man/fetch_args_list.Rd

@@ -43,7 +43,8 @@ test_that("fetch_args", {
         dry_run = FALSE,
         debug = FALSE,
         format_type = "json",
-        refresh_cache = FALSE
+        refresh_cache = FALSE,
+        reference_week_day = 1
       ),
       class = "fetch_args"
     )
@@ -59,7 +60,8 @@ test_that("fetch_args", {
       dry_run = TRUE,
       debug = TRUE,
       format_type = "classic",
-      refresh_cache = TRUE
+      refresh_cache = TRUE,
+      reference_week_day = 1
     ),
     structure(
       list(
@@ -72,7 +74,8 @@ test_that("fetch_args", {
         dry_run = TRUE,
         debug = TRUE,
         format_type = "classic",
-        refresh_cache = TRUE
+        refresh_cache = TRUE,
+        reference_week_day = 1
       ),
       class = "fetch_args"
     )

man/parse_api_week.Rd

@@ -148,6 +148,12 @@ test_that("parse_api_date handles missing values appropriately", {
   expect_identical(parse_api_date(NA), as.Date(NA))
 })
 
+test_that("parse_api_week returns the expected day of the week", {
+  expect_identical(parse_api_week(202005) %>% weekdays(), "Sunday")
+  expect_identical(parse_api_week(202005, 4) %>% weekdays(), "Wednesday")
+  expect_identical(parse_api_week(202005, 7) %>% weekdays(), "Saturday")
+})
+
 test_that("date_to_epiweek accepts str and int input", {
   expect_identical(date_to_epiweek("20200101"), 202001)
   expect_identical(date_to_epiweek(20200101), 202001)