Canned median quantile

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: epipredict
 Title: Basic epidemiology forecasting methods
-Version: 0.1.7
+Version: 0.1.8
 Authors@R: c(
     person("Daniel J.", "McDonald", , "[email protected]", role = c("aut", "cre")),
     person("Ryan", "Tibshirani", , "[email protected]", role = "aut"),

NEWS.md

@@ -25,6 +25,7 @@ Pre-1.0.0 numbering scheme: 0.x will indicate releases, while 0.0.x will indicat
 - Shifting no columns results in no error for either `step_epi_ahead` and `step_epi_lag`
 - Quantiles produced by `grf` were sometimes out of order.
 - dist_quantiles can have all `NA` values without causing unrelated errors
+- add `0.5` as a default quantile for canned forecasters to avoid strange thresholding behavior
 
 # epipredict 0.1
 

R/arx_forecaster.R

@@ -295,7 +295,7 @@ arx_args_list <- function(
     target_date = NULL,
     adjust_latency = c("none", "extend_ahead", "extend_lags", "locf"),
     warn_latency = TRUE,
-    quantile_levels = c(0.05, 0.95),
+    quantile_levels = c(0.05, 0.5, 0.95),
     symmetrize = TRUE,
     nonneg = TRUE,
     quantile_by_key = character(0L),

R/autoplot.R

@@ -236,19 +236,20 @@ plot_bands <- function(
     alpha = 0.6,
     linewidth = 0.05) {
   innames <- names(predictions)
-  n <- length(levels)
-  alpha <- alpha / (n - 1)
-  l <- (1 - levels) / 2
-  l <- c(rev(l), 1 - l)
+  na_levels <- length(levels)
+  alpha <- alpha / (n_levels - 1)
+  # generate the corresponding level that is 1 - level
+  levels <- (1 - levels) / 2
+  levels <- c(rev(levels), 1 - levels)
 
   ntarget_dates <- dplyr::n_distinct(predictions$time_value)
 
   predictions <- predictions %>%
-    mutate(.pred_distn = dist_quantiles(quantile(.pred_distn, l), l)) %>%
+    mutate(.pred_distn = dist_quantiles(quantile(.pred_distn, levels), levels)) %>%
     pivot_quantiles_wider(.pred_distn)
   qnames <- setdiff(names(predictions), innames)
 
-  for (i in 1:n) {
+  for (i in 1:n_levels) {
     bottom <- qnames[i]
     top <- rev(qnames)[i]
     if (i == 1) {

R/flatline_forecaster.R

@@ -108,7 +108,7 @@ flatline_args_list <- function(
     n_training = Inf,
     forecast_date = NULL,
     target_date = NULL,
-    quantile_levels = c(0.05, 0.95),
+    quantile_levels = c(0.05, 0.5, 0.95),
     symmetrize = TRUE,
     nonneg = TRUE,
     quantile_by_key = character(0L),

R/layer_quantile_distn.R

@@ -44,7 +44,7 @@
 #' p
 layer_quantile_distn <- function(frosting,
                                  ...,
-                                 quantile_levels = c(.25, .75),
+                                 quantile_levels = c(0.25, 0.5, 0.75),
                                  truncate = c(-Inf, Inf),
                                  name = ".pred_distn",
                                  id = rand_id("quantile_distn")) {

R/layer_residual_quantiles.R

@@ -48,7 +48,7 @@
 #' p2 <- forecast(wf2)
 layer_residual_quantiles <- function(
     frosting, ...,
-    quantile_levels = c(0.05, 0.95),
+    quantile_levels = c(0.05, 0.5, 0.95),
     symmetrize = TRUE,
     by_key = character(0L),
     name = ".pred_distn",

tests/testthat/test-arx_args_list.R

@@ -41,7 +41,7 @@ test_that("arx forecaster disambiguates quantiles", {
   tlist <- eval(formals(quantile_reg)$quantile_levels)
   expect_identical( # both default
     compare_quantile_args(alist, tlist),
-    sort(c(alist, tlist))
+    c(0.05, 0.5, 0.95)
   )
   expect_snapshot(
     error = TRUE,