enh: add reference_week_day arg to fetch_args_list

Author: dshemetov

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()
     }
   })
 

R/model.R

@@ -163,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") {
@@ -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