Remove examples with long runtimes

DESCRIPTION

@@ -133,6 +133,7 @@ Suggests:
     styler,
     testthat,
     tidyr,
+    usethis,
     withr
 LinkingTo: 
     BH (>= 1.66.0),

NEWS.md

@@ -1,5 +1,9 @@
 # EpiNow2 1.4.9000
 
+## Package
+
+* Reduced the number of long-running examples.
+
 # EpiNow2 1.4.0
 
 This release contains some bug fixes, minor new features, and the initial stages of some broader improvement to future handling of delay distributions.

R/estimate_infections.R

@@ -91,7 +91,7 @@
 #'   sd = convert_to_logsd(2, 1), sd_sd = 0, max = 10
 #' )
 #'
-#' # default settings but assuming that delays are fixed rather than uncertain
+#' # for more examples, see the "estimate_infections examples" vignette
 #' def <- estimate_infections(reported_cases,
 #'   generation_time = generation_time_opts(generation_time),
 #'   delays = delay_opts(incubation_period + reporting_delay),
@@ -102,141 +102,6 @@
 #' summary(def)
 #' # summary plot
 #' plot(def)
-#'
-#' # decreasing the accuracy of the approximate Gaussian to speed up
-#' #computation.
-#' # These settings are an area of active research. See ?gp_opts for details.
-#' agp <- estimate_infections(reported_cases,
-#'   generation_time = generation_time_opts(generation_time),
-#'   delays = delay_opts(incubation_period + reporting_delay),
-#'   rt = rt_opts(prior = list(mean = 2, sd = 0.1)),
-#'   gp = gp_opts(ls_min = 10, basis_prop = 0.1),
-#'   stan = stan_opts(control = list(adapt_delta = 0.95))
-#' )
-#' summary(agp)
-#' plot(agp)
-#'
-#' # Adjusting for future susceptible depletion
-#' dep <- estimate_infections(reported_cases,
-#'   generation_time = generation_time_opts(generation_time),
-#'   delays = delay_opts(incubation_period + reporting_delay),
-#'   rt = rt_opts(
-#'     prior = list(mean = 2, sd = 0.1),
-#'     pop = 1000000, future = "latest"
-#'   ),
-#'   gp = gp_opts(ls_min = 10, basis_prop = 0.1), horizon = 21,
-#'   stan = stan_opts(control = list(adapt_delta = 0.95))
-#' )
-#' plot(dep)
-#'
-#' # Adjusting for truncation of the most recent data
-#' # See estimate_truncation for an approach to estimating this from data
-#' trunc_dist <- dist_spec(
-#'   mean = convert_to_logmean(0.5, 0.5), mean_sd = 0.1,
-#'   sd = convert_to_logsd(0.5, 0.5), sd_sd = 0.1,
-#'   max = 3
-#' )
-#' trunc <- estimate_infections(reported_cases,
-#'   generation_time = generation_time_opts(generation_time),
-#'   delays = delay_opts(incubation_period + reporting_delay),
-#'   truncation = trunc_opts(trunc_dist),
-#'   rt = rt_opts(prior = list(mean = 2, sd = 0.1)),
-#'   gp = gp_opts(ls_min = 10, basis_prop = 0.1),
-#'   stan = stan_opts(control = list(adapt_delta = 0.95))
-#' )
-#' plot(trunc)
-#'
-#' # using back calculation (combined here with under reporting)
-#' # this model is in the order of 10 ~ 100 faster than the gaussian process
-#' # method
-#' # it is likely robust for retrospective Rt but less reliable for real time
-#' # estimates
-#' # the width of the prior window controls the reliance on observed data and
-#' # can be optionally switched off using backcalc_opts(prior = "none"),
-#' # see ?backcalc_opts for other options
-#' backcalc <- estimate_infections(reported_cases,
-#'   generation_time = generation_time_opts(generation_time),
-#'   delays = delay_opts(incubation_period + reporting_delay),
-#'   rt = NULL, backcalc = backcalc_opts(),
-#'   obs = obs_opts(scale = list(mean = 0.4, sd = 0.05)),
-#'   horizon = 0
-#' )
-#' plot(backcalc)
-#'
-#' # Rt projected into the future using the Gaussian process
-#' project_rt <- estimate_infections(reported_cases,
-#'   generation_time = generation_time_opts(generation_time),
-#'   delays = delay_opts(incubation_period + reporting_delay),
-#'   rt = rt_opts(
-#'     prior = list(mean = 2, sd = 0.1),
-#'     future = "project"
-#'   )
-#' )
-#' plot(project_rt)
-#'
-#' # default settings on a later snapshot of data
-#' snapshot_cases <- example_confirmed[80:130]
-#' snapshot <- estimate_infections(snapshot_cases,
-#'   generation_time = generation_time_opts(generation_time),
-#'   delays = delay_opts(incubation_period + reporting_delay),
-#'   rt = rt_opts(prior = list(mean = 1, sd = 0.1))
-#' )
-#' plot(snapshot)
-#'
-#' # stationary Rt assumption (likely to provide biased real-time estimates)
-#' # with uncertain reporting delays
-#' stat <- estimate_infections(reported_cases,
-#'   generation_time = generation_time_opts(generation_time),
-#'   delays = delay_opts(incubation_period_uncertain + reporting_delay),
-#'   rt = rt_opts(prior = list(mean = 2, sd = 0.1), gp_on = "R0")
-#' )
-#' plot(stat)
-#'
-#' # no gaussian process (i.e fixed Rt assuming no breakpoints)
-#' # with uncertain reporting delays
-#' fixed <- estimate_infections(reported_cases,
-#'   generation_time = generation_time_opts(generation_time),
-#'   delays = delay_opts(incubation_period_uncertain + reporting_delay),
-#'   gp = NULL
-#' )
-#' plot(fixed)
-#'
-#' # no delays
-#' no_delay <- estimate_infections(
-#'   reported_cases,
-#'   generation_time = generation_time_opts(generation_time)
-#' )
-#' plot(no_delay)
-#'
-#' # break point but otherwise static Rt
-#' # with uncertain reporting delays
-#' bp_cases <- data.table::copy(reported_cases)
-#' bp_cases <- bp_cases[,
-#'  breakpoint := ifelse(date == as.Date("2020-03-16"), 1, 0)
-#' ]
-#' bkp <- estimate_infections(bp_cases,
-#'   generation_time = generation_time_opts(generation_time),
-#'   delays = delay_opts(incubation_period_uncertain + reporting_delay),
-#'   rt = rt_opts(prior = list(mean = 2, sd = 0.1)),
-#'   gp = NULL
-#' )
-#' # break point effect
-#' summary(bkp, type = "parameters", params = "breakpoints")
-#' plot(bkp)
-#'
-#' # weekly random walk
-#' # with uncertain reporting delays
-#' rw <- estimate_infections(reported_cases,
-#'   generation_time = generation_time_opts(generation_time),
-#'   delays = delay_opts(incubation_period_uncertain + reporting_delay),
-#'   rt = rt_opts(prior = list(mean = 2, sd = 0.1), rw = 7),
-#'   gp = NULL
-#' )
-#'
-#' # random walk effects
-#' summary(rw, type = "parameters", params = "breakpoints")
-#' plot(rw)
-#'
 #' options(old_opts)
 #' }
 estimate_infections <- function(reported_cases,

R/get.R

@@ -70,43 +70,13 @@ get_raw_result <- function(file, region, date,
 #' @importFrom purrr map safely
 #' @importFrom data.table rbindlist
 #' @examples
-#' \donttest{
-#' # construct example distributions
-#' generation_time <- get_generation_time(
-#'  disease = "SARS-CoV-2", source = "ganyani"
-#' )
-#' incubation_period <- get_incubation_period(
-#'  disease = "SARS-CoV-2", source = "lauer"
-#' )
-#' reporting_delay <- estimate_delay(rlnorm(100, log(6), 1), max_value = 10)
-#'
-#' # example case vector
-#' cases <- example_confirmed[1:30]
-#' cases <- data.table::rbindlist(list(
-#'   data.table::copy(cases)[, region := "testland"],
-#'   cases[, region := "realland"]
+#' # get example multiregion estimates
+#' regional_out <- readRDS(system.file(
+#'     package = "EpiNow2", "extdata", "example_regional_epinow.rds"
 #' ))
 #'
-#' # save results to tmp folder
-#' dir <- file.path(tempdir(check = TRUE), "results")
-#' # run multiregion estimates
-#' regional_out <- regional_epinow(
-#'   reported_cases = cases,
-#'   generation_time = generation_time_opts(generation_time),
-#'   delays = delay_opts(incubation_period + reporting_delay),
-#'   rt = rt_opts(rw = 7), gp = NULL,
-#'   output = c("regions", "latest"),
-#'   target_folder = dir,
-#'   return_output = TRUE
-#' )
 #' # from output
 #' results <- get_regional_results(regional_out$regional, samples = FALSE)
-#' names(results)
-#'
-#' # from a folder
-#' folder_results <- get_regional_results(results_dir = dir, samples = FALSE)
-#' names(folder_results)
-#' }
 get_regional_results <- function(regional_output,
                                  results_dir, date,
                                  samples = TRUE,

R/plot.R

@@ -79,35 +79,22 @@ plot_CrIs <- function(plot, CrIs, alpha, linewidth) {
 #' @importFrom data.table setDT fifelse copy as.data.table
 #' @importFrom purrr map
 #' @examples
-#' \donttest{
-#' # define example cases
-#' cases <- example_confirmed[1:40]
+#' # get example model results
+#' out <- readRDS(system.file(
+#'     package = "EpiNow2", "extdata", "example_estimate_infections.rds"
+#' ))
 #'
-#' # set up example delays
-#' generation_time <- get_generation_time(
-#'  disease = "SARS-CoV-2", source = "ganyani"
-#' )
-#' incubation_period <- get_incubation_period(
-#'  disease = "SARS-CoV-2", source = "lauer"
-#' )
-#' reporting_delay <- estimate_delay(rlnorm(100, log(6), 1), max_value = 10)
-#'
-#' # run model
-#' out <- estimate_infections(cases,
-#'   generation_time = generation_time_opts(generation_time),
-#'   delays = delay_opts(incubation_period + reporting_delay)
-#' )
 #' # plot infections
 #' plot_estimates(
 #'   estimate = out$summarised[variable == "infections"],
-#'   reported = cases,
+#'   reported = out$observations,
 #'   ylab = "Cases", max_plot = 2
 #' ) + ggplot2::facet_wrap(~type, scales = "free_y")
 #'
 #' # plot reported cases estimated via Rt
 #' plot_estimates(
 #'   estimate = out$summarised[variable == "reported_cases"],
-#'   reported = cases,
+#'   reported = out$observations,
 #'   ylab = "Cases"
 #' )
 #'
@@ -124,7 +111,6 @@ plot_CrIs <- function(plot, CrIs, alpha, linewidth) {
 #'   ylab = "Effective Reproduction No.",
 #'   hline = 1, estimate_type = "Estimate"
 #' )
-#' }
 plot_estimates <- function(estimate, reported, ylab = "Cases", hline,
                            obs_as_col = TRUE, max_plot = 10,
                            estimate_type = NULL) {

R/regional_epinow.R

@@ -88,6 +88,7 @@
 #'
 #' # run epinow across multiple regions and generate summaries
 #' # samples and warmup have been reduced for this example
+#' # for more examples, see the "estimate_infections examples" vignette
 #' def <- regional_epinow(
 #'   reported_cases = cases,
 #'   generation_time = generation_time_opts(generation_time),
@@ -99,24 +100,6 @@
 #'   ),
 #'   verbose = interactive()
 #' )
-#'
-#' # apply a different rt method per region
-#' # (here a gaussian process and a weekly random walk)
-#' gp <- opts_list(gp_opts(), cases)
-#' gp <- update_list(gp, list(realland = NULL))
-#' rt <- opts_list(rt_opts(), cases, realland = rt_opts(rw = 7))
-#' region_rt <- regional_epinow(
-#'   reported_cases = cases,
-#'   generation_time = generation_time_opts(generation_time),
-#'   delays = delay_opts(incubation_period + reporting_delay),
-#'   rt = rt, gp = gp,
-#'   stan = stan_opts(
-#'     samples = 100, warmup = 200,
-#'     control = list(adapt_delta = 0.95)
-#'   ),
-#'   verbose = interactive()
-#' )
-#'
 #' options(old_opts)
 #' }
 regional_epinow <- function(reported_cases,

R/report.R

@@ -262,36 +262,17 @@ report_summary <- function(summarised_estimates,
 #' `summarised_estimates[variable == "growth_rate"]`, respectively.
 #' @export
 #' @examples
-#' \donttest{
-#' # define example cases
-#' cases <- example_confirmed[1:40]
-#'
-#' # set up example delays
-#' generation_time <- get_generation_time(
-#'  disease = "SARS-CoV-2", source = "ganyani"
-#' )
-#' incubation_period <- get_incubation_period(
-#'  disease = "SARS-CoV-2", source = "lauer"
-#' )
-#' reporting_delay <- bootstrapped_dist_fit(
-#'  rlnorm(100, log(6), 1), max_value = 30
-#' )
-#'
-#' # run model
-#' out <- estimate_infections(cases,
-#'   stan = stan_opts(samples = 500),
-#'   generation_time = generation_time_opts(generation_time),
-#'   delays = delay_opts(incubation_period + reporting_delay),
-#'   rt = NULL
-#' )
+#' # get example output form estimate_infections
+#' out <- readRDS(system.file(
+#'     package = "EpiNow2", "extdata", "example_estimate_infections.rds"
+#' ))
 #'
 #' # plot infections
 #' plots <- report_plots(
 #'   summarised_estimates = out$summarised,
-#'   reported = cases
+#'   reported = out$observations
 #' )
 #' plots
-#' }
 report_plots <- function(summarised_estimates, reported,
                          target_folder = NULL, ...) {
   # set input to data.table