add bar chart as main fig and swap into Hub comparison fig

_targets_eval_postprocessing.R

@@ -1539,7 +1539,7 @@ hub_comparison_plots <- list(
       "CMU-TimeSeries",
       "COVIDhub-4_week_ensemble",
       "cfa-wwrenewal(real-time)",
-      "cfa-hosponlyrenewal(real-time)",
+      "cfa-hosponlyrenewal(real-time)*",
       "cfa-wwrenewal(retro)",
       "cfa-hosponlyrenewal(retro)"
     )
@@ -1740,6 +1740,24 @@ hub_comparison_plots <- list(
       time_period = "Feb-Mar 2024"
     )
   ),
+  tar_target(
+    name = fig5_all_time_bar_chart,
+    make_fig5_bar_chart(
+      combine_scores_oct_mar,
+      time_period = "Oct-Mar"
+    )
+  ),
+  tar_target(
+    name = fig5_real_time_bar_chart,
+    make_fig5_bar_chart(
+      combine_scores_feb_mar |>
+        dplyr::filter(!model %in% c(
+          "cfa-wwrenewal(retro)",
+          "cfa-hosponlyrenewal(retro)"
+        )),
+      time_period = "Oct-Mar"
+    )
+  ),
   tar_target(
     name = fig5_std_rank_feb_mar,
     command = make_fig5_density_rank(
@@ -1784,8 +1802,8 @@ hub_comparison_plots <- list(
       fig5_heatmap_rel_wis_feb_mar = fig5_heatmap_rel_wis_feb_mar,
       fig5_qq_plot_all_time = fig5_qq_plot_all_time,
       fig5_qq_plot_feb_mar = fig5_qq_plot_feb_mar,
-      fig5_std_rank_feb_mar = fig5_std_rank_feb_mar,
-      fig5_std_rank_all_time = fig5_std_rank_all_time,
+      fig5_std_rank_feb_mar = fig5_real_time_bar_chart,
+      fig5_std_rank_all_time = fig5_all_time_bar_chart,
       fig_file_dir = eval_config$ms_fig_dir
     )
   )

wweval/R/ms_fig5.R

@@ -47,6 +47,48 @@ make_fig5_table_and_plot <- function(scores,
   return(hub_scores_overall)
 }
 
+#' Make plot of WIS scores in Hub models overall
+#'
+#' @param scores quantile based scores from the hub
+#' @param time_period string indicating which time period to make the plot for
+#' @param fig_file_dir directory to save figure
+#'
+#' @return A plot ordered by average wis over the time period
+#' @export
+make_fig5_bar_chart <- function(scores,
+                                time_period) {
+  # Overall avg wis, bias, absolute error etc
+  hub_scores_overall <- scores |>
+    dplyr::group_by(model) |>
+    dplyr::summarise(
+      avg_wis = mean(interval_score),
+      avg_bias = mean(bias),
+      avg_ae = mean(ae_median)
+    ) |>
+    dplyr::mutate(model = factor(model,
+      levels = as.character(model)[order(avg_wis)]
+    ))
+
+  colors <- plot_components()
+  p <- ggplot(hub_scores_overall) +
+    geom_bar(aes(x = model, y = avg_wis, fill = model),
+      stat = "identity", position = "dodge"
+    ) +
+    get_plot_theme(
+      x_axis_dates = TRUE,
+      y_axis_title_size = 8
+    ) +
+    theme(legend.position = "none") +
+    scale_fill_manual(values = colors$model_colors) +
+    xlab("") +
+    ylab("Average WIS")
+
+
+  return(p)
+}
+
+
+
 
 #' Get plot of WIS over time
 #'

wweval/R/plotting_style.R

@@ -102,7 +102,7 @@ plot_components <- function() {
     "hosp" = pal_model[2],
     "cfa-wwrenewal(retro)" = pal_model[1],
     "cfa-wwrenewal(real-time)" = pal_model[5],
-    "cfa-hosponlyrenewal(real-time)" = "orange3",
+    "cfa-hosponlyrenewal(real-time)*" = "orange3",
     "cfa-hosponlyrenewal(retro)" = pal_model[2],
     "COVIDhub-4_week_ensemble" = pastel_model[3],
     "COVIDhub-trained_ensemble" = pal_horizons[1],

wweval/R/score_real_time_outputs.R

@@ -220,7 +220,7 @@ format_scores_for_comparison <- function(real_time_scores,
     ) |>
     dplyr::mutate(
       location = loc_abbr_to_flusight_code(location),
-      model = "cfa-hosponlyrenewal(real-time)",
+      model = "cfa-hosponlyrenewal(real-time)*",
       type = "quantile",
       days_ahead = as.numeric(date - forecast_date),
       target = glue::glue("{days_ahead} day ahead inc hosp"),