Skip to content

Commit

Permalink
remove long run time examples
Browse files Browse the repository at this point in the history
  • Loading branch information
@sbfnk
sbfnk committed Sep 27, 2023
1 parent 104c034 commit 71609b3
Show file tree
Hide file tree
Showing 13 changed files with 30 additions and 576 deletions.
137 changes: 1 addition & 136 deletions R/estimate_infections.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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),
Expand All @@ -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,
Expand Down
37 changes: 2 additions & 35 deletions R/get.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -70,43 +70,10 @@ 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"]
#' ))
#'
#' # 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
#' )
#' # get example multiregion estimates
#' regional_out <- example_regional_epinow
#' # 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,
Expand Down
25 changes: 4 additions & 21 deletions R/plot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -79,35 +79,19 @@ 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]
#'
#' # 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)
#' )
#' # get example model results
#' out <- example_estimate_infections
#' # 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"
#' )
#'
Expand All @@ -124,7 +108,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) {
Expand Down
19 changes: 1 addition & 18 deletions R/regional_epinow.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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),
Expand All @@ -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,
Expand Down
27 changes: 3 additions & 24 deletions R/report.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -262,36 +262,15 @@ 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 <- example_estimate_infections
#'
#' # 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
Expand Down
58 changes: 4 additions & 54 deletions R/summarise.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -165,37 +165,12 @@ summarise_results <- function(regions,
#' @importFrom data.table setDT fcase
#' @importFrom futile.logger flog.info
#' @examples
#' \donttest{
#' # 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 = 30)
#'
#' # example case vector from EpiSoon
#' cases <- example_confirmed[1:30]
#' cases <- data.table::rbindlist(list(
#' data.table::copy(cases)[, region := "testland"],
#' cases[, region := "realland"]
#' ))
#'
#' # run basic nowcasting pipeline
#' out <- regional_epinow(
#' reported_cases = cases,
#' generation_time = generation_time_opts(generation_time),
#' delays = delay_opts(incubation_period + reporting_delay),
#' output = "region",
#' rt = NULL
#' )
#'
#' # get example output from regional_epinow model
#' out <- example_regional_epinow
#' regional_summary(
#' regional_output = out$regional,
#' reported_cases = cases
#' reported_cases = out$summary$reported_cases
#' )
#' }
regional_summary <- function(regional_output = NULL,
reported_cases,
results_dir = NULL,
Expand Down Expand Up @@ -526,33 +501,8 @@ summarise_key_measures <- function(regional_results = NULL,
#' @importFrom data.table data.table fwrite
#' @importFrom purrr map safely
#' @examples
#' \donttest{
#' # 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 = 15)
#'
#' cases <- example_confirmed[1:30]
#' cases <- data.table::rbindlist(list(
#' data.table::copy(cases)[, region := "testland"],
#' cases[, region := "realland"]
#' ))
#'
#' # run basic nowcasting pipeline
#' regional_out <- regional_epinow(
#' reported_cases = cases,
#' generation_time = generation_time_opts(generation_time),
#' delays = delay_opts(incubation_period + reporting_delay),
#' stan = stan_opts(samples = 100, warmup = 100),
#' output = c("region", "timing")
#' )
#'
#' regional_out <- example_regional_epinow # get example run outputs
#' regional_runtimes(regional_output = regional_out$regional)
#' }
regional_runtimes <- function(regional_output = NULL,
target_folder = NULL,
target_date = NULL,
Expand Down
Loading

0 comments on commit 71609b3

Please sign in to comment.