fix: covid_hosp_explore with package updates

Author: dshemetov

R/aux_data_utils.R

@@ -194,7 +194,7 @@ daily_to_weekly_archive <- function(epi_arch,
                                     day_of_week = 4L,
                                     day_of_week_end = 7L) {
   agg_method <- arg_match(agg_method)
-  keys <- key_colnames(epi_arch, exclude = "time_value")
+  keys <- key_colnames(epi_arch, exclude = c("time_value", "version"))
   ref_time_values <- epi_arch$DT$version %>%
     unique() %>%
     sort()
@@ -229,6 +229,7 @@ daily_to_weekly_archive <- function(epi_arch,
         ) %>%
         select(-all_of(agg_columns)) %>%
         rename_with(~ gsub("slide_value_", "", .x)) %>%
+        rename_with(~ gsub("_7dsum", "", .x)) %>%
         # only keep 1/week
         # group_by week, keep the largest in each week
         # alternatively

R/scoring.R

@@ -12,19 +12,23 @@ evaluate_predictions <- function(predictions_cards, truth_data) {
     must.include = c("geo_value", "target_end_date", "true_value")
   )
 
-  left_join(predictions_cards, truth_data, by = c("geo_value", "target_end_date")) %>%
-    scoringutils::score(metrics = c("interval_score", "ae_median", "coverage")) %>%
-    scoringutils::add_coverage(by = c("model", "geo_value", "forecast_date", "target_end_date"), ranges = c(80)) %>%
-    scoringutils::summarize_scores(by = c("model", "geo_value", "forecast_date", "target_end_date")) %>%
+  forecast_obj <- left_join(predictions_cards, truth_data, by = c("geo_value", "target_end_date")) %>%
+    scoringutils::as_forecast_quantile(
+      quantile_level = "quantile",
+      observed = "true_value",
+      predicted = "prediction",
+      forecast_unit = c("model", "geo_value", "forecast_date", "target_end_date")
+    )
+
+  scores <- forecast_obj %>%
+    scoringutils::score(metrics = get_metrics(.)) %>%
     as_tibble() %>%
     select(
-      model,
-      geo_value,
-      forecast_date,
-      target_end_date,
-      wis = interval_score,
+      model, geo_value, forecast_date, target_end_date,
+      wis,
       ae = ae_median,
-      coverage_80
+      coverage_50 = interval_coverage_50,
+      coverage_90 = interval_coverage_90
     ) %>%
     mutate(ahead = as.numeric(target_end_date - forecast_date))
 }

scripts/covid_hosp_explore.R

@@ -8,8 +8,9 @@ if (!exists("ref_time_values_")) {
   # Alternatively you can let slide_forecaster figure out ref_time_values
   start_date <- as.Date("2023-10-04")
   end_date <- as.Date("2024-04-24")
+  # end_date <- start_date + 7 * 10
   date_step <- 7L
-  # ref_time_values_ <- as.Date(c("2023-11-08", "2023-11-22"))
+  ref_time_values_ <- seq.Date(as.Date("2023-10-04"), as.Date("2024-04-24"), by = 7L)
 }
 time_value_adjust <- 3 # this moves the week marker from Saturday to Wednesday
 

scripts/targets-common.R

@@ -21,8 +21,8 @@ main_controller <- crew_controller_local(
   seconds_timeout = 7 * 24 * 60 * 60L, # 7 days is probably enough
   garbage_collection = TRUE,
   options_local = crew_options_local(log_directory = "local_logs"),
-  tasks_max = 1L,
-  launch_max = 10000L
+  # tasks_max = 1L,
+  # launch_max = 10000L
 )
 # The external scores processing causes the pipeline to exit with an error,
 # apparently due to running out of memory. Set up a non-parallel `crew`
@@ -35,8 +35,8 @@ serial_controller <- crew_controller_local(
   seconds_idle = 60L,
   seconds_timeout = 7 * 24 * 60 * 60L,
   garbage_collection = TRUE,
-  tasks_max = 1L,
-  launch_max = 10000L
+  # tasks_max = 1L,
+  # launch_max = 10000L
 )
 
 # Serial mode is better for debugging.