Predicted/actual epiweekly plots

hewr/DESCRIPTION

@@ -18,7 +18,7 @@ Imports:
     fable,
     feasts,
     forcats,
-    forecasttools (>= 0.0.0.9000),
+    forecasttools (>= 0.1.1),
     fs,
     ggdist,
     ggnewscale,

hewr/NAMESPACE

@@ -11,7 +11,7 @@ export(parse_pyrenew_model_name)
 export(parse_variable_name)
 export(process_state_forecast)
 export(read_and_combine_data)
-export(score_hubverse)
+export(score_hewr)
 export(to_epiweekly_quantile_table)
 importFrom(rlang,":=")
 importFrom(rlang,.data)

hewr/R/scoring.R

@@ -0,0 +1,53 @@
+#' Default scoring function for `pyrenew-hew`.
+#'
+#' Simple wrapper of [scoringutils::transform_forecasts()]
+#' and [scoringutils::score()] with reasonable defaults for
+#' `pyrenew-hew` production.
+#'
+#' @param scorable_table Table to score, as the output
+#' of [forecasttools::quantile_table_to_scorable()].
+#' @param transform transformation passed as the
+#' `fun` argument to [scoringutils::transform_forecasts()].
+#' Default [scoringutils::log_shift()].
+#' @param offset Offset for the transformation, passed to
+#' [scoringutils::transform_forecasts()]. Default 1.
+#' @param append_transformed When calling
+#' [scoringutils::transform_forecasts()], append
+#' the transformed scale forecasts to the base scale forecasts
+#' or keep only the transformed scale forecasts? Passed as the
+#' `append` argument to [scoringutils::transform_forecasts()].
+#' Boolean, default `FALSE` (keep only transformed scale).
+#' @param ... Other keyword arguments passed to
+#' [scoringutils::transform_forecasts()].
+#' @return A table of scores, as the output of
+#' [scoringutils::score()], filtered to include only the
+#' transformed_scale.
+#' @export
+score_hewr <- function(scorable_table,
+                       transform = scoringutils::log_shift,
+                       append_transformed = FALSE,
+                       offset = 1,
+                       ...) {
+  to_score <- scorable_table |>
+    scoringutils::transform_forecasts(
+      fun = transform,
+      append = append_transformed,
+      offset = offset,
+      ...
+    )
+
+  interval_coverage_95 <- purrr::partial(
+    scoringutils::interval_coverage,
+    interval_range = 95
+  )
+
+  scored <- to_score |>
+    scoringutils::score(
+      metrics = c(
+        scoringutils::get_metrics(to_score),
+        interval_coverage_95 = interval_coverage_95
+      )
+    )
+
+  return(scored)
+}

hewr/tests/testthat/test_score_hubverse.R → hewr/tests/testthat/test_hubverse_score.R

@@ -35,16 +35,15 @@ testthat::test_that("score_hubverse works as expected with valid inputs", {
     length(date_range) * length(locations)
   )
 
-  scored <- score_hubverse(forecast, observed)
-  expect_setequal(forecast$location, scored$location)
-  expect_setequal(scored$horizon, c(0, 1))
+  scored <- forecasttools::quantile_table_to_scorable(
+    forecast,
+    observed,
+    obs_date_column = "reference_date"
+  ) |>
+    score_hewr()
 
-  scored_all_horizon <- score_hubverse(
-    forecast, observed,
-    horizons = c(0, 1, 2)
-  )
-  expect_setequal(forecast$location, scored_all_horizon$location)
-  expect_setequal(forecast$horizon, scored_all_horizon$horizon)
+  expect_setequal(forecast$location, scored$location)
+  expect_setequal(forecast$horizon, scored$horizon)
 })
 
 
@@ -68,13 +67,18 @@ testthat::test_that("score_hubverse handles missing location data", {
     locations = c("loc1")
   )
 
-  result <- score_hubverse(forecast, observed)
+  result <- forecasttools::quantile_table_to_scorable(
+    forecast,
+    observed,
+    obs_date_column = "reference_date"
+  ) |>
+    score_hewr()
   expect_false("loc2" %in% result$location)
   expect_setequal(observed$location, result$location)
 })
 
 
-testthat::test_that("score_hubverse handles zero length forecast table", {
+testthat::test_that("score_hewr handles zero length forecast table", {
   forecast <- tibble::tibble(
     reference_date = as.Date(character(0)),
     horizon = integer(0),
@@ -95,7 +99,15 @@ testthat::test_that("score_hubverse handles zero length forecast table", {
   )
 
   expect_error(
-    result <- score_hubverse(forecast, observed),
-    "Assertion on 'data' failed: Must have at least 1 rows, but has 0 rows."
+    forecasttools::quantile_table_to_scorable(
+      forecast,
+      observed,
+      obs_date_column = "reference_date"
+    ) |>
+      score_hewr(),
+    paste0(
+      "Assertion on 'data' failed: ",
+      "Must have at least 1 rows, but has 0 rows."
+    )
   )
 })