Ds/season summary

R/forecasters/data_validation.R

@@ -97,6 +97,16 @@ filter_extraneous <- function(epi_data, filter_source, filter_agg_level) {
   return(epi_data)
 }
 
+#' the minus one ahead causes problems for `quantile_regression` if that data is
+#' actually present, so we should filter it out
+filter_minus_one_ahead <- function(epi_data, ahead) {
+  if (ahead < 0) {
+    dont_include <- attr(epi_data, "metadata")$as_of + ahead
+    epi_data %<>% filter(time_value < dont_include)
+  }
+  epi_data
+}
+
 #' Unwrap an argument if it's a list of length 1
 #'
 #' Many of our arguments to the forecasters come as lists not because we expect

R/forecasters/forecaster_scaled_pop_seasonal.R

@@ -76,6 +76,8 @@ scaled_pop_seasonal <- function(
   epi_data %<>% filter_extraneous(filter_source, filter_agg_level)
   # this is a temp fix until a real fix gets put into epipredict
   epi_data <- clear_lastminute_nas(epi_data, cols = c(outcome, extra_sources))
+  # predicting the -1 ahead when it is present sometimes lead to freezeing
+  epi_data %<>% filter_minus_one_ahead(ahead)
   # this next part is basically unavoidable boilerplate you'll want to copy
   args_input <- list(...)
   # edge case where there is no data or less data than the lags; eventually epipredict will handle this

R/forecasters/formatters.R

@@ -72,24 +72,27 @@ format_flusight <- function(pred, disease = c("flu", "covid")) {
 }
 
 format_scoring_utils <- function(forecasts_and_ensembles, disease = c("flu", "covid")) {
-  forecasts_and_ensembles %>%
-    filter(!grepl("region.*", geo_value)) %>%
-    mutate(
-      reference_date = get_forecast_reference_date(forecast_date),
-      target = glue::glue("wk inc {disease} hosp"),
-      horizon = as.integer(floor((target_end_date - reference_date) / 7)),
-      output_type = "quantile",
-      output_type_id = quantile,
-      value = value
-    ) %>%
+  # dplyr here was unreasonably slow on 1m+ rows, so replacing with direct access
+  fc_ens <- forecasts_and_ensembles
+  fc_ens <- fc_ens[!grepl("region.*", forecasts_and_ensembles$geo_value), ]
+  fc_ens[, "reference_date"] <- get_forecast_reference_date(fc_ens$forecast_date)
+  fc_ens[, "target"] <- glue::glue("wk inc {disease} hosp")
+  fc_ens[, "horizon"] <- as.integer(floor((fc_ens$target_end_date - fc_ens$reference_date) / 7))
+  fc_ens[, "output_type"] <- "quantile"
+  fc_ens[, "output_type_id"] <- fc_ens$quantile
+  fc_ens %>%
     left_join(
       get_population_data() %>%
         select(state_id, state_code),
       by = c("geo_value" = "state_id")
     ) %>%
     rename(location = state_code, model_id = forecaster) %>%
     select(reference_date, target, horizon, target_end_date, location, output_type, output_type_id, value, model_id) %>%
-    drop_na()
+    drop_na() %>%
+    arrange(location, target_end_date, reference_date, output_type_id) %>%
+    group_by(model_id, location, target_end_date, reference_date) %>%
+    mutate(value = sort(value)) %>%
+    ungroup()
 }
 
 #' The quantile levels used by the covidhub repository

R/targets/score_targets.R

@@ -13,7 +13,7 @@ get_external_forecasts <- function(external_object_name) {
     select(forecaster, geo_value, forecast_date, target_end_date, quantile, value)
 }
 
-score_forecasts <- function(nhsn_latest_data, joined_forecasts_and_ensembles) {
+score_forecasts <- function(nhsn_latest_data, joined_forecasts_and_ensembles, disease) {
   truth_data <-
     nhsn_latest_data %>%
     select(geo_value, target_end_date = time_value, oracle_value = value) %>%
@@ -33,9 +33,8 @@ score_forecasts <- function(nhsn_latest_data, joined_forecasts_and_ensembles) {
     pull(max_forecast) %>%
     min()
   forecasts_formatted <-
-    joined_forecasts_and_ensembles %>%
-    filter(forecast_date <= max_forecast_date) %>%
-    format_scoring_utils(disease = "covid")
+    joined_forecasts_and_ensembles[joined_forecasts_and_ensembles$forecast_date <= max_forecast_date,] %>%
+    format_scoring_utils(disease = disease)
   scores <- forecasts_formatted %>%
     filter(location %nin% c("US", "60", "66", "78")) %>%
     hubEvals::score_model_out(

R/utils.R

@@ -392,39 +392,9 @@ update_site <- function(sync_to_s3 = TRUE) {
     )
 
     # Insert into Production Reports section, skipping a line
-    prod_reports_index <- which(grepl("## Production Reports", report_md_content)) + 1
+    prod_reports_index <- which(grepl("## Weekly Fanplots 2024-2025 Season", report_md_content)) + 1
     report_md_content <- append(report_md_content, report_link, after = prod_reports_index)
   }
-  # add scoring notebooks if they exist
-  score_files <- dir_ls(reports_dir, regexp = ".*_backtesting_2024_2025_on_.*.html")
-  if (length(score_files) > 0) {
-    # a tibble of all score files, along with their generation date and disease
-    score_table <- tibble(
-      filename = score_files,
-      dates = str_match_all(filename, "[0-9]{4}-..-..")
-    ) %>%
-      unnest_wider(dates, names_sep = "_") %>%
-      rename(generation_date = dates_1) %>%
-      mutate(
-        generation_date = ymd(generation_date),
-        disease = str_match(filename, "flu|covid")
-      )
-    used_files <- score_table %>%
-      group_by(disease) %>%
-      slice_max(generation_date)
-    # iterating over the diseases
-    for (row_num in seq_along(used_files$filename)) {
-      file_name <- path_file(used_files$filename[[row_num]])
-      scoring_index <- which(grepl("### Scoring this season", report_md_content)) + 1
-      score_link <- sprintf(
-        "- [%s Scoring, Rendered %s](%s)",
-        str_to_title(used_files$disease[[row_num]]),
-        used_files$generation_date[[row_num]],
-        file_name
-      )
-      report_md_content <- append(report_md_content, score_link, after = scoring_index)
-    }
-  }
 
   # Write the updated content to report.md
   report_md_path <- path(reports_dir, "report.md")
@@ -725,3 +695,50 @@ get_socrata_updated_at <- function(dataset_url, missing_value = MAX_TIMESTAMP) {
     }
   )
 }
+
+
+
+#' get the unique shared (geo_value, forecast_date, target_end_date) tuples present for each forecaster in `forecasts`
+get_unique <- function(forecasts) {
+  forecasters <- forecasts %>%
+    pull(forecaster) %>%
+    unique()
+  distinct <- map(
+    forecasters,
+    \(x) forecasts %>%
+      filter(forecaster == x) %>%
+      select(geo_value, forecast_date, target_end_date) %>%
+      distinct()
+  )
+  distinct_dates <- reduce(distinct, \(x, y) x %>% inner_join(y, by = c("geo_value", "forecast_date", "target_end_date")))
+  mutate(
+    distinct_dates,
+    forecast_date = round_date(forecast_date, unit = "week", week_start = 6)
+  )
+}
+
+#' filter the external and local forecasts to just the shared dates/geos
+#' some forecasters have a limited set of geos; we want to include those
+#' anyways, they are `tructated_forecasters`, while the external_forecasts may
+#' have previous years forecasts that we definitely want to exclude via
+#' `season_start`.
+filter_shared_geo_dates <- function(local_forecasts, external_forecasts, season_start = "2024-11-01", trucated_forecasters = "windowed_seasonal_extra_sources") {
+  viable_dates <- inner_join(
+    local_forecasts %>%
+      filter(forecaster %nin% trucated_forecasters) %>%
+      get_unique(),
+    external_forecasts %>%
+      filter(forecast_date > season_start) %>%
+      get_unique(),
+    by = c("geo_value", "forecast_date", "target_end_date")
+  )
+  dplyr::bind_rows(
+    local_forecasts %>%
+      mutate(
+        forecast_date = round_date(forecast_date, unit = "week", week_start = 6)
+      ) %>%
+      inner_join(viable_dates, by = c("geo_value", "forecast_date", "target_end_date")),
+    external_forecasts %>%
+      inner_join(viable_dates, by = c("geo_value", "forecast_date", "target_end_date"))
+  )
+}

covid_geo_exclusions.csv

@@ -141,14 +141,14 @@ forecast_date,forecaster,geo_value,weight
 ##################
 # feb 12
 ##################
-2025-02-05, all, mp, 0
-2025-02-05, windowed_seasonal, all, 3
-2025-02-05, windowed_seasonal_extra_sources, all, 0.0
-2025-02-05, climate_linear, all, 3
-2025-02-05, linear, all, 0.5
-2025-02-05, linearlog, all, 0
-2025-02-05, climate_base, all, 0
-2025-02-05, climate_geo_agged, all, 0.0
+2025-02-12, all, mp, 0
+2025-02-12, windowed_seasonal, all, 3
+2025-02-12, windowed_seasonal_extra_sources, all, 0.0
+2025-02-12, climate_linear, all, 3
+2025-02-12, linear, all, 0.5
+2025-02-12, linearlog, all, 0
+2025-02-12, climate_base, all, 0
+2025-02-12, climate_geo_agged, all, 0.0
 ##################
 # feb 5
 ##################