add step to aggregate all aheads for a given model into one obj

Author: nmdefries

R/small_utils.R

@@ -27,9 +27,9 @@ add_id <- function(df, n_adj = 2) {
     mutate(id = hash_animal(id, n_adj = n_adj)$words) %>%
     mutate(id = paste(id[1:n_adj], sep="", collapse = " "))
   df %<>%
-    mutate(id = stringified) %>%
+    mutate(parent_id = stringified$id) %>%
     rowwise() %>%
-    mutate(id = paste(id, ahead, collapse = " ")) %>%
+    mutate(id = paste(parent_id, ahead, collapse = " ")) %>%
     ungroup()
   return(df)
 }

covid_hosp_explore.R

@@ -35,12 +35,12 @@ tar_option_set(
 source("covid_hosp_explore/forecaster_instantiation.R")
 source("covid_hosp_explore/data_targets.R")
 
-forecasts_and_scores <- tar_map(
+forecasts_and_scores_separate_aheads <- tar_map(
   values = forecaster_param_grids,
   names = id,
   unlist = FALSE,
   tar_target(
-    name = forecast,
+    name = forecast_by_ahead,
     command = {
       forecaster_pred(
         data = joined_archive_data_2022,
@@ -55,10 +55,10 @@ forecasts_and_scores <- tar_map(
     }
   ),
   tar_target(
-    name = score,
+    name = score_by_ahead,
     command = {
       run_evaluation_measure(
-        data = forecast,
+        data = forecast_by_ahead,
         evaluation_data = hhs_evaluation_data,
         measure = list(
           wis = weighted_interval_score,
@@ -70,6 +70,43 @@ forecasts_and_scores <- tar_map(
   )
 )
 
+forecasts_and_scores <- tar_map(
+  values = forecaster_parent_id_map,
+  names = parent_id,
+  tar_target(
+    name = forecast,
+    command = {
+      bind_rows(forecast_component_ids) %>%
+        mutate(parent_forecaster = parent_id)
+    }
+  ),
+  tar_target(
+    name = score,
+    command = {
+      bind_rows(score_component_ids) %>%
+        mutate(parent_forecaster = parent_id)
+    }
+  )
+  # tar_target(
+  #   name = score,
+  #   command = {
+  #     bind_rows(!!!component_ids) %>%
+  #       mutate(parent_forecaster = parent_id)
+  #   }
+  # )
+  #,
+  # tar_combine(
+  #   name = score,
+  #   list(
+  #     forecasts_and_scores_separate_aheads[["score_by_ahead"]][filter(param_grid, parent_id == value)[["rownum"]]]
+  #   ),
+  #   command = {
+  #     bind_rows(!!!.x) %>%
+  #       mutate(parent_forecaster = name)
+  #   }
+  # )
+)
+
 ensemble_keys <- list(a = c(300, 15))
 ensembles <- list(
   tar_target(
@@ -89,8 +126,8 @@ ensemble_forecast <- tar_map(
     name = ensemble_forecast,
     # TODO: Needs a lookup table to select the right forecasters
     list(
-      forecasts_and_scores[["forecast"]][[1]],
-      forecasts_and_scores[["forecast"]][[2]]
+      forecasts_and_scores_separate_aheads[["forecast_by_ahead"]][[1]],
+      forecasts_and_scores_separate_aheads[["forecast_by_ahead"]][[2]]
     ),
     command = {
       bind_rows(!!!.x, .id = "forecaster") %>%
@@ -124,6 +161,7 @@ ensemble_forecast <- tar_map(
 list(
   data,
   forecasters,
+  forecasts_and_scores_separate_aheads,
   forecasts_and_scores,
   ensembles,
   ensemble_forecast

covid_hosp_explore/forecaster_instantiation.R

@@ -20,9 +20,17 @@ grids <- list(
 # bind them together and give static ids; if you add a new field to a given
 # expand_grid, everything will get a new id, so it's better to add a new
 # expand_grid instead
-param_grid <- bind_rows(map(grids, add_id)) %>% relocate(id, .after = last_col())
+param_grid <- bind_rows(map(grids, add_id)) %>%
+  relocate(parent_id, id, .after = last_col())
 
-forecaster_param_grids <- make_target_param_grid(param_grid)
+forecaster_parent_id_map <- param_grid %>%
+  group_by(parent_id) %>%
+  summarize(
+    forecast_component_ids = list(syms(paste0("forecast_by_ahead_", gsub(" ", ".", id, fixed = TRUE)))),
+    score_component_ids = list(syms(paste0("score_by_ahead_", gsub(" ", ".", id, fixed = TRUE))))
+  )
+
+forecaster_param_grids <- make_target_param_grid(select(param_grid, -parent_id))
 
 # not actually used downstream, this is for lookup during plotting and human evaluation
 forecasters <- list(

run.R

@@ -53,7 +53,7 @@ tar_make()
 
 # Prevent functions defined in /R dir from being loaded unnecessarily
 options(shiny.autoload.r=FALSE)
-forecaster_options <- tar_read(forecasters)[["id"]]
+forecaster_options <- unique(tar_read(forecasters)[["parent_id"]])
 # Map forecaster names to score files
 forecaster_options <- setNames(
   paste0("score_", gsub(" ", ".", forecaster_options)),