Hot fix add stats for real-time (#223)

_targets_eval_postprocessing.R

@@ -1934,6 +1934,13 @@ supp_targets <- list(
       threshold = 1.1
     )
   ),
+  tar_target(
+    name = comp_stats_rt,
+    command = get_stats_imp_forecasts_wis(
+      scores = wis_scores_rt_summarized,
+      threshold = 1.1
+    )
+  ),
   tar_target(
     name = ww_quants_plot_supp,
     command = combine_outputs(

wweval/NAMESPACE

@@ -62,6 +62,7 @@ export(get_scores_from_quantiles)
 export(get_secret)
 export(get_state_level_quantiles)
 export(get_state_level_ww_quantiles)
+export(get_stats_imp_forecasts_wis)
 export(get_stats_improved_forecasts)
 export(get_summary_metadata)
 export(get_summary_ww_table)

wweval/R/supplement_analyses_and_figs.R

@@ -689,12 +689,12 @@ get_stats_improved_forecasts <- function(scores,
 
 
   forecasts_way_worse <- relative_crps_by_forecast |>
-    dplyr::filter(rel_crps > 4)
-  n_forecasts_4x_worse <- forecasts_way_worse |> nrow()
+    dplyr::filter(rel_crps > 3)
+  n_forecasts_3x_worse <- forecasts_way_worse |> nrow()
 
   forecasts_way_better <- relative_crps_by_forecast |>
-    dplyr::filter(rel_crps < 1 / 4)
-  n_forecasts_4x_better <- forecasts_way_better |> nrow()
+    dplyr::filter(rel_crps < 1 / 3)
+  n_forecasts_3x_better <- forecasts_way_better |> nrow()
 
   n_forecasts_better <- relative_crps_by_forecast |>
     dplyr::filter(rel_crps < 1) |>
@@ -726,13 +726,78 @@ get_stats_improved_forecasts <- function(scores,
     n_forecasts_worse,
     n_forecasts_better_thres,
     n_forecasts_worse_thres,
-    n_forecasts_4x_worse,
-    n_forecasts_4x_better
+    n_forecasts_3x_worse,
+    n_forecasts_3x_better
   )
 
   return(stats)
 }
 
+#' Get stats on number of improved forecasts in real time from wis
+#'
+#' @param scores tibble of scores for every location, forecast date, and horizon
+#' @param threshold numeric indicating fold change for considering a forecast
+#' improved or worse relative to baseline, e.g. 1.1
+#'
+#' @return table of the number of states with improvements, number of overall
+#' forecasts with improvements, number that got worse, etc.
+#' @export
+get_stats_imp_forecasts_wis <- function(scores,
+                                        threshold) {
+  relative_wis_by_forecast <- scores |>
+    dplyr::group_by(location, model, forecast_date) |>
+    dplyr::summarize(mean_wis = mean(interval_score)) |>
+    tidyr::pivot_wider(
+      names_from = model,
+      values_from = mean_wis,
+      id_cols = c("location", "forecast_date")
+    ) |>
+    dplyr::mutate(
+      rel_wis = ww / hosp,
+    )
+
+  forecasts_way_worse <- relative_wis_by_forecast |>
+    dplyr::filter(rel_wis > 3)
+  n_forecasts_3x_worse <- forecasts_way_worse |> nrow()
+
+  forecasts_way_better <- relative_wis_by_forecast |>
+    dplyr::filter(rel_wis < 1 / 3)
+  n_forecasts_3x_better <- forecasts_way_better |> nrow()
+
+  n_forecasts_better <- relative_wis_by_forecast |>
+    dplyr::filter(rel_wis < 1) |>
+    nrow()
+
+  n_forecasts_worse <- relative_wis_by_forecast |>
+    dplyr::filter(rel_wis > 1) |>
+    nrow()
+
+  n_forecasts_better_thres <- relative_wis_by_forecast |>
+    dplyr::filter(
+      rel_wis < 1 / threshold
+    ) |>
+    nrow()
+
+  n_forecasts_worse_thres <- relative_wis_by_forecast |>
+    dplyr::filter(
+      rel_wis > threshold
+    ) |>
+    nrow()
+
+  stats <- tibble::tibble(
+    n_forecasts_better,
+    n_forecasts_worse,
+    n_forecasts_better_thres,
+    n_forecasts_worse_thres,
+    n_forecasts_3x_worse,
+    n_forecasts_3x_better
+  )
+
+  return(stats)
+}
+
+
+
 
 
 get_plot_sites_vs_performance <- function(scores,