default quantiles are the same everywhere

Author: dajmcdon

R/arx_forecaster.R

@@ -253,8 +253,8 @@ arx_fcast_epi_workflow <- function(
 #'   the last day of data. For example, if the last day of data was 3 days ago,
 #'   the ahead becomes `ahead+3`.
 #'   - `"extend_lags"`: increase the lags so they're relative to the actual
-#'   forecast date. For example, if the lags are `c(0,7,14)` and the last day of
-#'   data was 3 days ago, the lags become `c(3,10,17)`.
+#'   forecast date. For example, if the lags are `c(0, 7, 14)` and the last day of
+#'   data was 3 days ago, the lags become `c(3, 10, 17)`.
 #' @param warn_latency by default, `step_adjust_latency` warns the user if the
 #'   latency is large. If this is `FALSE`, that warning is turned off.
 #' @param quantile_levels Vector or `NULL`. A vector of probabilities to produce
@@ -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.5, 0.95),
+    quantile_levels = c(0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95),
     symmetrize = TRUE,
     nonneg = TRUE,
     quantile_by_key = character(0L),
@@ -362,7 +362,7 @@ compare_quantile_args <- function(alist, tlist, train_method = c("qr", "grf")) {
   default_alist <- eval(formals(arx_args_list)$quantile_levels)
   default_tlist <- switch(train_method,
     "qr" = eval(formals(quantile_reg)$quantile_levels),
-    "grf" = c(.1, .5, .9)
+    "grf" = c(0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95)
   )
   if (setequal(alist, default_alist)) {
     if (setequal(tlist, default_tlist)) {

R/autoplot.R

@@ -39,9 +39,7 @@ ggplot2::autoplot
 #'   step_epi_naomit()
 #'
 #' f <- frosting() %>%
-#'   layer_residual_quantiles(
-#'     quantile_levels = c(.025, .1, .25, .75, .9, .975)
-#'   ) %>%
+#'   layer_residual_quantiles() %>%
 #'   layer_threshold(starts_with(".pred")) %>%
 #'   layer_add_target_date()
 #'

R/extract.R

@@ -13,7 +13,7 @@
 #' @examples
 #' f <- frosting() %>%
 #'   layer_predict() %>%
-#'   layer_residual_quantiles(quantile_levels = c(0.0275, 0.975), symmetrize = FALSE) %>%
+#'   layer_residual_quantiles(symmetrize = FALSE) %>%
 #'   layer_naomit(.pred)
 #'
 #' extract_argument(f, "layer_residual_quantiles", "symmetrize")

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.5, 0.95),
+    quantile_levels = c(0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 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(0.25, 0.5, 0.75),
+                                 quantile_levels = c(0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95),
                                  truncate = c(-Inf, Inf),
                                  name = ".pred_distn",
                                  id = rand_id("quantile_distn")) {

R/layer_residual_quantiles.R

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

R/make_grf_quantiles.R

@@ -141,7 +141,7 @@ make_grf_quantiles <- function() {
       data = c(x = "X", y = "Y"),
       func = c(pkg = "grf", fun = "quantile_forest"),
       defaults = list(
-        quantiles = c(0.1, 0.5, 0.9),
+        quantiles = c(0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95),
         num.threads = 1L,
         seed = rlang::expr(stats::runif(1, 0, .Machine$integer.max))
       )

R/make_quantile_reg.R

@@ -12,7 +12,7 @@
 #' @param engine Character string naming the fitting function. Currently, only
 #'   "rq" and "grf" are supported.
 #' @param quantile_levels A scalar or vector of values in (0, 1) to determine which
-#'   quantiles to estimate (default is 0.5).
+#'   quantiles to estimate (default is the set 0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95).
 #' @param method A fitting method used by [quantreg::rq()]. See the
 #'   documentation for a list of options.
 #'
@@ -27,7 +27,9 @@
 #' rq_spec <- quantile_reg(quantile_levels = c(.2, .8)) %>% set_engine("rq")
 #' ff <- rq_spec %>% fit(y ~ ., data = tib)
 #' predict(ff, new_data = tib)
-quantile_reg <- function(mode = "regression", engine = "rq", quantile_levels = 0.5, method = "br") {
+quantile_reg <- function(mode = "regression", engine = "rq",
+                         quantile_levels = c(0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95),
+                         method = "br") {
   # Check for correct mode
   if (mode != "regression") {
     cli_abort("`mode` must be 'regression'")

R/make_smooth_quantile_reg.R

@@ -5,12 +5,7 @@
 #' the [tidymodels](https://www.tidymodels.org/) framework. Currently, the
 #' only supported engine is [smoothqr::smooth_qr()].
 #'
-#' @param mode A single character string for the type of model.
-#'   The only possible value for this model is "regression".
-#' @param engine Character string naming the fitting function. Currently, only
-#'   "smooth_qr" is supported.
-#' @param quantile_levels A scalar or vector of values in (0, 1) to determine which
-#'   quantiles to estimate (default is 0.5).
+#' @inheritParams quantile_reg
 #' @param outcome_locations Defaults to the vector `1:ncol(y)` but if the
 #'   responses are observed at a different spacing (or appear in a different
 #'   order), that information should be used here. This
@@ -76,7 +71,7 @@ smooth_quantile_reg <- function(
     mode = "regression",
     engine = "smoothqr",
     outcome_locations = NULL,
-    quantile_levels = 0.5,
+    quantile_levels = c(0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95),
     degree = 3L) {
   # Check for correct mode
   if (mode != "regression") cli_abort("`mode` must be 'regression'")

tests/testthat/test-layer_residual_quantiles.R

@@ -65,9 +65,9 @@ test_that("Grouping by keys is supported", {
   expect_warning(p2 <- forecast(wf2))
 
   pivot1 <- pivot_quantiles_wider(p1, .pred_distn) %>%
-    mutate(width = `0.9` - `0.1`)
+    mutate(width = `0.95` - `0.05`)
   pivot2 <- pivot_quantiles_wider(p2, .pred_distn) %>%
-    mutate(width = `0.9` - `0.1`)
+    mutate(width = `0.95` - `0.05`)
   expect_equal(pivot1$width, rep(pivot1$width[1], nrow(pivot1)))
   expect_false(all(pivot2$width == pivot2$width[1]))
 })