pass all tests

Author: dajmcdon

R/arx_forecaster.R

@@ -200,7 +200,8 @@ arx_fcast_epi_workflow <- function(
     } else {
       quantile_levels <- sort(compare_quantile_args(
         args_list$quantile_levels,
-        rlang::eval_tidy(trainer$eng_args$quantiles) %||% c(.1, .5, .9),
+        rlang::eval_tidy(trainer$eng_args$quantiles) %||%
+          c(0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95),
         "grf"
       ))
       trainer$eng_args$quantiles <- rlang::enquo(quantile_levels)

tests/testthat/_snaps/snapshots.md

@@ -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),
-    c(0.05, 0.5, 0.95)
+    c(0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95)
   )
   expect_snapshot(
     error = TRUE,

tests/testthat/test-arx_args_list.R

@@ -8,20 +8,20 @@ test_that("layer argument extractor works", {
   expect_snapshot(error = TRUE, extract_argument(f$layers[[1]], "layer_predict", "bubble"))
   expect_identical(
     extract_argument(f$layers[[2]], "layer_residual_quantiles", "quantile_levels"),
-    c(0.0275, 0.9750)
+    c(0.0275, 0.5, 0.9750)
   )
 
   expect_snapshot(error = TRUE, extract_argument(f, "layer_thresh", "quantile_levels"))
   expect_identical(
     extract_argument(f, "layer_residual_quantiles", "quantile_levels"),
-    c(0.0275, 0.9750)
+    c(0.0275, 0.5, 0.9750)
   )
 
   wf <- epi_workflow(postprocessor = f)
   expect_snapshot(error = TRUE, extract_argument(epi_workflow(), "layer_residual_quantiles", "quantile_levels"))
   expect_identical(
     extract_argument(wf, "layer_residual_quantiles", "quantile_levels"),
-    c(0.0275, 0.9750)
+    c(0.0275, 0.5, 0.9750)
   )
 
   expect_snapshot(error = TRUE, extract_argument(wf, "layer_predict", c("type", "opts")))

tests/testthat/test-extract_argument.R

@@ -9,7 +9,10 @@ test_that("quantile_rand_forest defaults work", {
   spec <- rand_forest(engine = "grf_quantiles", mode = "regression")
   expect_silent(out <- fit(spec, formula = y ~ x + z, data = tib))
   pars <- parsnip::extract_fit_engine(out)
-  manual <- quantile_forest(as.matrix(tib[, 2:3]), tib$y, quantiles = c(0.1, 0.5, 0.9))
+  manual <- quantile_forest(
+    as.matrix(tib[, 2:3]), tib$y,
+    quantiles = c(0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95)
+  )
   expect_identical(pars$quantiles.orig, manual$quantiles.orig)
   expect_identical(pars$`_num_trees`, manual$`_num_trees`)
 
@@ -43,7 +46,8 @@ test_that("quantile_rand_forest handles alternative quantiles", {
 
 
 test_that("quantile_rand_forest handles allows setting the trees and mtry", {
-  spec <- rand_forest(mode = "regression", mtry = 2, trees = 100, engine = "grf_quantiles")
+  spec <- rand_forest(mode = "regression", mtry = 2, trees = 100) %>%
+    set_engine(engine = "grf_quantiles", quantiles = c(0.1, 0.5, 0.9))
   expect_silent(out <- fit(spec, formula = y ~ x + z, data = tib))
   pars <- parsnip::extract_fit_engine(out)
   manual <- quantile_forest(as.matrix(tib[, 2:3]), tib$y, mtry = 2, num.trees = 100)
@@ -68,13 +72,13 @@ test_that("quantile_rand_forest operates with arx_forecaster", {
   spec2 <- parsnip::extract_spec_parsnip(o)
   expect_identical(
     rlang::eval_tidy(spec2$eng_args$quantiles),
-    c(.05, .1, .5, .9, .95) # merged with arx_args default
+    c(.05, .1, 0.25, .5, 0.75, .9, .95) # merged with arx_args default
   )
   df <- epidatasets::counts_subset %>% filter(time_value >= "2021-10-01")
 
   z <- arx_forecaster(df, "cases", "cases", spec2)
   expect_identical(
     nested_quantiles(z$predictions$.pred_distn[1])[[1]]$quantile_levels,
-    c(.05, .1, .5, .9, .95)
+    c(.05, .1, 0.25, .5, 0.75, .9, .95)
   )
 })

tests/testthat/test-grf_quantiles.R

@@ -58,6 +58,7 @@ test_that("thresholds additional columns", {
   p <- p %>%
     dplyr::mutate(.quantiles = nested_quantiles(.pred_distn)) %>%
     tidyr::unnest(.quantiles)
-  expect_equal(round(p$values, digits = 3), c(0.180, 0.31, 0.180, .18, 0.310, .31))
-  expect_equal(p$quantile_levels, rep(c(.1, .9), times = 3))
+  expect_equal(round(p$values, digits = 3),
+               c(0.180, 0.180, 0.31, 0.180, 0.180, .18, 0.310, .31, .31))
+  expect_equal(p$quantile_levels, rep(c(.1, 0.5, .9), times = 3))
 })