From 6f3fe79b854cd2c1a6a55e70baa8f2878208e009 Mon Sep 17 00:00:00 2001
From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com>
Date: Fri, 20 Dec 2024 13:16:51 -0500
Subject: [PATCH] Hot fix add stats for real-time (#223)

---
 _targets_eval_postprocessing.R            |  7 +++
 wweval/NAMESPACE                          |  1 +
 wweval/R/supplement_analyses_and_figs.R   | 77 +++++++++++++++++++++--
 wweval/man/get_stats_imp_forecasts_wis.Rd | 21 +++++++
 4 files changed, 100 insertions(+), 6 deletions(-)
 create mode 100644 wweval/man/get_stats_imp_forecasts_wis.Rd

diff --git a/_targets_eval_postprocessing.R b/_targets_eval_postprocessing.R
index 54d52d2..c5eb016 100644
--- a/_targets_eval_postprocessing.R
+++ b/_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(
diff --git a/wweval/NAMESPACE b/wweval/NAMESPACE
index f82a55e..159e33e 100644
--- a/wweval/NAMESPACE
+++ b/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)
diff --git a/wweval/R/supplement_analyses_and_figs.R b/wweval/R/supplement_analyses_and_figs.R
index 606b7cd..80c4d57 100644
--- a/wweval/R/supplement_analyses_and_figs.R
+++ b/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,
diff --git a/wweval/man/get_stats_imp_forecasts_wis.Rd b/wweval/man/get_stats_imp_forecasts_wis.Rd
new file mode 100644
index 0000000..21b979f
--- /dev/null
+++ b/wweval/man/get_stats_imp_forecasts_wis.Rd
@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/supplement_analyses_and_figs.R
+\name{get_stats_imp_forecasts_wis}
+\alias{get_stats_imp_forecasts_wis}
+\title{Get stats on number of improved forecasts in real time from wis}
+\usage{
+get_stats_imp_forecasts_wis(scores, threshold)
+}
+\arguments{
+\item{scores}{tibble of scores for every location, forecast date, and horizon}
+
+\item{threshold}{numeric indicating fold change for considering a forecast
+improved or worse relative to baseline, e.g. 1.1}
+}
+\value{
+table of the number of states with improvements, number of overall
+forecasts with improvements, number that got worse, etc.
+}
+\description{
+Get stats on number of improved forecasts in real time from wis
+}