Merge pull request #31 from cmu-delphi/ndefries/evaluation-app-forecaster-naming

Use targets `forecasters` obj to fetch only up-to-date data for app

Author: nmdefries

app.R

@@ -39,7 +39,7 @@ load_forecast_data_raw <- function(forecaster) {
     # rename(wis = wis_count_scale, ae = ae_count_scale) %>%
     mutate(
       ahead = as.integer(target_end_date - forecast_date),
-      forecaster = forecaster
+      forecaster = names(forecaster_options[forecaster_options == forecaster])
     ) %>%
     {
       .

covid_hosp_explore.R

@@ -70,11 +70,21 @@ forecasts_and_scores <- tar_map(
   )
 )
 
+ensemble_keys <- list(a = c(300, 15))
+ensembles <- list(
+  tar_target(
+    name = ensembles,
+    command = {
+      ensemble_keys
+    }
+  )
+)
+
 # The combine approach below is taken from the manual:
 #   https://books.ropensci.org/targets/static.html#combine
 # The key is that the map above has unlist = FALSE.
 ensemble_forecast <- tar_map(
-  values = list(a = c(300, 15)),
+  values = ensemble_keys,
   tar_combine(
     name = ensemble_forecast,
     # TODO: Needs a lookup table to select the right forecasters
@@ -110,20 +120,11 @@ ensemble_forecast <- tar_map(
     }
   )
 )
-notebooks <- list(
-  tar_render(
-    name = report,
-    path = "extras/report.Rmd",
-    params = list(
-      exclude_geos = c("as", "gu", "mp", "vi")
-    )
-  )
-)
 
 list(
   data,
   forecasters,
   forecasts_and_scores,
-  ensemble_forecast,
-  notebooks
+  ensembles,
+  ensemble_forecast
 )

extras/report.Rmd

@@ -17,11 +17,11 @@ library(targets)
 source("extras/plotting.R")
 
 flu_forecasts <- bind_rows(
-  tar_read("forecast_ZWNiZ"),
-  tar_read("forecast_M2RjZ"),
-  tar_read("forecast_YzhkZ"),
+  tar_read("forecast_cheap.managerial.1"),
+  tar_read("forecast_clearcut.antiromantic.1"),
+  tar_read("forecast_honorary.salmonoid.5"),
   .id = "forecaster"
-) %>% filter(forecaster == "ZWNiZ")
+) %>% filter(forecaster == "cheap managerial 1")
 ```
 
 ## Trajectory plots

flu_hosp_explore.R

@@ -55,7 +55,9 @@ grids <- list(
 # expand_grid instead
 param_grid <- bind_rows(map(grids, add_id)) %>% relocate(id, .after = last_col())
 
-forecaster_param_grids <- make_target_param_grid(param_grid)
+forecaster_param_grids <- make_target_param_grid(param_grid) %>%
+  ## TODO This forecaster is hanging. Filter it out for now.
+  filter(id != "necessary endless 5")
 
 # not actually used downstream, this is for lookup during plotting and human evaluation
 forecasters <- list(
@@ -207,11 +209,21 @@ forecasts_and_scores <- tar_map(
   )
 )
 
+ensemble_keys <- list(a = c(300, 15))
+ensembles <- list(
+  tar_target(
+    name = ensembles,
+    command = {
+      ensemble_keys
+    }
+  )
+)
+
 # The combine approach below is taken from the manual:
 #   https://books.ropensci.org/targets/static.html#combine
 # The key is that the map above has unlist = FALSE.
 ensemble_forecast <- tar_map(
-  values = list(a = c(300, 15)),
+  values = ensemble_keys,
   tar_combine(
     name = ensemble_forecast,
     # TODO: Needs a lookup table to select the right forecasters
@@ -247,20 +259,11 @@ ensemble_forecast <- tar_map(
     }
   )
 )
-notebooks <- list(
-  tar_render(
-    name = report,
-    path = "extras/report.Rmd",
-    params = list(
-      exclude_geos = c("as", "gu", "mp", "vi")
-    )
-  )
-)
 
 list(
-  data
-  ## forecasters,
-  ## forecasts_and_scores,
-  ## ensemble_forecast,
-  ## notebooks
+  data,
+  forecasters,
+  forecasts_and_scores,
+  ensembles,
+  ensemble_forecast
 )

run.R

@@ -53,7 +53,19 @@ tar_make()
 
 # Prevent functions defined in /R dir from being loaded unnecessarily
 options(shiny.autoload.r=FALSE)
-## TODO: Alternately, create and save an object in `_targets.R`
-## that lists all objs of interest and `tar_read` that in.
-forecaster_options <- tar_objects(names=contains("score"))
+forecaster_options <- tar_read(forecasters)[["id"]]
+# Map forecaster names to score files
+forecaster_options <- setNames(
+  paste0("score_", gsub(" ", ".", forecaster_options)),
+  forecaster_options
+)
+
+# Add ensembles
+ensemble_options <- tar_read(ensembles)[["a"]]
+ensemble_options <- setNames(
+  paste0("ensemble_score_", ensemble_options),
+  paste0("ensemble score ", ensemble_options)
+)
+
+forecaster_options <- c(ensemble_options, forecaster_options)
 runApp(here::here("app.R"), port=3838)