914: Remove the use of deprecated functionality in examples/tests/vig…

…nettes (#939) * remove use of filter_leading_zeros * remove use of `horizon` * update examples
epiforecasts · Jan 30, 2025 · 046857e · 046857e
1 parent 97d92eb
commit 046857e
Show file tree

Hide file tree

Showing 14 changed files with 55 additions and 25 deletions.
diff --git a/R/dist_spec.R b/R/dist_spec.R
@@ -1007,7 +1007,6 @@ LogNormal <- function(meanlog, sdlog, mean, sd, ...) {
 #' Gamma(mean = 4, sd = 1)
 #' Gamma(shape = 16, rate = 4)
 #' Gamma(shape = Normal(16, 2), rate = Normal(4, 1))
-#' Gamma(shape = Normal(16, 2), scale = Normal(1/4, 1))
 Gamma <- function(shape, rate, scale, mean, sd, ...) {
   params <- as.list(environment())
   return(new_dist_spec(params, "gamma", ...))

diff --git a/R/epinow.R b/R/epinow.R
@@ -106,7 +106,21 @@ epinow <- function(data,
       "epinow(data)"
     )
   }
-  if (!missing(horizon)) {
+  if (!missing(filter_leading_zeros)) {
+    lifecycle::deprecate_warn(
+      "1.7.0",
+      "estimate_infections(filter_leading_zeros)",
+      "filter_leading_zeros()"
+    )
+  }
+  if (!missing(zero_threshold)) {
+    lifecycle::deprecate_warn(
+      "1.7.0",
+      "estimate_infections(zero_threshold)",
+      "apply_zero_threshold()"
+    )
+  }
+   if (!missing(horizon)) {
     lifecycle::deprecate_warn(
       "1.7.0",
       "epinow(horizon)",
@@ -171,6 +185,9 @@ epinow <- function(data,
   latest_folder <- target_folders$latest
 
   # specify internal functions
+  # temporary vars while argument not deprecated
+  filter_leading_zeros_missing <- missing(filter_leading_zeros)
+  zero_threshold_missing <- missing(zero_threshold)
   epinow_internal <- function() {
     # check verbose settings and set logger to match---------------------------
     if (verbose) {
@@ -189,7 +206,9 @@ epinow <- function(data,
     horizon <- update_horizon(forecast$horizon, target_date, reported_cases)
 
     # estimate infections and Reproduction no ---------------------------------
-    estimates <- estimate_infections(
+    # use do.call until filter_leading_zeros and zero_threshold are fully
+    # deprecated
+    estimate_infection_args <- list(
       data = reported_cases,
       generation_time = generation_time,
       delays = delays,
@@ -201,11 +220,17 @@ epinow <- function(data,
       forecast = forecast,
       stan = stan,
       CrIs = CrIs,
-      filter_leading_zeros = filter_leading_zeros,
-      zero_threshold = zero_threshold,
       verbose = verbose,
       id = id
     )
+    if (!filter_leading_zeros_missing) {
+      estimate_infection_args$filter_leading_zeros <- filter_leading_zeros
+    }
+    if (!zero_threshold_missing) {
+      estimate_infection_args$zero_threshold <- zero_threshold
+    }
+
+    estimates <- do.call(estimate_infections, estimate_infection_args)
 
     if (!output["fit"]) {
       estimates$fit <- NULL

diff --git a/R/estimate_truncation.R b/R/estimate_truncation.R
@@ -99,6 +99,7 @@
 #' # all the previous snapshots. Also, we're using the default options for
 #' # illustrative purposes only.
 #' out <- epinow(
+#'   generation_time = generation_time_opts(example_generation_time),
 #'   example_truncated[[5]],
 #'   truncation = trunc_opts(est$dist)
 #' )

diff --git a/R/opts.R b/R/opts.R
@@ -527,7 +527,7 @@ backcalc_opts <- function(prior = c("reports", "none", "infections"),
 #' gp_opts()
 #'
 #' # add a custom length scale
-#' gp_opts(ls_mean = 4)
+#' gp_opts(ls = LogNormal(mean = 4, sd = 1, max = 20))
 #'
 #' # use linear kernel
 #' gp_opts(kernel = "periodic")

diff --git a/R/simulate_infections.R b/R/simulate_infections.R
@@ -270,7 +270,8 @@ simulate_infections <- function(estimates, R, initial_infections,
 #'   delays = delay_opts(example_incubation_period + example_reporting_delay),
 #'   rt = rt_opts(prior = LogNormal(mean = 2, sd = 0.1), rw = 7),
 #'   obs = obs_opts(scale = Normal(mean = 0.1, sd = 0.01)),
-#'   gp = NULL, horizon = 0
+#'   gp = NULL,
+#'   forecast = forecast_opts(horizon = 0)
 #' )
 #'
 #' # update Rt trajectory and simulate new infections using it

diff --git a/inst/dev/recover-synthetic/rt.R b/inst/dev/recover-synthetic/rt.R
@@ -15,7 +15,8 @@ init <- estimate_infections(example_confirmed[1:100],
   generation_time = gt_opts(example_generation_time),
   delays = delay_opts(example_incubation_period + example_reporting_delay),
   rt = rt_opts(prior = LogNormal(mean = 2, sd = 0.1), rw = 14),
-  gp = NULL, horizon = 0,
+  gp = NULL,
+  forecast = forecast_opts(horizon = 0),
   obs = obs
 )
 
@@ -62,7 +63,7 @@ for (method in c("nuts")) {
       rt = rt_opts(prior = LogNormal(mean = 2, sd = 0.25)),
       stan = stanopts,
       obs = obs,
-      horizon = 0
+      forecast = forecast_opts(horizon = 0)
     )
   # runtime ~ 10 minutes
   make_plots(
@@ -77,7 +78,7 @@ for (method in c("nuts")) {
       rt = NULL,
       stan = stanopts,
       obs = obs,
-      horizon = 0
+      forecast = forecast_opts(horizon = 0)
     )
   # runtime ~ 15 seconds
   make_plots(
@@ -96,7 +97,7 @@ for (method in c("nuts")) {
       gp = NULL,
       stan = stanopts,
       obs = obs,
-      horizon = 0
+      forecast = forecast_opts(horizon = 0)
     )
   # runtime ~ 5 minutes
   make_plots(
@@ -113,7 +114,7 @@ for (method in c("nuts")) {
       ),
       stan = stanopts,
       obs = obs,
-      horizon = 0
+      forecast = forecast_opts(horizon = 0)
     )
 
   # runtime ~ 10 minutes
@@ -136,7 +137,7 @@ for (method in c("nuts")) {
         gp = NULL,
         stan = stanopts,
         obs = obs,
-        horizon = 0
+        forecast = forecast_opts(horizon = 0)
       )
     # runtime ~ 10 minutes (with 40+ divergent transitions)
     make_plots(

diff --git a/man/Distributions.Rd b/man/Distributions.Rd
diff --git a/man/estimate_truncation.Rd b/man/estimate_truncation.Rd
diff --git a/man/forecast_infections.Rd b/man/forecast_infections.Rd
diff --git a/man/gp_opts.Rd b/man/gp_opts.Rd
diff --git a/tests/testthat/test-estimate_secondary.R b/tests/testthat/test-estimate_secondary.R
@@ -227,27 +227,29 @@ test_that("estimate_secondary works with filter_leading_zeros set", {
   ## testing deprecated functionality
   withr::local_options(lifecycle_verbosity = "quiet")
   modified_data <- inc_cases[1:10, secondary := 0]
+  modified_data <- filter_leading_zeros(modified_data, obs_column = "secondary")
   out <- suppressWarnings(estimate_secondary(
     modified_data,
     obs = obs_opts(scale = Normal(mean = 0.2, sd = 0.2),
     week_effect = FALSE),
-    filter_leading_zeros = TRUE,
     verbose = FALSE
   ))
   expect_s3_class(out, "estimate_secondary")
   expect_named(out, c("predictions", "posterior", "data", "fit"))
-  expect_equal(out$predictions$primary, modified_data$primary[-(1:10)])
+  expect_equal(out$predictions$primary, modified_data$primary)
 })
 
 test_that("estimate_secondary works with zero_threshold set", {
   ## testing deprecated functionality
   withr::local_options(lifecycle_verbosity = "quiet")
   modified_data <- inc_cases[sample(1:30, 10), primary := 0]
+  modified_data <- apply_zero_threshold(
+    modified_data, threshold = 10, obs_column = "secondary"
+  )
   out <- estimate_secondary(
     modified_data,
     obs = obs_opts(scale = Normal(mean = 0.2, sd = 0.2),
                    week_effect = FALSE),
-    zero_threshold = 10,
     verbose = FALSE
   )
   expect_s3_class(out, "estimate_secondary")

diff --git a/tests/testthat/test-estimate_truncation.R b/tests/testthat/test-estimate_truncation.R
@@ -45,10 +45,10 @@ test_that("estimate_truncation works with filter_leading_zeros set", {
   # earlier dataset is corrected to be the same as the final dataset.
   modified_data <- data.table::copy(example_truncated)
   modified_data[[1]][1:3, confirm := 0]
+  modified_data <- lapply(modified_data, filter_leading_zeros)
   modified_data_fit <- estimate_truncation(
     modified_data,
-    verbose = FALSE, chains = 2, iter = 1000, warmup = 250,
-    filter_leading_zeros = TRUE
+    verbose = FALSE, chains = 2, iter = 1000, warmup = 250
   )
   # fit model to original dataset
   original_data_fit <- estimate_truncation(
@@ -76,9 +76,9 @@ test_that("estimate_truncation works with zero_threshold set", {
   # but with filter_leading_zeros = TRUE
   modified_data <- example_truncated
   modified_data <- purrr::map(modified_data, function(x) x[sample(1:10, 6), confirm := 0])
+  modified_data <- lapply(modified_data, apply_zero_threshold, threshold = 1)
   out <- estimate_truncation(modified_data,
-                             verbose = FALSE, chains = 2, iter = 1000, warmup = 250,
-                             zero_threshold = 1
+                             verbose = FALSE, chains = 2, iter = 1000, warmup = 250
   )
   expect_named(out, c("dist", "obs", "last_obs", "cmf", "data", "fit"))
   expect_s3_class(out$dist, "dist_spec")

diff --git a/vignettes/estimate_infections_options.Rmd b/vignettes/estimate_infections_options.Rmd
@@ -528,7 +528,7 @@ non_parametric <- estimate_infections(reported_cases,
   delays = delay_opts(delay),
   rt = NULL,
   backcalc = backcalc_opts(),
-  horizon = 0
+  forecast = forecast_opts(horizon = 0)
 )
 # summarise results
 summary(non_parametric)

diff --git a/vignettes/estimate_infections_options.Rmd.orig b/vignettes/estimate_infections_options.Rmd.orig
@@ -315,7 +315,7 @@ non_parametric <- estimate_infections(reported_cases,
   delays = delay_opts(delay),
   rt = NULL,
   backcalc = backcalc_opts(),
-  horizon = 0
+  forecast = forecast_opts(horizon = 0)
 )
 # summarise results
 summary(non_parametric)