fix warnings and empty tests

This is purely before any work on latency adjusting, and is just about
geting the tests to run without warnings or skipped tests. Getting this
involved:
1. renaming some lingering examples of p to probs and `q` to
`quantile_levels` (and some `quantile_level`s to the plural)
2. Adding snapshots so the tests for printing in population_scaling work
as intended (should probably be converted to cli_informs at some point)
3. removing the nearly empty `test-propagate_samples` which seems like
something intended that was never finished. Probably want to add an
issue if we actually want it done.
4. added a bunch of `edf`'s in unhappy `prep` steps

Author: dsweber2

R/arx_forecaster.R

@@ -289,8 +289,8 @@ print.arx_fcast <- function(x, ...) {
 }
 
 compare_quantile_args <- function(alist, tlist) {
-  default_alist <- eval(formals(arx_args_list)$quantile_level)
-  default_tlist <- eval(formals(quantile_reg)$quantile_level)
+  default_alist <- eval(formals(arx_args_list)$quantile_levels)
+  default_tlist <- eval(formals(quantile_reg)$quantile_levels)
   if (setequal(alist, default_alist)) {
     if (setequal(tlist, default_tlist)) {
       return(sort(unique(union(alist, tlist))))

tests/testthat/_snaps/population_scaling.md

@@ -0,0 +1,34 @@
+# test joining by default columns
+
+    Code
+      prep <- prep(r, jhu)
+    Message
+      Joining with `by = join_by(geo_value)`
+      Joining with `by = join_by(geo_value)`
+
+---
+
+    Code
+      b <- bake(prep, jhu)
+    Message
+      Joining with `by = join_by(geo_value)`
+      Joining with `by = join_by(geo_value)`
+
+---
+
+    Code
+      wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) %>% add_frosting(f)
+    Message
+      Joining with `by = join_by(geo_value)`
+      Joining with `by = join_by(geo_value)`
+
+---
+
+    Code
+      p <- predict(wf, latest)
+    Message
+      Joining with `by = join_by(geo_value)`
+      Joining with `by = join_by(geo_value)`
+      Joining with `by = join_by(geo_value)`
+      Joining with `by = join_by(geo_value)`
+

tests/testthat/test-dist_quantiles.R

@@ -28,17 +28,17 @@ test_that("single dist_quantiles works, quantiles are accessible", {
 
 test_that("quantile extrapolator works", {
   dstn <- dist_normal(c(10, 2), c(5, 10))
-  qq <- extrapolate_quantiles(dstn, p = c(.25, 0.5, .75))
+  qq <- extrapolate_quantiles(dstn, probs = c(.25, 0.5, .75))
   expect_s3_class(qq, "distribution")
   expect_s3_class(vctrs::vec_data(qq[1])[[1]], "dist_quantiles")
-  expect_length(parameters(qq[1])$q[[1]], 3L)
+  expect_length(parameters(qq[1])$quantile_levels[[1]], 3L)
 
 
   dstn <- dist_quantiles(list(1:4, 8:11), list(c(.2, .4, .6, .8)))
-  qq <- extrapolate_quantiles(dstn, p = c(.25, 0.5, .75))
+  qq <- extrapolate_quantiles(dstn, probs = c(.25, 0.5, .75))
   expect_s3_class(qq, "distribution")
   expect_s3_class(vctrs::vec_data(qq[1])[[1]], "dist_quantiles")
-  expect_length(parameters(qq[1])$q[[1]], 7L)
+  expect_length(parameters(qq[1])$quantile_levels[[1]], 7L)
 })
 
 test_that("small deviations of quantile requests work", {

tests/testthat/test-population_scaling.R

@@ -207,7 +207,53 @@ test_that("Postprocessing to get cases from case rate", {
 
 
 test_that("test joining by default columns", {
-  skip()
+
+  jhu <- case_death_rate_subset %>%
+    dplyr::filter(time_value > "2021-11-01", geo_value %in% c("ca", "ny")) %>%
+    dplyr::select(geo_value, time_value, case_rate)
+
+  reverse_pop_data = data.frame(geo_value = c("ca", "ny"),
+                                values = c(1/20000, 1/30000))
+
+  r <- epi_recipe(jhu) %>%
+    step_population_scaling(case_rate,
+                            df = reverse_pop_data,
+                            df_pop_col = "values",
+                            by = NULL,
+                            suffix = "_scaled") %>%
+    step_epi_lag(case_rate_scaled, lag = c(0, 7, 14)) %>% # cases
+    step_epi_ahead(case_rate_scaled, ahead = 7, role = "outcome") %>% # cases
+    recipes::step_naomit(recipes::all_predictors()) %>%
+    recipes::step_naomit(recipes::all_outcomes(), skip = TRUE)
+
+  expect_snapshot(prep <- prep(r, jhu))
+
+  expect_snapshot(b <- bake(prep, jhu))
+
+  f <- frosting() %>%
+    layer_predict() %>%
+    layer_threshold(.pred) %>%
+    layer_naomit(.pred) %>%
+    layer_population_scaling(.pred, df = reverse_pop_data,
+                             by =  NULL,
+                             df_pop_col = "values")
+
+  expect_snapshot(wf <- epi_workflow(r,
+                     parsnip::linear_reg()) %>%
+    fit(jhu) %>%
+    add_frosting(f))
+
+  latest <- get_test_data(recipe = r,
+                          x = case_death_rate_subset %>%
+                            dplyr::filter(time_value > "2021-11-01",
+                                          geo_value %in% c("ca", "ny")) %>%
+                            dplyr::select(geo_value, time_value, case_rate))
+
+
+  expect_snapshot(p <- predict(wf, latest))
+
+
+
   jhu <- case_death_rate_subset %>%
     dplyr::filter(time_value > "2021-11-01", geo_value %in% c("ca", "ny")) %>%
     dplyr::select(geo_value, time_value, case_rate)

tests/testthat/test-propagate_samples.R

@@ -34,7 +34,7 @@ test_that("step_growth_rate works for a single signal", {
 
   res <- r %>%
     step_growth_rate(value, horizon = 1) %>%
-    prep() %>%
+    prep(edf) %>%
     bake(edf)
   expect_equal(res$gr_1_rel_change_value, c(NA, 1 / 6:9))
 
@@ -46,7 +46,7 @@ test_that("step_growth_rate works for a single signal", {
   r <- epi_recipe(edf)
   res <- r %>%
     step_growth_rate(value, horizon = 1) %>%
-    prep() %>%
+    prep(edf) %>%
     bake(edf)
   expect_equal(res$gr_1_rel_change_value, rep(c(NA, 1 / 6:9), each = 2))
 })
@@ -63,7 +63,7 @@ test_that("step_growth_rate works for a two signals", {
 
   res <- r %>%
     step_growth_rate(v1, v2, horizon = 1) %>%
-    prep() %>%
+    prep(edf) %>%
     bake(edf)
   expect_equal(res$gr_1_rel_change_v1, c(NA, 1 / 6:9))
   expect_equal(res$gr_1_rel_change_v2, c(NA, 1 / 1:4))
@@ -76,7 +76,7 @@ test_that("step_growth_rate works for a two signals", {
   r <- epi_recipe(edf)
   res <- r %>%
     step_growth_rate(v1, v2, horizon = 1) %>%
-    prep() %>%
+    prep(edf) %>%
     bake(edf)
   expect_equal(res$gr_1_rel_change_v1, rep(c(NA, 1 / 6:9), each = 2))
   expect_equal(res$gr_1_rel_change_v2, rep(c(NA, 1 / 1:4), each = 2))

tests/testthat/test-step_growth_rate.R

@@ -27,13 +27,13 @@ test_that("step_lag_difference works for a single signal", {
 
   res <- r %>%
     step_lag_difference(value, horizon = 1) %>%
-    prep() %>%
+    prep(edf) %>%
     bake(edf)
   expect_equal(res$lag_diff_1_value, c(NA, rep(1, 4)))
 
   res <- r %>%
     step_lag_difference(value, horizon = 1:2) %>%
-    prep() %>%
+    prep(edf) %>%
     bake(edf)
   expect_equal(res$lag_diff_1_value, c(NA, rep(1, 4)))
   expect_equal(res$lag_diff_2_value, c(NA, NA, rep(2, 3)))
@@ -48,13 +48,13 @@ test_that("step_lag_difference works for a single signal", {
   r <- epi_recipe(edf)
   res <- r %>%
     step_lag_difference(value, horizon = 1) %>%
-    prep() %>%
+    prep(edf) %>%
     bake(edf)
   expect_equal(res$lag_diff_1_value, c(NA, NA, rep(1, 8)))
 })
 
 
-test_that("step_lag_difference works for a two signals", {
+test_that("step_lag_difference works for a two signal epi_df", {
   df <- data.frame(
     time_value = 1:5,
     geo_value = rep("a", 5),
@@ -65,7 +65,7 @@ test_that("step_lag_difference works for a two signals", {
 
   res <- r %>%
     step_lag_difference(v1, v2, horizon = 1:2) %>%
-    prep() %>%
+    prep(edf) %>%
     bake(edf)
   expect_equal(res$lag_diff_1_v1, c(NA, rep(1, 4)))
   expect_equal(res$lag_diff_2_v1, c(NA, NA, rep(2, 3)))
@@ -80,7 +80,7 @@ test_that("step_lag_difference works for a two signals", {
   r <- epi_recipe(edf)
   res <- r %>%
     step_lag_difference(v1, v2, horizon = 1:2) %>%
-    prep() %>%
+    prep(edf) %>%
     bake(edf)
   expect_equal(res$lag_diff_1_v1, rep(c(NA, rep(1, 4)), each = 2))
   expect_equal(res$lag_diff_2_v1, rep(c(NA, NA, rep(2, 3)), each = 2))