From 4be1c3082fec0d7d7c3b24d602d54cdb9216df79 Mon Sep 17 00:00:00 2001 From: Dmitry Shemetov Date: Fri, 14 Nov 2025 16:47:32 -0800 Subject: [PATCH 1/8] enh: pub_covidcast errors when time_type not day or week * nssp errors when time_type not week --- R/endpoints.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/R/endpoints.R b/R/endpoints.R index e82a992..a682178 100644 --- a/R/endpoints.R +++ b/R/endpoints.R @@ -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( From 3b0e01cb4a0521bb0829f9b98536fe3ffc435884 Mon Sep 17 00:00:00 2001 From: Dmitry Shemetov Date: Fri, 14 Nov 2025 16:49:04 -0800 Subject: [PATCH 2/8] fix: pub_covidcast_meta doesn't null hsa_nci, doesn't cast time to avoid NA for week types * pub_covidcast doen't null hsa_nci --- R/endpoints.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/endpoints.R b/R/endpoints.R index a682178..2c3a314 100644 --- a/R/endpoints.R +++ b/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") ) @@ -1070,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 = From a9a038572915e7355dd74a9d0d42f33d5fd38336 Mon Sep 17 00:00:00 2001 From: Dmitry Shemetov Date: Fri, 14 Nov 2025 16:49:51 -0800 Subject: [PATCH 3/8] enh: checkmate some checks --- R/epidatacall.R | 19 ++++++++++++++----- R/model.R | 27 ++++++++++++--------------- 2 files changed, 26 insertions(+), 20 deletions(-) diff --git a/R/epidatacall.R b/R/epidatacall.R index cd3c06b..402b3a5 100644 --- a/R/epidatacall.R +++ b/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,15 @@ create_epidata_call <- function(endpoint, params, meta = NULL, ) } + # TODO: Something like this in the future? We set up the categories + # but we don't actually validate them yet? + # for (field in names(params)) { + # value <- params[[field]] + # if (meta[[field]]$type == "categorical") { + # checkmate::assert_subset(value, meta[[field]]$categories) + # } + # } + if (is.null(meta)) { meta <- list() } diff --git a/R/model.R b/R/model.R index 383c6ab..015ec8c 100644 --- a/R/model.R +++ b/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, From 0240e9d13b8244869bb96bd3d1f48fb8222098cd Mon Sep 17 00:00:00 2001 From: Dmitry Shemetov Date: Fri, 14 Nov 2025 17:06:49 -0800 Subject: [PATCH 4/8] enh: add reference_week_day arg to fetch_args_list --- R/epidatacall.R | 14 ++++++++++---- R/model.R | 13 +++++++------ 2 files changed, 17 insertions(+), 10 deletions(-) diff --git a/R/epidatacall.R b/R/epidatacall.R index 402b3a5..21925c1 100644 --- a/R/epidatacall.R +++ b/R/epidatacall.R @@ -164,7 +164,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 @@ -180,7 +183,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() @@ -194,6 +198,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( @@ -206,7 +211,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" ) @@ -279,7 +285,7 @@ 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() } }) diff --git a/R/model.R b/R/model.R index 015ec8c..0322cc7 100644 --- a/R/model.R +++ b/R/model.R @@ -163,7 +163,7 @@ 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)) { @@ -171,7 +171,7 @@ parse_value <- function(info, value, disable_date_parsing = FALSE) { } 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") { @@ -197,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) @@ -224,7 +224,7 @@ 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 @@ -251,14 +251,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 Saturday. #' @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 From 781eecd4452bc0e4218df4169557e1edac863e7d Mon Sep 17 00:00:00 2001 From: Dmitry Shemetov Date: Fri, 14 Nov 2025 17:08:49 -0800 Subject: [PATCH 5/8] doc: bump version and add NEWS entry --- DESCRIPTION | 2 +- NEWS.md | 17 +++++++++++++++++ 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index c32a613..f818e50 100644 --- a/DESCRIPTION +++ b/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"), diff --git a/NEWS.md b/NEWS.md index 38c3c8b..c263012 100644 --- a/NEWS.md +++ b/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. From 42b78677ba1d14c891ed72931c9722f902b041ae Mon Sep 17 00:00:00 2001 From: Dmitry Shemetov Date: Fri, 14 Nov 2025 17:16:21 -0800 Subject: [PATCH 6/8] fix: tests --- tests/testthat/test-epidatacall.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-epidatacall.R b/tests/testthat/test-epidatacall.R index 69f885b..e9096af 100644 --- a/tests/testthat/test-epidatacall.R +++ b/tests/testthat/test-epidatacall.R @@ -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" ) From c9f19fd5f0a0bdf3ea0c7591414dc75c7b6d2378 Mon Sep 17 00:00:00 2001 From: dsweber2 Date: Sun, 16 Nov 2025 13:48:16 -0600 Subject: [PATCH 7/8] docs update, fix linting warning --- R/epidatacall.R | 16 ++++++++-------- R/model.R | 7 ++++++- man/fetch_args_list.Rd | 7 ++++++- man/parse_api_week.Rd | 4 +++- 4 files changed, 23 insertions(+), 11 deletions(-) diff --git a/R/epidatacall.R b/R/epidatacall.R index 21925c1..c01066a 100644 --- a/R/epidatacall.R +++ b/R/epidatacall.R @@ -73,14 +73,9 @@ create_epidata_call <- function(endpoint, params, meta = NULL, ) } - # TODO: Something like this in the future? We set up the categories + # TODO: Check the categories in the future? We set up the categories # but we don't actually validate them yet? - # for (field in names(params)) { - # value <- params[[field]] - # if (meta[[field]]$type == "categorical") { - # checkmate::assert_subset(value, meta[[field]]$categories) - # } - # } + # use checkmate::assert_subset or something like that if (is.null(meta)) { meta <- list() @@ -285,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, fetch_args$reference_week_day) %>% as_tibble() + fetched <- parse_data_frame( + epidata_call, + response_content, + fetch_args$disable_date_parsing, + fetch_args$reference_week_day + ) %>% as_tibble() } }) diff --git a/R/model.R b/R/model.R index 0322cc7..4177fa8 100644 --- a/R/model.R +++ b/R/model.R @@ -224,7 +224,12 @@ parse_data_frame <- function(epidata_call, df, disable_date_parsing = FALSE, ref 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, reference_week_day = reference_week_day) + df[[info$name]] <- parse_value( + info, + df[[info$name]], + disable_date_parsing = disable_date_parsing, + reference_week_day = reference_week_day + ) } } df diff --git a/man/fetch_args_list.Rd b/man/fetch_args_list.Rd index 1701288..2275d42 100644 --- a/man/fetch_args_list.Rd +++ b/man/fetch_args_list.Rd @@ -16,7 +16,8 @@ fetch_args_list( dry_run = FALSE, debug = FALSE, format_type = c("json", "classic", "csv"), - refresh_cache = FALSE + refresh_cache = FALSE, + reference_week_day = 1 ) } \arguments{ @@ -52,6 +53,10 @@ csv; this is only used by \code{fetch_debug}, and by default is \code{"json"}} \item{refresh_cache}{if \code{TRUE}, ignore the cache, fetch the data from the API, and update the cache, if it is enabled} + +\item{reference_week_day}{the day of the week to use as the reference day +when parsing epiweeks to dates (happens if \code{disable_date_parsing} is \code{FALSE}) +Defaults to 1 Sunday (the first day of the week).} } \value{ A \code{fetch_args} object containing all the specified options diff --git a/man/parse_api_week.Rd b/man/parse_api_week.Rd index a877d21..1cf5e83 100644 --- a/man/parse_api_week.Rd +++ b/man/parse_api_week.Rd @@ -4,10 +4,12 @@ \alias{parse_api_week} \title{parse_api_week converts an integer to a date} \usage{ -parse_api_week(value) +parse_api_week(value, reference_week_day = 1) } \arguments{ \item{value}{value to be converted to an epiweek} + +\item{reference_week_day}{the day of the week to use as the reference day. Defaults to Saturday.} } \value{ a date From 9b53a5e9352a0bd0d71b44d86ee8dc61f4bbff88 Mon Sep 17 00:00:00 2001 From: dsweber2 Date: Sun, 16 Nov 2025 14:17:24 -0600 Subject: [PATCH 8/8] test day of week, correct docs --- R/model.R | 2 +- man/parse_api_week.Rd | 2 +- tests/testthat/test-model.R | 6 ++++++ 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/R/model.R b/R/model.R index 4177fa8..3de76db 100644 --- a/R/model.R +++ b/R/model.R @@ -256,7 +256,7 @@ 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 Saturday. +#' @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 diff --git a/man/parse_api_week.Rd b/man/parse_api_week.Rd index 1cf5e83..9a78ef5 100644 --- a/man/parse_api_week.Rd +++ b/man/parse_api_week.Rd @@ -9,7 +9,7 @@ parse_api_week(value, reference_week_day = 1) \arguments{ \item{value}{value to be converted to an epiweek} -\item{reference_week_day}{the day of the week to use as the reference day. Defaults to Saturday.} +\item{reference_week_day}{the day of the week to use as the reference day. Defaults to Sunday.} } \value{ a date diff --git a/tests/testthat/test-model.R b/tests/testthat/test-model.R index 5444eb5..10d2b48 100644 --- a/tests/testthat/test-model.R +++ b/tests/testthat/test-model.R @@ -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)