Merge pull request #32 from signaturescience/epiyearweek

week/year -> epiweek/epiyear

R/forecast.R

@@ -33,7 +33,7 @@
 #' library(ggplot2)
 #' theme_set(theme_classic())
 #' ilifor_us$ili_bound %>%
-#'  mutate(date=cdcfluview::mmwr_week_to_date(year, week)) %>%
+#'  mutate(date=cdcfluview::mmwr_week_to_date(epiyear, epiweek)) %>%
 #'  filter(date>"2021-03-01") %>%
 #'  ggplot(aes(date, ili)) +
 #'  geom_line(lwd=.3, alpha=.5) +
@@ -51,7 +51,7 @@
 #' library(ggplot2)
 #' theme_set(theme_classic())
 #' ilifor_st$ili_bound %>%
-#'   mutate(date=cdcfluview::mmwr_week_to_date(year, week)) %>%
+#'   mutate(date=cdcfluview::mmwr_week_to_date(epiyear, epiweek)) %>%
 #'   filter(date>"2021-08-01") %>%
 #'   ggplot(aes(date, ili, col=forecasted)) +
 #'   geom_line(lwd=.3) +
@@ -71,7 +71,7 @@ forecast_ili <- function(ilidat, horizon=4L, trim_date=NULL, constrained=TRUE) {
   # Select just the columns you care about, and call "ili" the measure you're using
   ilidat <-
     ilidat %>%
-    dplyr::select(location, year, week, ili=unweighted_ili)
+    dplyr::select(location, epiyear, epiweek, ili=unweighted_ili)
 
   # Get missing data rates
   locstats <- ilidat %>%
@@ -96,7 +96,7 @@ forecast_ili <- function(ilidat, horizon=4L, trim_date=NULL, constrained=TRUE) {
   ## make a tsibble. do not chop the last week - because this is weekly data we won't have an incomplete final week
   ilidat_tsibble <-
     ilidat %>%
-    make_tsibble(epiyear = year, epiweek = week, key=location, chop=FALSE)
+    make_tsibble(epiyear = epiyear, epiweek = epiweek, key=location, chop=FALSE)
 
   # Defaults to constrained, non-seasonal model.
   if (constrained) {
@@ -140,14 +140,14 @@ forecast_ili <- function(ilidat, horizon=4L, trim_date=NULL, constrained=TRUE) {
   # Get the next #horizon weeks in a tibble
   ili_future <- ili_forecast %>%
     tibble::as_tibble() %>%
-    dplyr::mutate(year=lubridate::epiyear(yweek)) %>%
-    dplyr::mutate(week=lubridate::epiweek(yweek)) %>%
-    dplyr::select(location, year, week, ili=.mean)
+    dplyr::mutate(epiyear=lubridate::epiyear(yweek)) %>%
+    dplyr::mutate(epiweek=lubridate::epiweek(yweek)) %>%
+    dplyr::select(location, epiyear, epiweek, ili=.mean)
 
   # bind the historical data to the new data
   ili_bound <- dplyr::bind_rows(ilidat     %>% dplyr::mutate(forecasted=FALSE),
                                 ili_future %>% dplyr::mutate(forecasted=TRUE)) %>%
-    dplyr::arrange(location, year, week) %>%
+    dplyr::arrange(location, epiyear, epiweek) %>%
     dplyr::inner_join(locations, by="location")
 
   # Create results

R/retrieve.R

@@ -106,7 +106,7 @@ get_hdgov_hosp <- function(endpoint="https://healthdata.gov/resource/g62h-syeh.j
 #' @references API documentation: <https://dev.socrata.com/foundry/data.cdc.gov/k87d-gv3u>.
 #' @examples
 #' \dontrun{
-#' d <- get_cdc_vax_data()
+#' d <- get_cdc_vax()
 #' d
 #' library(ggplot2)
 #' d %>%
@@ -183,14 +183,14 @@ get_cdc_ili <- function(region=c("national", "state"), years=NULL) {
   # Get only relevant columns (drop age group distributions)
   # Join to internal package data to get state abbreviations and FIPS codes
   d <- d %>%
-    dplyr::select(region_type, region, year, week, week_start, dplyr::contains("ili"), ilitotal:total_patients) %>%
+    dplyr::select(region_type, region, epiyear=year, epiweek=week, week_start, dplyr::contains("ili"), ilitotal:total_patients) %>%
     dplyr::mutate(region=gsub("National", "US", region)) %>%
     dplyr::inner_join(locations, by=c("region"="location_name")) %>%
     dplyr::select(location, region_type, abbreviation, region, dplyr::everything())
   message(sprintf("Latest week_start / year / epiweek available:\n%s / %d / %d",
                   max(d$week_start),
-                  unique(d$year[d$week_start==max(d$week_start)]),
-                  unique(d$week[d$week_start==max(d$week_start)])))
+                  unique(d$epiyear[d$week_start==max(d$week_start)]),
+                  unique(d$epiweek[d$week_start==max(d$week_start)])))
   return(d)
 }
 
@@ -211,16 +211,16 @@ get_cdc_hosp <- function(years=NULL) {
     dplyr::transmute(location="US",
                      abbreviation="US",
                      region="US",
-                     year,
-                     week=year_wk_num,
+                     epiyear=year,
+                     epiweek=year_wk_num,
                      week_start=wk_start,
                      week_end=wk_end,
                      rate,
                      weeklyrate,
                      season=sea_label)
   message(sprintf("Latest week_start / year / epiweek available:\n%s / %d / %d",
                   max(d$week_start),
-                  unique(d$year[d$week_start==max(d$week_start)]),
-                  unique(d$week[d$week_start==max(d$week_start)])))
+                  unique(d$epiyear[d$week_start==max(d$week_start)]),
+                  unique(d$epiweek[d$week_start==max(d$week_start)])))
   return(d)
 }

scratch/worfklow.R

@@ -22,7 +22,7 @@ ilifor$ili_bound %>% tail(8)
 # Plot actual versus forecasted values
 p.ili <-
   ilifor$ili_bound %>%
-  mutate(date=cdcfluview::mmwr_week_to_date(year, week)) %>%
+  mutate(date=cdcfluview::mmwr_week_to_date(epiyear, epiweek)) %>%
   ggplot(aes(date, ili)) +
   geom_line(alpha=.5, lwd=.2) +
   geom_point(aes(col=forecasted)) +
@@ -44,7 +44,7 @@ tmp_weekly_flu <-
             flu.admits.cov = sum(flu.admits.cov, na.rm = TRUE),
             .groups = "drop") %>%
   mutate(location = "US", .before = "epiweek") %>%
-  left_join(rename(ilifor$ilidat, epiweek = week, epiyear = year))
+  left_join(ilifor$ilidat, by = c("epiyear", "location", "epiweek"))
 
 ## add lag columns
 tmp_weekly_flu_w_lag <-
@@ -85,6 +85,7 @@ res$forecasts
 res$model
 
 p.hosp <- plot_forc(res$forecasts, train_dat, test_dat)
+p.hosp
 
 library(patchwork)
 p.ili / p.hosp