Figure 2 rough draft components

_targets_eval_postprocessing.R

@@ -326,7 +326,8 @@ head_to_head_targets <- list(
           "location" = "state_abbr",
           "date" = "reference_date"
         )
-      )
+      ) |>
+      add_horizons_to_quantiles()
   ),
   # Do the same thing for the sampled scores, combining ww and hosp under
   # the status quo scenario, filtering to the locations and forecast dates
@@ -355,7 +356,8 @@ head_to_head_targets <- list(
           "location" = "state_abbr",
           "date" = "reference_date"
         )
-      )
+      ) |>
+      add_horizons_to_scores()
   ),
   # Repeat for the quantile-based scores
   tar_target(
@@ -368,9 +370,7 @@ head_to_head_targets <- list(
       dplyr::left_join(table_of_loc_dates_w_ww,
         by = c("location", "forecast_date")
       ) |>
-      dplyr::filter(
-        isTRUE(ww_sufficient)
-      ) |>
+      dplyr::filter(ww_sufficient) |>
       dplyr::left_join(
         convergence_df,
         by = c(
@@ -384,7 +384,111 @@ head_to_head_targets <- list(
           "location" = "state_abbr",
           "date" = "reference_date"
         )
-      )
+      ) |>
+      add_horizons_to_scores()
+  )
+)
+
+# Manuscript figures------------------------------------------------
+# Note that these are just the components of the figures, not the full
+# ggarranged, properly formatted figures, and currently require
+# specification for the figure components that are examples.
+manuscript_figures <- list(
+  tar_target(
+    name = fig2_hosp_t_1,
+    command = make_fig2_hosp_t(
+      hosp_quantiles_filtered,
+      loc_to_plot = c("MA"),
+      date_to_plot = "2024-01-15"
+    )
+  ),
+  tar_target(
+    name = fig2_hosp_t_2,
+    command = make_fig2_hosp_t(
+      hosp_quantiles_filtered,
+      loc_to_plot = c("AL"),
+      date_to_plot = "2024-01-15"
+    )
+  ),
+  tar_target(
+    name = fig2_hosp_t_3,
+    command = make_fig2_hosp_t(
+      hosp_quantiles_filtered,
+      loc_to_plot = c("WA"),
+      date_to_plot = "2024-01-15"
+    )
+  ),
+  tar_target(
+    name = fig2_ct_1,
+    command = make_fig2_ct(
+      all_ww_quantiles_sq,
+      loc_to_plot = "MA",
+      date_to_plot = "2024-01-15"
+    )
+  ),
+  tar_target(
+    name = fig2_ct_2,
+    command = make_fig2_ct(
+      all_ww_quantiles_sq,
+      loc_to_plot = "AL",
+      date_to_plot = "2024-01-15"
+    )
+  ),
+  tar_target(
+    name = fig2_ct_3,
+    command = make_fig2_ct(
+      all_ww_quantiles_sq,
+      loc_to_plot = "WA",
+      date_to_plot = "2024-01-15"
+    )
+  ),
+  tar_target(
+    name = fig2_forecast_comparison_nowcast1,
+    command = make_hosp_forecast_comp_fig(
+      hosp_quantiles_filtered,
+      loc_to_plot = "MA",
+      horizon_to_plot = "nowcast"
+    )
+  ),
+  tar_target(
+    name = fig2_forecast_comparison_1wk1,
+    command = make_hosp_forecast_comp_fig(
+      hosp_quantiles_filtered,
+      loc_to_plot = "MA",
+      horizon_to_plot = "1 wk"
+    )
+  ),
+  tar_target(
+    name = fig2_forecast_comparison_4wks1,
+    command = make_hosp_forecast_comp_fig(
+      hosp_quantiles_filtered,
+      loc_to_plot = "MA",
+      horizon_to_plot = "4 wks"
+    )
+  ),
+  tar_target(
+    name = fig2_crps_underlay_nowcast1,
+    command = make_crps_underlay_fig(
+      scores_filtered,
+      loc_to_plot = "MA",
+      horizon_to_plot = "nowcast"
+    )
+  ),
+  tar_target(
+    name = fig2_crps_underlay_1wk1,
+    command = make_crps_underlay_fig(
+      scores_filtered,
+      loc_to_plot = "MA",
+      horizon_to_plot = "1 wk"
+    )
+  ),
+  tar_target(
+    name = fig2_crps_underlay_4wks1,
+    command = make_crps_underlay_fig(
+      scores_filtered,
+      loc_to_plot = "MA",
+      horizon_to_plot = "4 wks"
+    )
   )
 )
 
@@ -783,11 +887,12 @@ hub_comparison_plots <- list(
 
 
 
-# Run the targets pipeline
+# Run the targets pipeline----------------------------------------------------
 list(
   upstream_targets,
   combined_targets,
   head_to_head_targets,
+  manuscript_figures,
   scenario_targets,
   hub_targets,
   hub_comparison_plots

wweval/NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+export(add_horizons_to_quantiles)
+export(add_horizons_to_scores)
 export(add_time_indexing)
 export(clean_ww_data)
 export(combine_outputs)
@@ -49,7 +51,11 @@ export(get_ww_data_indices)
 export(get_ww_data_sizes)
 export(get_ww_values)
 export(make_baseline_score_table)
+export(make_crps_underlay_fig)
 export(make_df)
+export(make_fig2_ct)
+export(make_fig2_hosp_t)
+export(make_hosp_forecast_comp_fig)
 export(sample_model)
 export(save_table)
 export(score_hub_submissions)

wweval/R/add_horizons.R

@@ -0,0 +1,84 @@
+#' Add columns indicating the horizon to the quantiles
+#'
+#' @description
+#' This function takes in a tibble of quantiles containing the columns
+#' `date`, `forecast_date` and `period` and adds the following columns:
+#' `horizon_weeks` (an integer) and `horizon` (a string to be used for
+#' categorical grouping of horizons)
+#'
+#'
+#' @param quantiles A tibble containing the quantiled values and the following
+#' required columns: `date`, `forecast_date`, and `period`
+#'
+#' @return a tibble containing the same columns as `quantiles` plus
+#' `horizon_weeks` and `horizon`
+#' @export
+add_horizons_to_quantiles <- function(quantiles) {
+  quantiles_w_horizons <- quantiles |>
+    dplyr::mutate(
+      # As written, this generates negative integer weeks for days before the
+      # forecast date, and +1 for days after the forecast date, and a 0
+      # on the forecast date
+      horizon_weeks = ifelse(date > forecast_date,
+        ceiling(as.numeric(date - forecast_date) / 7),
+        -ceiling(abs(as.numeric(date - forecast_date) / 7))
+      )
+    ) |>
+    dplyr::mutate(
+      horizon = dplyr::case_when(
+        period == "calibration" ~ "calibration",
+        period != "calibration" & horizon_weeks < 0 ~ "nowcast",
+        horizon_weeks == 1 ~ "1 wk",
+        horizon_weeks == 2 ~ "2 wks",
+        horizon_weeks == 3 ~ "3 wks",
+        horizon_weeks == 4 ~ "4 wks",
+        TRUE ~ NA_character_
+      )
+    )
+  return(quantiles_w_horizons)
+}
+
+#' Add columns indicating the horizon to the scores
+#'
+#' @description
+#' This function takes in a tibble of scores on the nowcasts/forecasts
+#' containing the columns `date` and `forecast_date` and adds the following
+#' columns: `horizon_weeks` (an integer) and `horizon` (a string to be used for
+#' categorical grouping of horizons)
+#'
+#'
+#' @param scores A tibble containing the quantiled values and the following
+#' required columns: `date`and `forecast_date`
+#' @param max_weeks_nowcast An integer indicating the expected maximum number
+#' of weeks where date < forecast date. If the output contains values beyond
+#' this threshold, an error will be thrown which may indicate that the scores
+#' contain scores for calibrated data.
+#'
+#' @return a tibble containing the same columns as `scores` plus
+#' `horizon_weeks` and `horizon`
+#' @export
+add_horizons_to_scores <- function(scores,
+                                   max_weeks_nowcast = 2) {
+  scores_w_horizons <- scores |>
+    dplyr::mutate(
+      # As written, this generates negative integer weeks for days before the
+      # forecast date, and +1 for days after the forecast date, and a 0
+      # on the forecast date
+      horizon_weeks = ifelse(date > forecast_date,
+        ceiling(as.numeric(date - forecast_date) / 7),
+        -ceiling(abs(as.numeric(date - forecast_date) / 7))
+      )
+    ) |>
+    dplyr::mutate(
+      horizon = dplyr::case_when(
+        horizon_weeks < 0 ~ "nowcast",
+        horizon_weeks == 1 ~ "1 wk",
+        horizon_weeks == 2 ~ "2 wks",
+        horizon_weeks == 3 ~ "3 wks",
+        horizon_weeks == 4 ~ "4 wks",
+        TRUE ~ NA_character_
+      )
+    )
+
+  return(scores_w_horizons)
+}