a

Author: dshemetov

R/forecasters/forecaster_scaled_pop.R

@@ -156,15 +156,6 @@ scaled_pop <- function(epi_data,
   if (adding_source) {
     pred_final %<>% select(-source)
   }
-  browser()
-  res %>%
-    group_by(geo_value, forecast_date, target_end_date) %>%
-    summarize(increasing = all(hhs - shift(hhs, 1, -Inf) > 0)) %>%
-    ungroup() %>%
-    filter(!increasing)
-
-  res %>%
-    filter(geo_value == "ma", forecast_date == "2023-10-18", target_end_date == "2023-10-18")
   gc()
   return(pred_final)
 }

scripts/covid_hosp_explore.R

@@ -10,7 +10,7 @@ if (!exists("ref_time_values_")) {
   end_date <- as.Date("2024-04-24")
   # end_date <- start_date + 7 * 10
   date_step <- 7L
-  ref_time_values_ <- seq.Date(start_date, end_date, by = 7L)[3]
+  ref_time_values_ <- seq.Date(start_date, end_date, by = 7L)
 }
 time_value_adjust <- 3 # this moves the week marker from Saturday to Wednesday
 

scripts/flu_hosp_prod.R

@@ -397,7 +397,6 @@ rlang::list2(
     tar_target(
       name = truth_data,
       command = {
-        browser()
         date <- forecast_generation_date_int
         nssp_state <-
           current_nssp_archive %>%

scripts/reports/comparison-notebook.Rmd

@@ -1,5 +1,5 @@
 ---
-title: "`r params$forecaster_family`: evaluation on 2023/24 in 2024/25" 
+title: "`r params$forecaster_family`: evaluation on 2023/24 in 2024/25"
 date: "compiled on `r format(Sys.time(), '%d %B %Y')`"
 output:
   html_document:
@@ -116,12 +116,12 @@ param_table <- params$forecaster_parameters %>%
         geomean_ae = round(GeoMean(ae), 2),
         mean_wis = round(Mean(wis), 2),
         geomean_wis = round(GeoMean(wis), 2),
-        mean_coverage_80 = round(Mean(coverage_80), 2),
+        mean_coverage_90 = round(Mean(coverage_90), 2),
       ) %>%
       rename(id = forecaster)
   ) %>%
   arrange(mean_ae) %>%
-  relocate(id, mean_ae, geomean_ae, mean_wis, geomean_wis, mean_coverage_80)
+  relocate(id, mean_ae, geomean_ae, mean_wis, geomean_wis, mean_coverage_90)
 datatable(param_table)
 ```
 
@@ -499,10 +499,10 @@ ggplotly(p, tooltip = "text", height = 800, width = 1000) %>%
   layout(hoverlabel = list(bgcolor = "white"))
 ```
 
-#### % Coverage by Forecast Date
+#### 90% Coverage by Forecast Date
 
 ```{r}
-var <- "coverage_80"
+var <- "coverage_90"
 group_cols <- c("forecaster", "forecast_date", "ahead")
 
 # Aggregate metric across groups
@@ -539,16 +539,16 @@ p <- ggplot(
   facet_wrap(~ahead, nrow = 4, labeller = labeller(ahead = facets.label)) +
   scale_color_discrete() +
   guides(color = guide_legend(ncol = 2)) +
-  labs(title = subtitle, x = "Forecast Dates", y = "Arithmetic Mean 80% Coverage")
+  labs(title = subtitle, x = "Forecast Dates", y = "Arithmetic Mean 90% Coverage")
 
 ggplotly(p, tooltip = "text", height = 800, width = 1000) %>%
   layout(hoverlabel = list(bgcolor = "white"))
 ```
 
-#### % Coverage by Ahead
+#### 90% Coverage by Ahead
 
 ```{r}
-var <- "coverage_80"
+var <- "coverage_90"
 id_cols <- c("forecaster", "ahead")
 
 # Aggregate metric across groups
@@ -582,15 +582,15 @@ p <- ggplot(
   geom_hline(yintercept = .8, linetype = 1, color = "black") +
   scale_color_discrete() +
   guides(color = guide_legend(ncol = 2)) +
-  labs(title = subtitle, x = "Days ahead", y = "Arithmetic Mean 80% Coverage")
+  labs(title = subtitle, x = "Days ahead", y = "Arithmetic Mean 90% Coverage")
 
 ggplotly(p, tooltip = "text", height = 800, width = 1000) %>%
   layout(hoverlabel = list(bgcolor = "white"))
 ```
 
 ### Fan plots {.tabset}
 
-Fan plots showing the 80% prediction intervals for the forecasts made by the CMU forecasters and the outside forecasters. The black line is the truth data.
+Fan plots showing the 90% prediction intervals for the forecasts made by the CMU forecasters and the outside forecasters. The black line is the truth data.
 
 ```{r}
 if (params$disease == "flu") {

scripts/targets-exploration-common.R

@@ -154,9 +154,6 @@ make_forecasts_and_scores <- function() {
     tar_target(
       name = forecast,
       command = {
-        debugonce(scaled_pop)
-        debugonce(slide_forecaster)
-        browser()
         slid <- slide_forecaster(
           epi_archive = joined_archive_data,
           outcome = "hhs",