styler::style_folder("all_the_folders")

dsweber2 · dsweber2 · commit 4606f25d54f7 · 2025-01-13T11:23:26.000-06:00
diff --git a/Makefile b/Makefile
@@ -86,7 +86,7 @@ dashboard:
 	Rscript scripts/dashboard.R
 
 update_site:
-	Rscript -e "source('R/utils.R'); update_site()"
+	Rscript -e "suppressPackageStartupMessages(source(here::here('R', 'load_all.R'))); update_site()"
 
 netlify:
 	netlify deploy --dir=reports --prod
diff --git a/R/forecasters/forecaster_climatological.R b/R/forecasters/forecaster_climatological.R
@@ -1,18 +1,18 @@
 climate_linear_ensembled <- function(epi_data,
-                           outcome,
-                           extra_sources = "",
-                           ahead = 7,
-                           trainer = parsnip::linear_reg(),
-                           quantile_levels = covidhub_probs(),
-                           filter_source = "",
-                           filter_agg_level = "",
-                           scale_method = c("quantile", "std", "none"),
-                           center_method = c("median", "mean", "none"),
-                           nonlin_method = c("quart_root", "none"),
-                           drop_non_seasons = FALSE,
-                           residual_tail = 0.99,
-                           residual_center = 0.35,
-                           ...) {
+                                     outcome,
+                                     extra_sources = "",
+                                     ahead = 7,
+                                     trainer = parsnip::linear_reg(),
+                                     quantile_levels = covidhub_probs(),
+                                     filter_source = "",
+                                     filter_agg_level = "",
+                                     scale_method = c("quantile", "std", "none"),
+                                     center_method = c("median", "mean", "none"),
+                                     nonlin_method = c("quart_root", "none"),
+                                     drop_non_seasons = FALSE,
+                                     residual_tail = 0.99,
+                                     residual_center = 0.35,
+                                     ...) {
   scale_method <- arg_match(scale_method)
   center_method <- arg_match(center_method)
   nonlin_method <- arg_match(nonlin_method)
@@ -49,7 +49,9 @@ climate_linear_ensembled <- function(epi_data,
   }
   learned_params <- calculate_whitening_params(season_data, outcome, scale_method, center_method, nonlin_method)
   epi_data %<>% data_whitening(outcome, learned_params, nonlin_method)
-  epi_data <- epi_data %>% select(geo_value, source, time_value, season, value = !!outcome) %>% mutate(epiweek = epiweek(time_value))
+  epi_data <- epi_data %>%
+    select(geo_value, source, time_value, season, value = !!outcome) %>%
+    mutate(epiweek = epiweek(time_value))
   pred_climate <- climatological_model(epi_data, ahead) %>% mutate(forecaster = "climate")
   pred_geo_climate <- climatological_model(epi_data, ahead, geo_agg = FALSE) %>% mutate(forecaster = "climate_geo")
   pred_linear <- forecaster_baseline_linear(epi_data, ahead, residual_tail = residual_tail, residual_center = residual_center) %>% mutate(forecaster = "linear")
diff --git a/R/utils.R b/R/utils.R
@@ -305,8 +305,10 @@ update_site <- function() {
   report_md_content <- readLines(template_path)
   # Get the list of files in the reports directory
   report_files <- dir_ls(reports_dir, regexp = ".*_prod_on_.*.html")
-  report_table <- tibble(filename = report_files,
-         dates = str_match_all(filename, "[0-9]{4}-..-..")) %>%
+  report_table <- tibble(
+    filename = report_files,
+    dates = str_match_all(filename, "[0-9]{4}-..-..")
+  ) %>%
     unnest_wider(dates, names_sep = "_") %>%
     rename(forecast_date = dates_1, generation_date = dates_2) %>%
     mutate(
diff --git a/scripts/covid_hosp_explore.R b/scripts/covid_hosp_explore.R
@@ -9,7 +9,7 @@ if (!exists("ref_time_values_")) {
   start_date <- as.Date("2023-10-04")
   end_date <- as.Date("2024-04-24")
   date_step <- 7L
-  #ref_time_values_ <- as.Date(c("2023-11-08", "2023-11-22"))
+  # ref_time_values_ <- as.Date(c("2023-11-08", "2023-11-22"))
 }
 time_value_adjust <- 3 # this moves the week marker from Saturday to Wednesday
 
diff --git a/scripts/covid_hosp_prod.R b/scripts/covid_hosp_prod.R
@@ -183,7 +183,8 @@ rlang::list2(
         if (submission_directory != "cache") {
           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_generation_date)))
+          )
         } else {
           validation <- "not validating when there is no hub (set submission_directory)"
         }
diff --git a/scripts/flu_hosp_explore.R b/scripts/flu_hosp_explore.R
@@ -536,7 +536,7 @@ rlang::list2(
     family_notebooks,
     command = {
       actual_eval_data <- hhs_evaluation_data
-        mutate(target_end_date = target_end_date + 3)
+      mutate(target_end_date = target_end_date + 3)
       delphi_forecaster_subset <- forecaster_parameter_combinations[[forecaster_families]]$id
       outside_forecaster_subset <- c("FluSight-baseline", "FluSight-ensemble", "UMass-flusion")
       filtered_forecasts <- joined_forecasts %>%
diff --git a/scripts/flu_hosp_prod.R b/scripts/flu_hosp_prod.R
@@ -2,6 +2,7 @@
 source("scripts/targets-common.R")
 source("scripts/targets-exploration-common.R")
 
+submit_climatological <- FALSE
 submission_directory <- Sys.getenv("FLU_SUBMISSION_DIRECTORY", "cache")
 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
@@ -10,7 +11,7 @@ truth_data_date <- "2023-09-01"
 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")
 very_latent_locations <- list(list(
   c("source"),
   c("flusurv", "ILI+")
diff --git a/scripts/one_offs/making_hhs_weekly_ex.R b/scripts/one_offs/making_hhs_weekly_ex.R
@@ -127,9 +127,10 @@ daily_to_weekly_archive <- function(epi_arch,
 
 health_data_covid <- map(forecast_dates, get_health_data)
 compactified_health_data_covid <- mapply(\(x, y) mutate(x, version = y),
-       health_data_covid,
-       forecast_dates,
-       SIMPLIFY = FALSE) %>%
+  health_data_covid,
+  forecast_dates,
+  SIMPLIFY = FALSE
+) %>%
   bind_rows() %>%
   filter(!is.na(hhs)) %>%
   as_epi_archive(compactify = TRUE)
@@ -141,9 +142,10 @@ weekly_archive_covid <- compactified_health_data_covid %>%
 
 health_data_flu <- map(forecast_dates, \(x) get_health_data(x, "flu"))
 compactified_health_data_flu <- mapply(\(x, y) mutate(x, version = y),
-       health_data_flu,
-       forecast_dates,
-       SIMPLIFY = FALSE) %>%
+  health_data_flu,
+  forecast_dates,
+  SIMPLIFY = FALSE
+) %>%
   bind_rows() %>%
   filter(!is.na(hhs)) %>%
   as_epi_archive(compactify = TRUE)
diff --git a/scripts/reports/baseline_linear_model.Rmd b/scripts/reports/baseline_linear_model.Rmd
@@ -14,10 +14,10 @@ $$\\[.4in]$$
 
 ```{r echo=FALSE}
 knitr::opts_chunk$set(
-    fig.align = "center",
-    message = FALSE,
-    warning = FALSE,
-    cache = FALSE
+  fig.align = "center",
+  message = FALSE,
+  warning = FALSE,
+  cache = FALSE
 )
 knitr::opts_knit$set(root.dir = here::here())
 ggplot2::theme_set(ggplot2::theme_bw())
@@ -40,24 +40,24 @@ library(ggplot2)
 library(plotly)
 
 if (params$disease == "flu") {
-    epi_data <- readr::read_csv("https://data.cdc.gov/resource/ua7e-t2fy.csv?$limit=20000&$select=weekendingdate,jurisdiction,totalconfflunewadm", show_col_types = FALSE) %>%
-        rename(time_value = weekendingdate, value = totalconfflunewadm, geo_value = jurisdiction)
+  epi_data <- readr::read_csv("https://data.cdc.gov/resource/ua7e-t2fy.csv?$limit=20000&$select=weekendingdate,jurisdiction,totalconfflunewadm", show_col_types = FALSE) %>%
+    rename(time_value = weekendingdate, value = totalconfflunewadm, geo_value = jurisdiction)
 } else if (params$disease == "covid") {
-    epi_data <- readr::read_csv("https://data.cdc.gov/resource/ua7e-t2fy.csv?$limit=20000&$select=weekendingdate,jurisdiction,totalconfc19newadm", show_col_types = FALSE) %>%
-        rename(time_value = weekendingdate, value = totalconfc19newadm, geo_value = jurisdiction)
+  epi_data <- readr::read_csv("https://data.cdc.gov/resource/ua7e-t2fy.csv?$limit=20000&$select=weekendingdate,jurisdiction,totalconfc19newadm", show_col_types = FALSE) %>%
+    rename(time_value = weekendingdate, value = totalconfc19newadm, geo_value = jurisdiction)
 } else {
-    stop("Invalid disease")
+  stop("Invalid disease")
 }
 today <- Sys.Date()
 epi_data <- epi_data %>%
-    filter(geo_value %nin% c("AS", "USA", "VI", "PR", "MP", "GU")) %>%
-    mutate(time_value = as.Date(time_value), geo_value = tolower(geo_value)) %>%
-    mutate(
-        target_end_date = time_value,
-        value = ifelse(value == 0, NA, value)
-    ) %>%
-    arrange(geo_value, time_value) %>%
-    as_epi_df(as_of = today)
+  filter(geo_value %nin% c("AS", "USA", "VI", "PR", "MP", "GU")) %>%
+  mutate(time_value = as.Date(time_value), geo_value = tolower(geo_value)) %>%
+  mutate(
+    target_end_date = time_value,
+    value = ifelse(value == 0, NA, value)
+  ) %>%
+  arrange(geo_value, time_value) %>%
+  as_epi_df(as_of = today)
 
 aheads <- -1:3
 forecast_date <- today
@@ -69,18 +69,18 @@ subset_geos <- c("ca", "ny", "fl", "tx", "pa")
 
 ```{r}
 quantile_forecast <- map(aheads, ~ forecaster_baseline_linear(epi_data, .x, log = FALSE)) %>%
-    bind_rows() %>%
-    filter(geo_value %in% subset_geos) %>%
-    mutate(forecaster = "baseline_linear")
+  bind_rows() %>%
+  filter(geo_value %in% subset_geos) %>%
+  mutate(forecaster = "baseline_linear")
 truth_data <- epi_data %>%
-    filter(geo_value %in% subset_geos, time_value > forecast_date - 365 * 2)
+  filter(geo_value %in% subset_geos, time_value > forecast_date - 365 * 2)
 train_fit <- quantile_forecast %>%
-    filter(is.na(quantile)) %>%
-    mutate(time_value = target_end_date)
+  filter(is.na(quantile)) %>%
+  mutate(time_value = target_end_date)
 quantile_forecast <- quantile_forecast %>% filter(!is.na(quantile))
 train_data <- epi_data %>%
-    filter(geo_value %in% subset_geos, time_value > forecast_date - 30) %>%
-    summarize(start = min(time_value), stop = max(time_value))
+  filter(geo_value %in% subset_geos, time_value > forecast_date - 30) %>%
+  summarize(start = min(time_value), stop = max(time_value))
 
 # Bad forecast filters
 filter_geos <- filter_forecast_geos(quantile_forecast, truth_data)
@@ -92,7 +92,7 @@ Filter geo recommendations: `r paste(filter_geos, collapse = ", ")`.
 
 ```{r}
 p <- plot_forecasts(quantile_forecast, forecast_date, truth_data = truth_data, relevant_period = train_data) +
-    geom_point(data = train_fit, mapping = aes(x = time_value, y = value), size = 0.25)
+  geom_point(data = train_fit, mapping = aes(x = time_value, y = value), size = 0.25)
 
 ggplotly(p, tooltip = "text", height = 5000, width = 1700)
 ```
@@ -101,18 +101,18 @@ ggplotly(p, tooltip = "text", height = 5000, width = 1700)
 
 ```{r}
 quantile_forecast <- map(aheads, ~ forecaster_baseline_linear(epi_data, .x, log = TRUE)) %>%
-    bind_rows() %>%
-    filter(geo_value %in% subset_geos) %>%
-    mutate(forecaster = "baseline_linear")
+  bind_rows() %>%
+  filter(geo_value %in% subset_geos) %>%
+  mutate(forecaster = "baseline_linear")
 truth_data <- epi_data %>%
-    filter(geo_value %in% subset_geos, time_value > forecast_date - 365 * 2)
+  filter(geo_value %in% subset_geos, time_value > forecast_date - 365 * 2)
 train_fit <- quantile_forecast %>%
-    filter(is.na(quantile)) %>%
-    mutate(time_value = target_end_date)
+  filter(is.na(quantile)) %>%
+  mutate(time_value = target_end_date)
 quantile_forecast <- quantile_forecast %>% filter(!is.na(quantile))
 train_data <- epi_data %>%
-    filter(geo_value %in% subset_geos, time_value > forecast_date - 30) %>%
-    summarize(start = min(time_value), stop = max(time_value))
+  filter(geo_value %in% subset_geos, time_value > forecast_date - 30) %>%
+  summarize(start = min(time_value), stop = max(time_value))
 
 filter_geos <- filter_forecast_geos(quantile_forecast, truth_data)
 ```
@@ -123,7 +123,7 @@ Filter geo recommendations: `r paste(filter_geos, collapse = ", ")`.
 
 ```{r}
 p <- plot_forecasts(quantile_forecast, forecast_date, truth_data = truth_data, relevant_period = train_data) +
-    geom_point(data = train_fit, mapping = aes(x = time_value, y = value), size = 0.25)
+  geom_point(data = train_fit, mapping = aes(x = time_value, y = value), size = 0.25)
 
 ggplotly(p, tooltip = "text", height = 5000, width = 1700)
 ```
diff --git a/scripts/reports/comparison-notebook.Rmd b/scripts/reports/comparison-notebook.Rmd
diff --git a/scripts/reports/flu-overall-comparison-notebook.Rmd b/scripts/reports/flu-overall-comparison-notebook.Rmd
diff --git a/scripts/reports/new_data.Rmd b/scripts/reports/new_data.Rmd

Original file line number	Diff line number	Diff line change
`@@ -9,7 +9,7 @@ if (!exists("ref_time_values_")) {`
`9`	`9`	`start_date <- as.Date("2023-10-04")`
`10`	`10`	`end_date <- as.Date("2024-04-24")`
`11`	`11`	`date_step <- 7L`
`12`		`- #ref_time_values_ <- as.Date(c("2023-11-08", "2023-11-22"))`
	`12`	`+ # ref_time_values_ <- as.Date(c("2023-11-08", "2023-11-22"))`
`13`	`13`	`}`
`14`	`14`	`time_value_adjust <- 3 # this moves the week marker from Saturday to Wednesday`
`15`	`15`