forecast_generation_date -> forecast_date

Author: dsweber2

scripts/covid_hosp_prod.R

@@ -7,7 +7,8 @@ insufficient_data_geos <- c("as", "mp", "vi", "gu")
 # date to cut the truth data off at, so we don't have too much of the past
 truth_data_date <- "2023-09-01"
 # Generically set the generation date to the next Wednesday (or today if it's Wednesday)
-forecast_generation_date <- seq.Date(as.Date("2024-11-20"), Sys.Date(), by = 7L)
+forecast_generation_date <- Sys.Date()
+forecast_date <- seq.Date(as.Date("2024-11-20"), Sys.Date(), by = 7L)
 
 forecaster_fns <- list2(
   linear = function(...) {
@@ -58,16 +59,16 @@ rlang::list2(
   tar_map(
     values = tidyr::expand_grid(
       tibble(
-        forecast_generation_date = forecast_generation_date
+        forecast_date = forecast_date
       )
     ),
-    names = "forecast_generation_date",
+    names = "forecast_date",
     tar_target(
       name = geo_forecasters_weights,
       command = {
-        geo_forecasters_weights <- parse_prod_weights(here::here("covid_geo_exclusions.csv"), forecast_generation_date)
-        if (nrow(geo_forecasters_weights %>% filter(forecast_date == forecast_generation_date)) == 0) {
-          cli_abort("there are no weights  for the forecast date {forecast_generation_date}")
+        geo_forecasters_weights <- parse_prod_weights(here::here("covid_geo_exclusions.csv"), forecast_date)
+        if (nrow(geo_forecasters_weights %>% filter(forecast_date == forecast_date)) == 0) {
+          cli_abort("there are no weights  for the forecast date {forecast_date}")
         }
         geo_forecasters_weights
       },
@@ -82,7 +83,7 @@ rlang::list2(
     tar_target(
       forecast_res,
       command = {
-        forecast_date <- as.Date(forecast_generation_date)
+        forecast_date <- as.Date(forecast_date)
         if (forecast_date < Sys.Date()) {
           train_data <- nhsn_archive_data %>%
             epix_as_of(forecast_date) %>%
@@ -95,7 +96,7 @@ rlang::list2(
           train_data <-
             nhsn_latest_data %>%
             data_substitutions(disease = "covid") %>%
-            as_epi_df(as_of = as.Date(forecast_generation_date))
+            as_epi_df(as_of = as.Date(forecast_date))
         }
         attributes(train_data)$metadata$as_of <- round_date(forecast_date, "weeks", week_start = 3)
         train_data %>%
@@ -134,7 +135,7 @@ rlang::list2(
     tar_target(
       name = make_submission_csv,
       command = {
-        forecast_reference_date <- get_forecast_reference_date(as.Date(forecast_generation_date))
+        forecast_reference_date <- get_forecast_reference_date(as.Date(forecast_date))
         ensemble_mixture_res %>%
           format_flusight(disease = "covid") %>%
           write_submission_file(forecast_reference_date, file.path(submission_directory, "model-output/CMU-TimeSeries"))
@@ -153,7 +154,7 @@ rlang::list2(
             ungroup() %>%
             format_flusight(disease = "covid") %>%
             write_submission_file(
-              get_forecast_reference_date(as.Date(forecast_generation_date)),
+              get_forecast_reference_date(as.Date(forecast_date)),
               submission_directory = file.path(submission_directory, "model-output/CMU-climatological-baseline"),
               file_name = "CMU-climatological-baseline"
             )
@@ -169,7 +170,7 @@ rlang::list2(
         if (submission_directory != "cache") {
           validation <- validate_submission(
             submission_directory,
-            file_path = sprintf("CMU-TimeSeries/%s-CMU-TimeSeries.csv", get_forecast_reference_date(as.Date(forecast_generation_date)))
+            file_path = sprintf("CMU-TimeSeries/%s-CMU-TimeSeries.csv", get_forecast_reference_date(as.Date(forecast_date)))
           )
         } else {
           validation <- "not validating when there is no hub (set submission_directory)"
@@ -186,7 +187,7 @@ rlang::list2(
         if (submission_directory != "cache" && submit_climatological) {
           validation <- validate_submission(
             submission_directory,
-            file_path = sprintf("CMU-climatological-baseline/%s-CMU-climatological-baseline.csv", get_forecast_reference_date(as.Date(forecast_generation_date)))
+            file_path = sprintf("CMU-climatological-baseline/%s-CMU-climatological-baseline.csv", get_forecast_reference_date(as.Date(forecast_date)))
           )
         } else {
           validation <- "not validating when there is no hub (set submission_directory)"
@@ -242,13 +243,13 @@ rlang::list2(
           "scripts/reports/forecast_report.Rmd",
           output_file = here::here(
             "reports",
-            sprintf("%s_covid_prod_on_%s.html", as.Date(forecast_generation_date), as.Date(Sys.Date()))
+            sprintf("%s_covid_prod_on_%s.html", as.Date(forecast_date), as.Date(Sys.Date()))
           ),
           params = list(
             disease = "covid",
             forecast_res = forecast_res %>% bind_rows(ensemble_mixture_res %>% mutate(forecaster = "ensemble_mix")),
             ensemble_res = ensemble_res,
-            forecast_generation_date = as.Date(forecast_generation_date),
+            forecast_date = as.Date(forecast_date),
             truth_data = truth_data
           )
         )

scripts/flu_hosp_prod.R

@@ -10,8 +10,9 @@ truth_data_date <- "2023-09-01"
 # needed to create the aux data targets
 end_date <- Sys.Date()
 # Generically set the generation date to the next Wednesday (or today if it's Wednesday)
-forecast_generation_date <- seq.Date(as.Date("2024-11-20"), Sys.Date(), by = 7L)
-# forecast_generation_date <- as.Date("2025-01-08")
+forecast_generation_date <- Sys.Date()
+forecast_date <- seq.Date(as.Date("2024-11-20"), Sys.Date(), by = 7L)
+# forecast_date <- as.Date("2025-01-08")
 very_latent_locations <- list(list(
   c("source"),
   c("flusurv", "ILI+")
@@ -109,14 +110,14 @@ rlang::list2(
     }
   ),
   tar_map(
-    values = tidyr::expand_grid(tibble(forecast_generation_date = forecast_generation_date)),
-    names = "forecast_generation_date",
+    values = tidyr::expand_grid(tibble(forecast_date = forecast_date)),
+    names = "forecast_date",
     tar_target(
       name = geo_forecasters_weights,
       command = {
-        geo_forecasters_weights <- parse_prod_weights(here::here("flu_geo_exclusions.csv"), forecast_generation_date)
-        if (nrow(geo_forecasters_weights %>% filter(forecast_date == forecast_generation_date)) == 0) {
-          cli_abort("there are no weights  for the forecast date {forecast_generation_date}")
+        geo_forecasters_weights <- parse_prod_weights(here::here("flu_geo_exclusions.csv"), forecast_date)
+        if (nrow(geo_forecasters_weights %>% filter(forecast_date == forecast_date)) == 0) {
+          cli_abort("there are no weights  for the forecast date {forecast_date}")
         }
         geo_forecasters_weights
       },
@@ -131,7 +132,7 @@ rlang::list2(
     tar_target(
       forecast_res,
       command = {
-        forecast_date <- as.Date(forecast_generation_date)
+        forecast_date <- as.Date(forecast_date)
         if (forecast_date < Sys.Date()) {
           train_data <- nhsn_archive_data %>%
             epix_as_of(forecast_date) %>%
@@ -193,7 +194,7 @@ rlang::list2(
         ensemble_mixture_res %>%
           format_flusight(disease = "flu") %>%
           write_submission_file(
-            get_forecast_reference_date(as.Date(forecast_generation_date)),
+            get_forecast_reference_date(as.Date(forecast_date)),
             file.path(submission_directory, "model-output/CMU-TimeSeries")
           )
       },
@@ -211,7 +212,7 @@ rlang::list2(
             ungroup() %>%
             format_flusight(disease = "flu") %>%
             write_submission_file(
-              get_forecast_reference_date(as.Date(forecast_generation_date)),
+              get_forecast_reference_date(as.Date(forecast_date)),
               submission_directory = file.path(submission_directory, "model-output/CMU-climatological-baseline"),
               file_name = "CMU-climatological-baseline"
             )
@@ -227,7 +228,7 @@ rlang::list2(
         if (submission_directory != "cache") {
           validation <- validate_submission(
             submission_directory,
-            file_path = sprintf("CMU-TimeSeries/%s-CMU-TimeSeries.csv", get_forecast_reference_date(as.Date(forecast_generation_date)))
+            file_path = sprintf("CMU-TimeSeries/%s-CMU-TimeSeries.csv", get_forecast_reference_date(as.Date(forecast_date)))
           )
         } else {
           validation <- "not validating when there is no hub (set submission_directory)"
@@ -244,7 +245,7 @@ rlang::list2(
         if (submission_directory != "cache" && submit_climatological) {
           validation <- validate_submission(
             submission_directory,
-            file_path = sprintf("CMU-climatological-baseline/%s-CMU-climatological-baseline.csv", get_forecast_reference_date(as.Date(forecast_generation_date)))
+            file_path = sprintf("CMU-climatological-baseline/%s-CMU-climatological-baseline.csv", get_forecast_reference_date(as.Date(forecast_date)))
           )
         } else {
           validation <- "not validating when there is no hub (set submission_directory)"
@@ -267,24 +268,12 @@ rlang::list2(
           select(geo_value, source, target_end_date = time_value, value) %>%
           filter(target_end_date > truth_data_date, geo_value %nin% insufficient_data_geos) %>%
           mutate(target_end_date = target_end_date + 6)
-        forecast_date <- as.Date(forecast_generation_date)
+        forecast_date <- as.Date(forecast_date)
         if (forecast_date < Sys.Date()) {
           truth_data <- nhsn_archive_data %>% epix_as_of(forecast_date)
         } else {
           truth_data <- nhsn_latest_data
         }
-        nhsn_latest_data %>%
-          pull(time_value) %>%
-          max()
-        nhsn_archive_data %>%
-          epix_as_of(as.Date("2024-12-18")) %>%
-          pull(time_value) %>%
-          max()
-        forecast_date
-        nhsn_archive_data %>%
-          epix_as_of(forecast_date) %>%
-          pull(time_value) %>%
-          max()
         truth_data <- truth_data %>%
           mutate(target_end_date = time_value) %>%
           filter(time_value > truth_data_date) %>%
@@ -318,13 +307,13 @@ rlang::list2(
           "scripts/reports/forecast_report.Rmd",
           output_file = here::here(
             "reports",
-            sprintf("%s_flu_prod_on_%s.html", as.Date(forecast_generation_date), as.Date(Sys.Date()))
+            sprintf("%s_flu_prod_on_%s.html", as.Date(forecast_date), as.Date(Sys.Date()))
           ),
           params = list(
             disease = "flu",
             forecast_res = forecast_res %>% bind_rows(ensemble_mixture_res %>% mutate(forecaster = "ensemble_mix")),
             ensemble_res = ensemble_res,
-            forecast_generation_date = as.Date(forecast_generation_date),
+            forecast_date = as.Date(forecast_date),
             truth_data = truth_data
           )
         )

scripts/reports/forecast_report.Rmd

@@ -1,7 +1,7 @@
 ---
-title: "`r params$forecast_generation_date`: `r params$disease` forecaster predictions"
+title: "`r params$forecast_date`: `r params$disease` forecaster predictions"
 author: Delphi Forecast Team
-date: "Rendered: `r format(Sys.time(), '%Y-%m-%d %H:%M:%S')`, Forecast date: `r params$forecast_generation_date`, Last day of data: `r max(params$truth_data$target_end_date)`"
+date: "Rendered: `r format(Sys.time(), '%Y-%m-%d %H:%M:%S')`, Forecast date: `r params$forecast_date`, Last day of data: `r max(params$truth_data$target_end_date)`"
 output:
   html_document:
     toc: True
@@ -11,7 +11,7 @@ params:
   disease: "covid"
   forecast_res: !r ""
   ensemble_res: !r ""
-  forecast_generation_date: !r ""
+  forecast_date: !r ""
   truth_data: !r ""
 ---
 
@@ -52,7 +52,7 @@ Fan displays 20-80 quantiles for coverage.
 ```{r, fig.height = 60, fig.width = 12, echo=FALSE}
 the_plot <- plot_forecasts(
   params$forecast_res %>% bind_rows(params$ensemble_res %>% mutate(forecaster = "ensemble")),
-  params$forecast_generation_date,
+  params$forecast_date,
   params$truth_data,
   quantiles = c(0.8),
   alphas = c(0.7)
@@ -71,7 +71,7 @@ Fan displays 20-80, 5-95, and 1-99 quantiles.
 ```{r, fig.height = 60, fig.width = 12, echo=FALSE}
 the_plot <- plot_forecasts(
   params$forecast_res %>% bind_rows(params$ensemble_res %>% mutate(forecaster = "ensemble")),
-  params$forecast_generation_date,
+  params$forecast_date,
   params$truth_data,
   quantiles = c(0.8, 0.95, 0.99),
   alphas = c(0.9, 0.6, 0.2)
@@ -94,7 +94,7 @@ ggplotly(the_plot, tooltip = "text", height = 9000, width = 2000) %>%
 <!--     value = sum(value), -->
 <!--     .by = c("forecaster", "forecast_date", "target_end_date", "quantile") -->
 <!--   ), -->
-<!--   params$forecast_generation_date, -->
+<!--   params$forecast_date, -->
 <!--   "nation", -->
 <!--   params$truth_data %>% mutate(target_end_date = time_value) %>% filter(geo_value == "usa") %>% filter(time_value > "2023-09-01") -->
 <!-- ) %>% -->