diff --git a/R/deprecated.R b/R/deprecated.R index 06f47257e..25f9a3ad3 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -26,158 +26,19 @@ #' @inheritParams sample_approx_dist #' @importFrom data.table setorder data.table data.table #' @importFrom lubridate wday -#' @examples -#' \donttest{ -#' # This function is deprecated and its functionality can now be accessed -#' # from [simulate_secondary()]. -#' # Here are some examples of how to use [simulate_secondary()] to replace -#' # adjust_infection_to_report(). -#' -#' # Old (using adjust_infection_to_report()): -#' # Define example case data -#' cases <- data.table::copy(example_confirmed) -#' cases <- cases[, cases := as.integer(confirm)] -#' # Define a simple reporting delay distribution -#' delay_def <- lognorm_dist_def( -#' mean = 5, mean_sd = 1, sd = 3, sd_sd = 1, -#' max_value = 30, samples = 1, to_log = TRUE -#' ) -#' report <- adjust_infection_to_report( -#' cases, -#' delay_defs = list(delay_def), -#' reporting_model = function(n) rpois(length(n), n) -#' ) -#' print(report) -#' -#' # New (using simulate_secondary()): -#' cases <- data.table::copy(example_confirmed) -#' cases <- cases[, primary := as.integer(confirm)] -#' uncertain_delay <- LogNormal( -#' mean = Normal(5, 1), sd = Normal(3, 1), -#' max = 30 -#' ) -#' delay <- fix_dist(uncertain_delay, strategy = "sample") -#' report <- simulate_secondary( -#' cases, -#' delays = delay_opts(delay), -#' obs = obs_opts(family = "poisson") -#' ) -#' print(report) -#' } adjust_infection_to_report <- function(infections, delay_defs, reporting_model, reporting_effect, type = "sample", truncate_future = TRUE) { - deprecate_warn( + deprecate_stop( when = "1.5.0", what = "adjust_infection_to_report()", with = "simulate_secondary()", details = c( "See equivalent examples using `simulate_secondary()`", - "in ?adjust_infection_to_report.", - "This function will be removed completely in the next version." + "in ?adjust_infection_to_report." ) ) - # Reset DT Defaults on Exit - set_dt_single_thread() - - ## deprecated - sample_single_dist <- function(input, delay_def) { - ## Define sample delay fn - sample_delay_fn <- function(n, ...) { - EpiNow2::dist_skel( - n = n, - model = delay_def$model[[1]], - params = delay_def$params[[1]], - max_value = delay_def$max_value[[1]], - ... - ) - } - - - ## Infection to onset - out <- suppressWarnings(EpiNow2::sample_approx_dist( - cases = input, - dist_fn = sample_delay_fn, - max_value = delay_def$max_value, - direction = "forwards", - type = type, - truncate_future = FALSE - )) - - return(out) - } - - sample_dist_spec <- function(input, delay_def) { - ## Define sample delay fn - sample_delay_fn <- function(n, dist, cum, ...) { - fixed_dist <- discretise(fix_dist(delay_def, strategy = "sample")) - if (dist) { - fixed_dist[[1]]$pmf[n + 1] - } else { - sample(seq_along(fixed_dist[[1]]$pmf) - 1, size = n, replace = TRUE) - } - } - - ## Infection to onset - out <- suppressWarnings(EpiNow2::sample_approx_dist( - cases = input, - dist_fn = sample_delay_fn, - max_value = max(delay_def), - direction = "forwards", - type = type, - truncate_future = FALSE - )) - - return(out) - } - - if (is(delay_defs, "dist_spec")) { - report <- sample_dist_spec(infections, extract_single_dist(delay_defs, 1)) - if (length(delay_defs) > 1) { - for (def in seq(2, length(delay_defs))) { - report <- sample_dist_spec(report, extract_single_dist(delay_defs, def)) - } - } - } else { - deprecate_warn( - "1.5.0", - "adjust_infection_to_report(delay_defs = 'should be a dist_spec')", - details = "Specifying this as a list of data tables is deprecated." - ) - report <- sample_single_dist(infections, delay_defs[[1]]) - if (length(delay_defs) > 1) { - for (def in 2:length(delay_defs)) { - report <- sample_single_dist(report, delay_defs[[def]]) - } - } - } - ## Add a weekly reporting effect if present - if (!missing(reporting_effect)) { - reporting_effect <- data.table::data.table( - day = 1:7, - effect = reporting_effect - ) - - report <- report[, day := lubridate::wday(date, week_start = 1)] - report <- report[reporting_effect, on = "day"] - report <- report[, cases := as.integer(cases * effect)][ - , - `:=`(effect = NULL, day = NULL) - ] - - report <- data.table::setorder(report, date) - } - - if (!missing(reporting_model)) { - report <- report[, cases := reporting_model(cases)] - } - - ## Truncate reported cases by maximum infection date - if (type == "sample" && truncate_future) { - report <- report[date <= max(infections$date)] - } - return(report) } #' Specify a distribution. @@ -202,14 +63,6 @@ adjust_infection_to_report <- function(infections, delay_defs, #' @param max Numeric, maximum value of the distribution. The distribution will #' be truncated at this value. Default: `Inf`, i.e. no maximum. #' -#' @param mean Deprecated; use `params_mean` instead. -#' -#' @param sd Deprecated; use `params_mean` instead. -#' -#' @param mean_sd Deprecated; use `params_sd` instead. -#' -#' @param sd_sd Deprecated; use `params_sd` instead. -#' #' @param pmf Numeric, a vector of values that represent the (nonparametric) #' probability mass function of the delay (starting with 0); defaults to an #' empty vector corresponding to a parametric specification of the distribution @@ -223,87 +76,18 @@ dist_spec <- function(distribution = c( "lognormal", "normal", "gamma", "fixed", "empty" ), params_mean = numeric(0), params_sd = numeric(0), - mean, sd = 0, mean_sd = 0, sd_sd = 0, max = Inf, pmf = numeric(0), fixed = FALSE) { - lifecycle::deprecate_warn( + lifecycle::deprecate_stop( "1.5.0", "dist_spec()", details = c( paste0( "Please use distribution functions such as `Gamma()` or `Lognormal()` ", "instead." - ), - "The function will become internal only in the next version." + ) ) ) - ## check for deprecated parameters - if (!missing(fixed)) { - lifecycle::deprecate_warn( - "1.5.0", - "dist_spec(fixed)", - "fix_dist()" - ) - params_sd <- NULL - } - ## check for deprecated parameters - if (!all(missing(mean), missing(sd), missing(mean_sd), missing(sd_sd)) && - (length(params_mean) > 0 || length(params_sd) > 0)) { - stop("Distributional parameters should not be given as `mean`, `sd`, etc. ", - "in addition to `params_mean` or `params_sd`") - } - distribution <- match.arg(distribution) - ## check if distribution is given as empty and warn about deprecation if so - if (distribution == "empty") { - deprecate_warn( - "1.5.0", - "dist_spec(distribution = 'must not be \"empty\"')", - details = "Please use `Fixed(0)` instead." - ) - } - - if (!all(missing(mean), missing(sd), missing(mean_sd), missing(sd_sd))) { - if (sd == 0 && mean_sd == 0 && sd_sd == 0) { - distribution <- "fixed" - } - ## deprecated arguments given - if (distribution == "lognormal") { - params_mean <- c(meanlog = mean, sdlog = sd) - params_sd <- c(meanlog = mean_sd, sdlog = sd_sd) - } else if (distribution == "gamma") { - temp_dist <- Gamma( - mean = Normal(mean, mean_sd), - sd = Normal(sd, sd_sd) - ) - params_mean <- vapply(get_parameters(temp_dist), mean, numeric(1)) - params_sd <- vapply(get_parameters(temp_dist), sd_dist, numeric(1)) - } else if (distribution == "normal") { - params_mean <- c(mean = mean, sd = sd) - params_sd <- c(mean = mean_sd, sd = sd_sd) - } else if (distribution == "fixed") { - params_mean <- mean - } - } - if (length(pmf) > 0) { - if (!all( - missing(mean), missing(sd), missing(mean_sd), missing(sd_sd), - missing(params_mean), missing(params_sd) - )) { - stop("Distributional parameters should not be given in addition to `pmf`") - } - distribution <- "nonparametric" - parameters <- list(pmf = pmf) - } else { - if (length(params_sd) == 0) { - params_sd <- rep(0, length(params_mean)) - } - parameters <- lapply(seq_along(params_mean), function(id) { - Normal(params_mean[id], params_sd[id]) - }) - names(parameters) <- natural_params(distribution) - parameters$max <- max - } - return(new_dist_spec(parameters, distribution)) } #' Generate a Gamma Distribution Definition Based on Parameter Estimates @@ -327,71 +111,14 @@ dist_spec <- function(distribution = c( #' @export #' @inheritParams dist_skel #' @inheritParams lognorm_dist_def -#' @examples -#' # using estimated shape and scale -#' def <- gamma_dist_def( -#' shape = 5.807, shape_sd = 0.2, -#' scale = 0.9, scale_sd = 0.05, -#' max_value = 20, samples = 10 -#' ) -#' print(def) -#' def$params[[1]] -#' -#' # using mean and sd -#' def <- gamma_dist_def( -#' mean = 3, mean_sd = 0.5, -#' sd = 3, sd_sd = 0.1, -#' max_value = 20, samples = 10 -#' ) -#' print(def) -#' def$params[[1]] gamma_dist_def <- function(shape, shape_sd, scale, scale_sd, mean, mean_sd, sd, sd_sd, max_value, samples) { - lifecycle::deprecate_warn( - "1.5.0", "gamma_dist_def()", "Gamma()", - "The function will be removed completely in the next version." - ) - - if (missing(shape) && missing(scale) && !missing(mean) && !missing(sd)) { - if (!missing(mean_sd)) { - mean <- truncnorm::rtruncnorm(samples, a = 0, mean = mean, sd = mean_sd) - } - if (!missing(sd_sd)) { - sd <- truncnorm::rtruncnorm(samples, a = 0, mean = sd, sd = sd_sd) - } - scale <- sd^2 / mean - shape <- mean / scale - } else { - if (!missing(shape_sd)) { - shape <- truncnorm::rtruncnorm( - samples, - a = 0, mean = shape, sd = shape_sd - ) - } - if (!missing(scale_sd)) { - scale <- 1 / truncnorm::rtruncnorm( - samples, - a = 0, mean = scale, sd = scale_sd - ) - } - } - - rate <- 1 / scale - - dist <- data.table::data.table( - model = rep("gamma", samples), - params = purrr::list_transpose( - list( - shape = shape, - rate = rate - ) - ), - max_value = rep(max_value, samples) + lifecycle::deprecate_stop( + "1.5.0", "gamma_dist_def()", "Gamma()" ) - return(dist) } #' Generate initial conditions by fitting to cumulative cases @@ -427,50 +154,10 @@ gamma_dist_def <- function(shape, shape_sd, init_cumulative_fit <- function(args, samples = 50, warmup = 50, id = "init", verbose = FALSE, backend = "rstan") { - deprecate_warn( + deprecate_stop( when = "1.5.0", what = "init_cumulative_fit()" ) - futile.logger::flog.debug( - "%s: Fitting to cumulative data to initialise chains", id, - name = "EpiNow2.epinow.estimate_infections.fit" - ) - # copy main run settings and override to use only 100 iterations and a single - # chain - initial_args <- create_stan_args( - stan = stan_opts( - args$object, - samples = samples, - warmup = warmup, - control = list(adapt_delta = 0.9, max_treedepth = 13), - chains = 1, - cores = 2, - backend = backend, - open_progress = FALSE, - show_messages = FALSE - ), - data = args$data, init = args$init - ) - # change observations to be cumulative in order to protect against noise and - # give an approximate fit (though for Rt constrained to be > 1) - initial_args$data$cases <- cumsum(initial_args$data$cases) - initial_args$data$shifted_cases <- cumsum(initial_args$data$shifted_cases) - - # initial fit - if (verbose) { - fit <- fit_model(initial_args, id = "init_cumulative") - } else { - out <- tempfile(tmpdir = tempdir(check = TRUE)) - capture.output( - { - fit <- fit_model(initial_args, id = "init_cumulative") - }, - type = c("output", "message"), - split = FALSE, - file = out - ) - } - return(fit) } #' Generate a Log Normal Distribution Definition Based on Parameter Estimates @@ -497,75 +184,13 @@ init_cumulative_fit <- function(args, samples = 50, warmup = 50, #' @export #' @keywords internal #' @inheritParams dist_skel -#' @examples -#' def <- lognorm_dist_def( -#' mean = 1.621, mean_sd = 0.0640, -#' sd = 0.418, sd_sd = 0.0691, -#' max_value = 20, samples = 10 -#' ) -#' print(def) -#' def$params[[1]] -#' -#' def <- lognorm_dist_def( -#' mean = 5, mean_sd = 1, -#' sd = 3, sd_sd = 1, -#' max_value = 20, samples = 10, -#' to_log = TRUE -#' ) -#' print(def) -#' def$params[[1]] lognorm_dist_def <- function(mean, mean_sd, sd, sd_sd, max_value, samples, to_log = FALSE) { - lifecycle::deprecate_warn( - "1.5.0", "lognorm_dist_def()", "LogNormal()", - "The function will be removed completely in the next version." + lifecycle::deprecate_stop( + "1.5.0", "lognorm_dist_def()", "LogNormal()" ) - - transform_mean <- function(mu, sig) { - mean_location <- log(mu^2 / sqrt(sig^2 + mu^2)) - mean_location - } - - transform_sd <- function(mu, sig) { - mean_shape <- sqrt(log(1 + (sig^2 / mu^2))) - mean_shape - } - - if (missing(mean_sd)) { - sampled_means <- mean - } else { - sampled_means <- truncnorm::rtruncnorm( - samples, - a = 0, mean = mean, sd = mean_sd - ) - } - - if (missing(sd_sd)) { - sampled_sds <- sd - } else { - sampled_sds <- truncnorm::rtruncnorm(samples, a = 0, mean = sd, sd = sd_sd) - } - means <- sampled_means - sds <- sampled_sds - - if (to_log) { - means <- mapply(transform_mean, sampled_means, sampled_sds) - sds <- mapply(transform_sd, sampled_means, sampled_sds) - } - - dist <- data.table::data.table( - model = rep("lognormal", samples), - params = purrr::list_transpose( - list( - meanlog = means, - sdlog = sds - ) - ), - max_value = rep(max_value, samples) - ) - return(dist) } #' Report case counts by date of report @@ -598,110 +223,27 @@ lognorm_dist_def <- function(mean, mean_sd, #' @inheritParams adjust_infection_to_report #' @importFrom data.table data.table rbindlist #' @importFrom future.apply future_lapply -#' @examples -#' \donttest{ -#' # This function is deprecated and its functionality can now be accessed -#' # from [simulate_secondary()]. -#' # Here are some examples of how to use [simulate_secondary()] to replace -#' # report_cases(). -#' # Old (using report_cases()): -#' # Define case data -#' cases <- example_confirmed[1:40] -#' cases <- cases[, cases := as.integer(confirm)] -#' cases <- cases[, confirm := NULL][, sample := 1] -#' reported_cases <- report_cases( -#' case_estimates = cases, -#' delays = delay_opts(example_incubation_period + example_reporting_delay), -#' type = "sample" -#' ) -#' print(reported_cases$samples) -#' -#' # New (using simulate_secondary()): -#' cases <- example_confirmed[1:40] -#' cases <- cases[, primary := as.integer(confirm)] -#' report <- simulate_secondary( -#' cases, -#' delays = delay_opts( -#' fix_dist(example_incubation_period + example_reporting_delay) -#' ), -#' obs = obs_opts(family = "poisson") -#' ) -#' print(report) -#' } report_cases <- function(case_estimates, case_forecast = NULL, delays, type = "sample", reporting_effect, CrIs = c(0.2, 0.5, 0.9)) { - deprecate_warn( + deprecate_stop( when = "1.5.0", what = "report_cases()", with = "simulate_secondary()", details = c( "See equivalent examples using `simulate_secondary()`", - "in ?report_cases.", - "This function will be removed completely in the next version." - ) - ) - samples <- length(unique(case_estimates$sample)) - - # add a null reporting effect if missing - if (missing(reporting_effect)) { - reporting_effect <- data.table::data.table( - sample = list(1:samples), - effect = rep(1, 7), - day = 1:7 + "in ?report_cases." ) - reporting_effect <- reporting_effect[, - .(sample = unlist(sample)), by = .(effect, day) - ] - } - # filter and sum nowcast to use only upscaled cases by date of infection - infections <- data.table::copy(case_estimates) - - # add in case forecast if present - if (!is.null(case_forecast)) { - infections <- data.table::rbindlist(list( - infections, - case_forecast[, .(date, sample, cases = as.integer(cases))] - ), use.names = TRUE) - } - - ## For each sample map to report date - report <- future.apply::future_lapply(1:max(infections$sample), - function(id) { - suppressWarnings( - EpiNow2::adjust_infection_to_report(infections[sample == id], - delay_defs = delays, - type = type, - reporting_effect = reporting_effect[sample == id, ]$effect - ) - ) - }, - future.seed = TRUE ) - - report <- data.table::rbindlist(report, idcol = "sample") - - out <- list() - # bind all samples together - out$samples <- report - # summarise samples - out$summarised <- calc_summary_measures( - report[, value := cases][, cases := NULL], - summarise_by = "date", - order_by = "date", - CrIs = CrIs - ) - return(out) } #' Approximate Sampling a Distribution using Counts #' #' @description `r lifecycle::badge("deprecated")` -#' Convolves cases by a PMF function. This function will soon be removed or -#' replaced with a more robust stan implementation. +#' Deprecated; Convolves cases by a PMF function. #' #' @param cases A `` of cases (in date order) with the following #' variables: `date` and `cases`. @@ -732,60 +274,6 @@ report_cases <- function(case_estimates, #' @importFrom purrr map_dfc #' @importFrom data.table data.table setorder #' @importFrom lubridate days -#' @examples -#' \donttest{ -#' cases <- example_confirmed -#' cases <- cases[, cases := as.integer(confirm)] -#' print(cases) -#' -#' # total cases -#' sum(cases$cases) -#' -#' delay_fn <- function(n, dist, cum) { -#' if (dist) { -#' pgamma(n + 0.9999, 2, 1) - pgamma(n - 1e-5, 2, 1) -#' } else { -#' as.integer(rgamma(n, 2, 1)) -#' } -#' } -#' -#' onsets <- sample_approx_dist( -#' cases = cases, -#' dist_fn = delay_fn -#' ) -#' -#' # estimated onset distribution -#' print(onsets) -#' -#' # check that sum is equal to reported cases -#' total_onsets <- median( -#' purrr::map_dbl( -#' 1:10, -#' ~ sum(sample_approx_dist( -#' cases = cases, -#' dist_fn = delay_fn -#' )$cases) -#' ) -#' ) -#' total_onsets -#' -#' -#' # map from onset cases to reported -#' reports <- sample_approx_dist( -#' cases = cases, -#' dist_fn = delay_fn, -#' direction = "forwards" -#' ) -#' -#' -#' # map from onset cases to reported using a mean shift -#' reports <- sample_approx_dist( -#' cases = cases, -#' dist_fn = delay_fn, -#' direction = "forwards", -#' type = "median" -#' ) -#' } sample_approx_dist <- function(cases = NULL, dist_fn = NULL, max_value = 120, @@ -793,97 +281,168 @@ sample_approx_dist <- function(cases = NULL, direction = "backwards", type = "sample", truncate_future = TRUE) { - deprecate_warn( + deprecate_stop( "1.5.0", - "sample_approx_dist()", - details = "The function will be removed completely in the next version." + "sample_approx_dist()" ) - if (type == "sample") { - if (direction == "backwards") { - direction_fn <- rev - } else if (direction == "forwards") { - direction_fn <- function(x) { - x - } - } - # reverse cases so starts with current first - reversed_cases <- direction_fn(cases$cases) - reversed_cases[is.na(reversed_cases)] <- 0 - # draw from the density fn of the dist - draw <- dist_fn(0:max_value, dist = TRUE, cum = FALSE) +} - # approximate cases - mapped_cases <- do.call(cbind, purrr::map( - seq_along(reversed_cases), - ~ c( - rep(0, . - 1), - stats::rbinom( - length(draw), - rep(reversed_cases[.], length(draw)), - draw - ), - rep(0, length(reversed_cases) - .) +#' Get a Literature Distribution +#' +#' +#' @description `r lifecycle::badge("deprecated")` +#' +#' This function has been deprecated. Please specify a distribution +#' using functions such as [Gamma()] or [LogNormal()] instead. +#' +#' @param data A `` in the format of `generation_times`. +#' +#' @param disease A character string indicating the disease of interest. +#' +#' @param source A character string indicating the source of interest. +#' +#' @param max_value Numeric, the maximum value to allow. Defaults to 14 days. +#' +#' @param fixed Logical, defaults to `FALSE`. Should distributions be supplied +#' as fixed values (vs with uncertainty)? +#' +#' @return A list defining a distribution +#' +#' @seealso [dist_spec()] +#' @export +#' @keywords internal +get_dist <- function(data, disease, source, max_value = 14, fixed = FALSE) { + lifecycle::deprecate_stop( + "1.5.0", "get_dist()", + details = c( + paste( + "Please use distribution functions such as `Gamma()` or `Lognormal()`", + "instead." ) - )) - + ) + ) +} - # set dates order based on direction mapping - if (direction == "backwards") { - dates <- seq(min(cases$date) - lubridate::days(length(draw) - 1), - max(cases$date), - by = "days" - ) - } else if (direction == "forwards") { - dates <- seq(min(cases$date), - max(cases$date) + lubridate::days(length(draw) - 1), - by = "days" +#' Get a Literature Distribution for the Generation Time +#' +#' @description `r lifecycle::badge("deprecated")` +#' +#' Extracts a literature distribution from `generation_times`. +#' This function has been deprecated. Please specify a distribution +#' using functions such as [Gamma()] or [LogNormal()] instead. +#' +#' @inheritParams get_dist +#' @inherit get_dist +#' @export +#' @seealso [dist_spec()] +#' @keywords internal +get_generation_time <- function(disease, source, max_value = 14, + fixed = FALSE) { + lifecycle::deprecate_stop( + "1.5.0", "get_generation_time()", + details = c( + paste( + "Please use distribution functions such as `Gamma()` or `Lognormal()`", + "instead." + ), + paste( + "To obtain the previous estimate by Ganyani et al. (2020) use", + "`example_generation_time`." ) - } - - # summarises movements and sample for placement of non-integer cases - case_sum <- direction_fn(rowSums(mapped_cases)) - floor_case_sum <- floor(case_sum) - sample_cases <- floor_case_sum + - as.numeric((runif(seq_along(case_sum)) < (case_sum - floor_case_sum))) - - # summarise imputed onsets and build output data.table - mapped_cases <- data.table::data.table( - date = dates, - cases = sample_cases ) + ) +} - # filter out all zero cases until first recorded case - mapped_cases <- data.table::setorder(mapped_cases, date) - mapped_cases <- mapped_cases[ - , - cum_cases := cumsum(cases) - ][cum_cases != 0][, cum_cases := NULL] - } else if (type == "median") { - shift <- as.integer( - median(as.integer(dist_fn(1000, dist = FALSE)), na.rm = TRUE) +#' Get a Literature Distribution for the Incubation Period +#' +#' @description `r lifecycle::badge("deprecated")` +#' +#' Extracts a literature distribution from `generation_times`. +#' This function has been deprecated. Please specify a distribution +#' using functions such as [Gamma()] or [LogNormal()] instead. +#' +#' @inheritParams get_dist +#' @inherit get_dist +#' @export +#' @keywords internal +get_incubation_period <- function(disease, source, max_value = 14, + fixed = FALSE) { + lifecycle::deprecate_stop( + "1.5.0", "get_incubation_period()", + details = c( + paste( + "Please use distribution functions such as `Gamma()` or `Lognormal()`", + "instead." + ), + paste( + "To obtain the previous estimate by Ganyani et al. (2020) use", + "`example_incubation_period`." + ) ) + ) +} - if (direction == "backwards") { - mapped_cases <- data.table::copy(cases)[ - , - date := date - lubridate::days(shift) - ] - } else if (direction == "forwards") { - mapped_cases <- data.table::copy(cases)[ - , - date := date + lubridate::days(shift) - ] - } - } +#' Rstan Sampling Options +#' +#' @description `r lifecycle::badge("deprecated")` +#' Deprecated; use [stan_sampling_opts()] instead. +#' @inheritParams stan_sampling_opts +#' @return A list of arguments to pass to [rstan::sampling()]. +#' @export +rstan_sampling_opts <- function(cores = getOption("mc.cores", 1L), + warmup = 250, + samples = 2000, + chains = 4, + control = list(), + save_warmup = FALSE, + seed = as.integer(runif(1, 1, 1e8)), + future = FALSE, + max_execution_time = Inf, + ...) { + lifecycle::deprecate_stop( + "1.5.0", "rstan_sampling_opts()", + "stan_sampling_opts()" + ) +} - if (!is.null(earliest_allowed_mapped)) { - mapped_cases <- mapped_cases[date >= as.Date(earliest_allowed_mapped)] - } +#' Rstan Variational Bayes Options +#' +#' @description `r lifecycle::badge("deprecated")` +#' Deprecated; use [stan_vb_opts()] instead. +#' @inheritParams stan_vb_opts +#' @return A list of arguments to pass to [rstan::vb()]. +#' @export +rstan_vb_opts <- function(samples = 2000, + trials = 10, + iter = 10000, ...) { + lifecycle::deprecate_stop( + "1.5.0", "rstan_vb_opts()", + "stan_vb_opts()" + ) +} - # filter out future cases - if (direction == "forwards" && truncate_future) { - max_date <- max(cases$date) - mapped_cases <- mapped_cases[date <= max_date] - } - return(mapped_cases) +#' Rstan Options +#' +#' @description `r lifecycle::badge("deprecated")` +#' Deprecated; specify options in [stan_opts()] instead. +#' +#' @param object Stan model object. By default uses the compiled package +#' default. +#' +#' @param method A character string, defaulting to sampling. Currently supports +#' [rstan::sampling()] ("sampling") or [rstan::vb()]. +#' +#' @param ... Additional parameters to pass underlying option functions. +#' @importFrom rlang arg_match +#' @return A list of arguments to pass to the appropriate rstan functions. +#' @export +#' @inheritParams rstan_sampling_opts +#' @seealso [rstan_sampling_opts()] [rstan_vb_opts()] +rstan_opts <- function(object = NULL, + samples = 2000, + method = c("sampling", "vb"), ...) { + lifecycle::deprecate_stop( + "1.5.0", "rstan_opts()", + "stan_opts()" + ) } diff --git a/R/dist_spec.R b/R/dist_spec.R index 08513d18f..48f717257 100644 --- a/R/dist_spec.R +++ b/R/dist_spec.R @@ -185,10 +185,10 @@ dist_skel <- function(n, dist = FALSE, cum = TRUE, model, #' #' @description `r lifecycle::badge("experimental")` #' @return A delay distribution representing the sum of the two delays -#' @param e1 The first delay distribution (of type [dist_spec()]) to +#' @param e1 The first delay distribution (of type ) to #' combine. #' -#' @param e2 The second delay distribution (of type [dist_spec()]) to +#' @param e2 The second delay distribution (of type ) to #' combine. #' @method + dist_spec #' @export @@ -214,7 +214,7 @@ dist_skel <- function(n, dist = FALSE, cum = TRUE, model, #' This combines the parameters so that they can be fed as multiple delay #' distributions to [epinow()] or [estimate_infections()]. #' -#' @param ... The delay distributions (from calls to [dist_spec()]) to combine +#' @param ... The delay distributions to combine #' @return Combined delay distributions (with class ``) #' @method c dist_spec #' @export @@ -248,7 +248,7 @@ c.dist_spec <- function(...) { #' #' @description `r lifecycle::badge("experimental")` #' This works out the mean of all the (parametric / nonparametric) delay -#' distributions combined in the passed [dist_spec()] (ignoring any uncertainty +#' distributions combined in the passed (ignoring any uncertainty #' in parameters) #' #' @param x The `` to use @@ -312,9 +312,9 @@ mean.dist_spec <- function(x, ..., ignore_uncertainty = FALSE) { #' #' @description `r lifecycle::badge("experimental")` #' This works out the standard deviation of all the (parametric / -#' nonparametric) delay distributions combined in the passed [dist_spec()]. +#' nonparametric) delay distributions combined in the passed . #' -#' @param x The [dist_spec()] to use +#' @param x The to use #' @return A vector of standard deviations. #' @importFrom utils head #' @keywords internal @@ -370,10 +370,10 @@ sd_dist <- function(x) { #' #' @description `r lifecycle::badge("experimental")` #' This works out the maximum of all the (parametric / nonparametric) delay -#' distributions combined in the passed [dist_spec()] (ignoring any uncertainty +#' distributions combined in the passed (ignoring any uncertainty #' in parameters) #' -#' @param x The [dist_spec()] to use +#' @param x The to use #' @param ... Not used #' @return A vector of means. #' @method max dist_spec @@ -554,7 +554,7 @@ apply_tolerance <- function(x, tolerance) { #' #' @description `r lifecycle::badge("experimental")` #' This displays the parameters of the uncertain and probability mass -#' functions of fixed delay distributions combined in the passed [dist_spec()]. +#' functions of fixed delay distributions combined in the passed . #' @param x The `` to use #' @param ... Not used #' @return invisible @@ -1186,7 +1186,7 @@ get_pmf <- function(x, id = NULL) { return(x[[id]]$pmf) } -##' Get the distribution of a [dist_spec()] +##' Get the distribution of a ##' ##' @inheritParams get_dist_spec_id ##' @description `r lifecycle::badge("experimental")` diff --git a/R/epinow.R b/R/epinow.R index 906c1f803..c4b239423 100644 --- a/R/epinow.R +++ b/R/epinow.R @@ -63,7 +63,7 @@ #' #' # estimate Rt and nowcast/forecast cases by date of infection #' out <- epinow( -#' reported_cases = reported_cases, +#' data = reported_cases, #' generation_time = generation_time_opts(generation_time), #' rt = rt_opts(prior = list(mean = 2, sd = 0.1)), #' delays = delay_opts(incubation_period + reporting_delay) @@ -98,20 +98,12 @@ epinow <- function(data, target_folder = NULL, target_date, logs = tempdir(), id = "epinow", verbose = interactive(), reported_cases) { - # Warning for deprecated arguments if (!missing(reported_cases)) { - if (!missing(data)) { - stop("Can't have `reported_cases` and `data` arguments. ", - "Use `data` instead." - ) - } - lifecycle::deprecate_warn( + lifecycle::deprecate_stop( "1.5.0", "epinow(reported_cases)", - "epinow(data)", - "The argument will be removed completely in the next version." + "epinow(data)" ) - data <- reported_cases } # Check inputs assert_logical(return_output) diff --git a/R/estimate_delay.R b/R/estimate_delay.R index e45e1c53b..5b076efd0 100644 --- a/R/estimate_delay.R +++ b/R/estimate_delay.R @@ -183,16 +183,13 @@ bootstrapped_dist_fit <- function(values, dist = "lognormal", fit <- EpiNow2::dist_fit(values, samples = samples, dist = dist) - out <- list() if (dist == "lognormal") { - out$mean_samples <- sample(extract(fit)$mu, samples) - out$sd_samples <- sample(extract(fit)$sigma, samples) + out$meanlog <- sample(extract(fit)$mu, samples) + out$sdlog <- sample(extract(fit)$sigma, samples) } else if (dist == "gamma") { - alpha_samples <- sample(extract(fit)$alpha, samples) - beta_samples <- sample(extract(fit)$beta, samples) - out$mean_samples <- alpha_samples / beta_samples - out$sd_samples <- sqrt(alpha_samples) / beta_samples + out$shape <- sample(extract(fit)$alpha, samples) + out$rate <- sample(extract(fit)$beta, samples) } return(out) } @@ -224,17 +221,16 @@ bootstrapped_dist_fit <- function(values, dist = "lognormal", dist_samples <- purrr::map(dist_samples, unlist) } - out <- list() - out$mean <- mean(dist_samples$mean_samples) - out$mean_sd <- sd(dist_samples$mean_samples) - out$sd <- mean(dist_samples$sd_sample) - out$sd_sd <- sd(dist_samples$sd_samples) + params <- lapply(dist_samples, function(x) { + Normal(mean = mean(x), sd = sd(x)) + }) + if (!missing(max_value)) { - out$max <- max_value + params$max <- max_value } else { - out$max <- max(values) + params$max <- max(values) } - return(do.call(dist_spec, out)) + return(new_dist_spec(params = params, distribution = dist)) } #' Estimate a Delay Distribution diff --git a/R/estimate_infections.R b/R/estimate_infections.R index b5e9f6f6d..11bced120 100644 --- a/R/estimate_infections.R +++ b/R/estimate_infections.R @@ -129,18 +129,11 @@ estimate_infections <- function(data, reported_cases) { # Deprecate reported_cases in favour of data if (!missing(reported_cases)) { - if (!missing(data)) { - stop("Can't have `reported_cases` and `data` arguments. ", - "Use `data` instead." - ) - } - lifecycle::deprecate_warn( + lifecycle::deprecate_stop( "1.5.0", "estimate_infections(reported_cases)", - "estimate_infections(data)", - "The argument will be removed completely in the next version." + "estimate_infections(data)" ) - data <- reported_cases } # Validate inputs check_reports_valid(data, model = "estimate_infections") diff --git a/R/estimate_secondary.R b/R/estimate_secondary.R index e3eeb1e5b..adf5488d0 100644 --- a/R/estimate_secondary.R +++ b/R/estimate_secondary.R @@ -159,16 +159,11 @@ estimate_secondary <- function(data, reports) { # Deprecate reported_cases in favour of data if (!missing(reports)) { - if (!missing(data)) { - stop("Can't have `reported` and `data` arguments. Use `data` instead.") - } - lifecycle::deprecate_warn( + lifecycle::deprecate_stop( "1.5.0", "estimate_secondary(reports)", - "estimate_secondary(data)", - "The argument will be removed completely in the next version." + "estimate_secondary(data)" ) - data <- reports } # Validate the inputs check_reports_valid(data, model = "estimate_secondary") diff --git a/R/estimate_truncation.R b/R/estimate_truncation.R index 55fd8271c..e15fe38ca 100644 --- a/R/estimate_truncation.R +++ b/R/estimate_truncation.R @@ -42,12 +42,6 @@ #' #' @param obs Deprecated; use `data` instead. #' -#' @param max_truncation Deprecated; use `truncation` instead. -#' -#' @param trunc_max Deprecated; use `truncation` instead. -#' -#' @param trunc_dist Deprecated; use `truncation` instead. -#' #' @param model A compiled stan model to override the default model. May be #' useful for package developers or those developing extensions. #' @@ -111,8 +105,7 @@ #' plot(out) #' options(old_opts) #' } -estimate_truncation <- function(data, max_truncation, trunc_max = 10, - trunc_dist = "lognormal", +estimate_truncation <- function(data, truncation = trunc_opts( LogNormal( meanlog = Normal(0, 1), @@ -131,16 +124,11 @@ estimate_truncation <- function(data, max_truncation, trunc_max = 10, obs) { if (!missing(obs)) { - if (!missing(data)) { - stop("Can't have `obs` and `data` arguments. Use `data` instead.") - } - lifecycle::deprecate_warn( + lifecycle::deprecate_stop( "1.5.0", "estimate_truncation(obs)", - "estimate_truncation(data)", - "The argument will be removed completely in the next version." + "estimate_truncation(data)" ) - data <- obs } if (!is.null(model)) { lifecycle::deprecate_stop( @@ -150,11 +138,10 @@ estimate_truncation <- function(data, max_truncation, trunc_max = 10, ) } if (!missing(weigh_delay_priors)) { - lifecycle::deprecate_warn( + lifecycle::deprecate_stop( "1.5.0", "estimate_truncation(weigh_delay_priors)", - "trunc_opts(weight_prior)", - detail = "This argument will be removed completely in the next version" + "trunc_opts(weight_prior)" ) } # Validate inputs @@ -167,68 +154,6 @@ estimate_truncation <- function(data, max_truncation, trunc_max = 10, assert_logical(weigh_delay_priors) assert_logical(verbose) - ## code block to remove in next EpiNow2 version - construct_trunc <- FALSE - if (!missing(trunc_max)) { - if (!missing(truncation)) { - stop( - "`trunc_max` and `truncation` arguments are both given. ", - "Use only `truncation` instead.") - } - if (!missing(max_truncation)) { - stop( - "`max_truncation` and `trunc_max` arguments are both given. ", - "Use only `truncation` instead.") - } - deprecate_stop( - "1.4.0", - "estimate_truncation(trunc_max)", - "estimate_truncation(truncation)" - ) - construct_trunc <- TRUE - } - if (!missing(max_truncation)) { - if (!missing(truncation)) { - stop( - "`max_truncation` and `truncation` arguments are both given. ", - "Use only `truncation` instead.") - } - deprecate_stop( - "1.4.0", - "estimate_truncation(max_truncation)", - "estimate_truncation(truncation)" - ) - trunc_max <- max_truncation - construct_trunc <- TRUE - } - if (!missing(trunc_dist)) { - trunc_dist <- arg_match(trunc_dist) - if (!missing(truncation)) { - stop( - "`trunc_dist` and `truncation` arguments are both given. ", - "Use only `truncation` instead.") - } - deprecate_stop( - "1.4.0", - "estimate_truncation(trunc_dist)", - "estimate_truncation(truncation)" - ) - construct_trunc <- TRUE - } - if (construct_trunc) { - params_mean <- c(0, 1) - params_sd <- c(1, 1) - parameters <- lapply(seq_along(params_mean), function(id) { - Normal(params_mean, params_sd) - }) - names(parameters) <- natural_params(trunc_dist) - parameters$max <- trunc_max - truncation <- new_dist_spec( - params = parameters, - distribution = trunc_dist - ) - } - # combine into ordered matrix dirty_obs <- purrr::map(data, data.table::as.data.table) dirty_obs <- purrr::map(dirty_obs, diff --git a/R/get.R b/R/get.R index 913a1bfea..f3c9d4130 100644 --- a/R/get.R +++ b/R/get.R @@ -154,134 +154,6 @@ get_regional_results <- function(regional_output, return(out) } -#' Get a Literature Distribution -#' -#' -#' @description `r lifecycle::badge("deprecated")` -#' -#' This function has been deprecated. Please specify a distribution -#' using functions such as [Gamma()] or [LogNormal()] instead. -#' -#' @param data A `` in the format of `generation_times`. -#' -#' @param disease A character string indicating the disease of interest. -#' -#' @param source A character string indicating the source of interest. -#' -#' @param max_value Numeric, the maximum value to allow. Defaults to 14 days. -#' -#' @param fixed Logical, defaults to `FALSE`. Should distributions be supplied -#' as fixed values (vs with uncertainty)? -#' -#' @return A list defining a distribution -#' -#' @seealso [dist_spec()] -#' @export -#' @keywords internal -get_dist <- function(data, disease, source, max_value = 14, fixed = FALSE) { - lifecycle::deprecate_warn( - "1.5.0", "get_dist()", - details = c( - paste( - "Please use distribution functions such as `Gamma()` or `Lognormal()`", - "instead." - ), - "The function will be removed completely in the next version." - ) - ) - target_disease <- disease - target_source <- source - data <- data[disease == target_disease][source == target_source] - if (fixed) { - data$sd <- 0 - data$sd_sd <- 0 - } - parameters <- list( - Normal(data$mean, data$mean_sd), - Normal(data$sd, data$sd_sd) - ) - if (data$dist == "gamma") { - names(parameters) <- c("mean", "sd") - } else { - names(parameters) <- c("meanlog", "sdlog") - } - parameters$max <- max_value - return(new_dist_spec( - params = parameters, - distribution = data$dist - )) -} -#' Get a Literature Distribution for the Generation Time -#' -#' @description `r lifecycle::badge("deprecated")` -#' -#' Extracts a literature distribution from `generation_times`. -#' This function has been deprecated. Please specify a distribution -#' using functions such as [Gamma()] or [LogNormal()] instead. -#' -#' @inheritParams get_dist -#' @inherit get_dist -#' @export -#' @seealso [dist_spec()] -#' @keywords internal -get_generation_time <- function(disease, source, max_value = 14, - fixed = FALSE) { - lifecycle::deprecate_warn( - "1.5.0", "get_generation_time()", - details = c( - paste( - "Please use distribution functions such as `Gamma()` or `Lognormal()`", - "instead." - ), - "The function will be removed completely in the next version.", - paste( - "To obtain the previous estimate by Ganyani et al. (2020) use", - "`example_generation_time`." - ) - ) - ) - dist <- get_dist(EpiNow2::generation_times, - disease = disease, source = source, - max_value = max_value, fixed = fixed - ) - - return(dist) -} -#' Get a Literature Distribution for the Incubation Period -#' -#' @description `r lifecycle::badge("deprecated")` -#' -#' Extracts a literature distribution from `generation_times`. -#' This function has been deprecated. Please specify a distribution -#' using functions such as [Gamma()] or [LogNormal()] instead. -#' -#' @inheritParams get_dist -#' @inherit get_dist -#' @export -#' @keywords internal -get_incubation_period <- function(disease, source, max_value = 14, - fixed = FALSE) { - lifecycle::deprecate_warn( - "1.5.0", "get_incubation_period()", - details = c( - paste( - "Please use distribution functions such as `Gamma()` or `Lognormal()`", - "instead." - ), - "The function will be removed completely in the next version.", - paste( - "To obtain the previous estimate by Ganyani et al. (2020) use", - "`example_incubation_period`." - ) - ) - ) - dist <- get_dist(EpiNow2::incubation_periods, - disease = disease, source = source, - max_value = max_value, fixed = fixed - ) - - return(dist) -} #' Get Regions with Most Reported Cases #' #' @description `r lifecycle::badge("stable")` diff --git a/R/opts.R b/R/opts.R index 3d212614d..11af0a9a3 100644 --- a/R/opts.R +++ b/R/opts.R @@ -44,52 +44,18 @@ generation_time_opts <- function(dist = Fixed(1), ..., disease, source, max = 14, fixed = FALSE, tolerance = 0.001, weight_prior = TRUE) { - deprecated_options_given <- FALSE dot_options <- list(...) - ## check consistent options are given - type_options <- (length(dot_options) > 0) + ## distributional parameters - (!missing(disease) && !missing(source)) ## from included distributions - if (type_options > 1) { + if ((length(dot_options) > 0) || + (!missing(disease) && !missing(source)) || + (!is(dist, "dist_spec"))) { stop( - "Generation time can be given either as distributional options ", - "or as a combination of disease and source, but not both." - ) - } - if (length(dot_options) > 0) { - if (is(dist, "dist_spec")) { ## dist not specified - dot_options$distribution <- "gamma" - } - ## set max - if (!("max" %in% names(dot_options))) { - dot_options$max <- max - } - ## set default of mean=1 for backwards compatibility - if (!("mean" %in% names(dot_options))) { - dot_options$mean <- 1 - } - dist <- do.call(dist_spec, dot_options) - if (fixed) dist <- fix_dist(dist) - deprecated_options_given <- TRUE - } else if (!missing(disease) && !missing(source)) { - dist <- get_generation_time(disease, source, max, fixed) - dist$fixed <- fixed - deprecated_options_given <- TRUE - } - if (!is(dist, "dist_spec")) { - if (is.list(dist) && length(dot_options) == 0) { - dist <- do.call(dist_spec, dist) - } - deprecated_options_given <- TRUE - } - if (deprecated_options_given) { - warning( "The generation time distribution should be given to ", "`generation_time_opts` using a `dist_spec`. ", "This behaviour has changed from previous versions of `EpiNow2` and ", "any code using it may need to be updated as any other ways of ", - "specifying the generation time are deprecated and will be removed in ", - "the next version. For examples and more ", + "specifying the generation time are deprecated.", + "For examples and more ", "information, see the relevant documentation pages using ", "`?generation_time_opts`") } @@ -189,7 +155,7 @@ secondary_opts <- function(type = c("incidence", "prevalence"), ...) { #' @inheritParams generation_time_opts #' @return A `` object summarising the input delay distributions. #' @seealso [convert_to_logmean()] [convert_to_logsd()] -#' [bootstrapped_dist_fit()] [dist_spec()] +#' [bootstrapped_dist_fit()] \code{\link{Distributions}} #' @export #' @examples #' # no delays @@ -209,27 +175,14 @@ delay_opts <- function(dist = Fixed(0), ..., fixed = FALSE, tolerance = 0.001, weight_prior = TRUE) { dot_options <- list(...) if (!is(dist, "dist_spec")) { ## could be old syntax - if (is.list(dist)) { - ## combine lists if more than one given - dot_options <- c(list(dist), dot_options) - dist <- lapply(dot_options, do.call, what = dist_spec) - if (length(dist) > 1) { - for (i in seq(2, length(dist))) { - dist[[1]] <- dist[[1]] + dist[[i]] - } - } - dist <- dist[[1]] - } else { - stop("`dist` should be given as result of a call to `dist_spec`.") - } - warning( + stop( "Delay distributions must be of given either using a call to ", "`dist_spec` or one of the `get_...` functions such as ", "`get_incubation_period`. ", "This behaviour has changed from previous versions of `EpiNow2` and ", "any code using it may need to be updated as any other ways of ", - "specifying delays are deprecated and will be removed in ", - "the next version. For examples and more ", + "specifying delays are deprecated. ", + "For examples and more ", "information, see the relevant documentation pages using ", "`?delay_opts`." ) @@ -268,7 +221,7 @@ delay_opts <- function(dist = Fixed(0), ..., fixed = FALSE, tolerance = 0.001, #' distribution. #' #' @seealso [convert_to_logmean()] [convert_to_logsd()] -#' [bootstrapped_dist_fit()] [dist_spec()] +#' [bootstrapped_dist_fit()] \code{\link{Distributions}} #' @export #' @examples #' # no truncation @@ -279,10 +232,7 @@ delay_opts <- function(dist = Fixed(0), ..., fixed = FALSE, tolerance = 0.001, trunc_opts <- function(dist = Fixed(0), tolerance = 0.001, weight_prior = FALSE) { if (!is(dist, "dist_spec")) { - if (is.list(dist)) { - dist <- do.call(dist_spec, dist) - } - warning( + stop( "Truncation distributions must be of given either using a call to ", "`dist_spec` or one of the `get_...` functions. ", "This behaviour has changed from previous versions of `EpiNow2` and ", @@ -583,11 +533,10 @@ obs_opts <- function(family = c("negbin", "poisson"), } if (length(phi) == 2 && is.numeric(phi)) { - warning( + stop( "Specifying `phi` as a length 2 vector is deprecated. Mean and SD ", "should be given as list elements." ) - phi <- list(mean = phi[1], sd = phi[2]) } obs <- list( family = arg_match(family), @@ -614,33 +563,6 @@ obs_opts <- function(family = c("negbin", "poisson"), return(obs) } -#' Rstan Sampling Options -#' -#' @description `r lifecycle::badge("deprecated")` -#' Deprecated; use [stan_sampling_opts()] instead. -#' @inheritParams stan_sampling_opts -#' @return A list of arguments to pass to [rstan::sampling()]. -#' @export -rstan_sampling_opts <- function(cores = getOption("mc.cores", 1L), - warmup = 250, - samples = 2000, - chains = 4, - control = list(), - save_warmup = FALSE, - seed = as.integer(runif(1, 1, 1e8)), - future = FALSE, - max_execution_time = Inf, - ...) { - lifecycle::deprecate_warn( - "1.5.0", "rstan_sampling_opts()", - "stan_sampling_opts()" - ) - return(stan_sampling_opts( - cores, warmup, samples, chains, control, save_warmup, seed, future, - max_execution_time, backend = "rstan", ... - )) -} - #' Stan Sampling Options #' #' @description `r lifecycle::badge("stable")` @@ -738,23 +660,6 @@ stan_sampling_opts <- function(cores = getOption("mc.cores", 1L), return(opts) } -#' Rstan Variational Bayes Options -#' -#' @description `r lifecycle::badge("deprecated")` -#' Deprecated; use [stan_vb_opts()] instead. -#' @inheritParams stan_vb_opts -#' @return A list of arguments to pass to [rstan::vb()]. -#' @export -rstan_vb_opts <- function(samples = 2000, - trials = 10, - iter = 10000, ...) { - lifecycle::deprecate_warn( - "1.5.0", "rstan_vb_opts()", - "stan_vb_opts()" - ) - return(stan_vb_opts(samples, trials, iter, ...)) -} - #' Stan Variational Bayes Options #' #' @description `r lifecycle::badge("stable")` @@ -846,51 +751,6 @@ stan_pathfinder_opts <- function(backend = "cmdstanr", return(opts) } -#' Rstan Options -#' -#' @description `r lifecycle::badge("deprecated")` -#' Deprecated; specify options in [stan_opts()] instead. -#' -#' @param object Stan model object. By default uses the compiled package -#' default. -#' -#' @param method A character string, defaulting to sampling. Currently supports -#' [rstan::sampling()] ("sampling") or [rstan::vb()]. -#' -#' @param ... Additional parameters to pass underlying option functions. -#' @importFrom rlang arg_match -#' @return A list of arguments to pass to the appropriate rstan functions. -#' @export -#' @inheritParams rstan_sampling_opts -#' @seealso [rstan_sampling_opts()] [rstan_vb_opts()] -rstan_opts <- function(object = NULL, - samples = 2000, - method = c("sampling", "vb"), ...) { - lifecycle::deprecate_warn( - "1.5.0", "rstan_opts()", - "stan_opts()" - ) - method <- arg_match(method) - # shared everywhere opts - if (is.null(object)) { - object <- stanmodels$estimate_infections - } - opts <- list( - object = object, - method = method - ) - if (method == "sampling") { - opts <- c( - opts, stan_sampling_opts(samples = samples, backend = "rstan", ...) - ) - } else if (method == "vb") { - opts <- c( - opts, stan_vb_opts(samples = samples, ...) - ) - } - return(opts) -} - #' Stan Options #' #' @description `r lifecycle::badge("stable")` @@ -911,21 +771,8 @@ rstan_opts <- function(object = NULL, #' @param backend Character string indicating the backend to use for fitting #' stan models. Supported arguments are "rstan" (default) or "cmdstanr". #' -#' @param init_fit `r lifecycle::badge("experimental")` -#' Character string or `stanfit` object, defaults to NULL. Should an initial -#' fit be used to initialise the full fit. An example scenario would be using a -#' national level fit to parametrise regional level fits. Optionally a -#' character string can be passed with the currently supported option being -#' "cumulative". This fits the model to cumulative cases and may be useful for -#' certain data sets where the sampler gets stuck or struggles to initialise. -#' See [init_cumulative_fit()] for details. -#' -#' This implementation is based on the approach taken in -#' [epidemia](https://github.com/ImperialCollegeLondon/epidemia/) authored by -#' James Scott. -#' -#' This argument is deprecated and the default (NULL) will be used from -#' the next version. +#' @param init_fit `r lifecycle::badge("deprecated")` +#' This argument is deprecated. #' #' @param return_fit Logical, defaults to TRUE. Should the fit stan model be #' returned. @@ -1001,16 +848,10 @@ stan_opts <- function(object = NULL, } if (!is.null(init_fit)) { - deprecate_warn( + deprecate_stop( when = "1.5.0", - what = "stan_opts(init_fit)", - details = paste("This argument is deprecated and the default (NULL)", - "will be used from the next version.") + what = "stan_opts(init_fit)" ) - if (is.character(init_fit)) { - init_fit <- arg_match(init_fit, values = "cumulative") - } - opts$init_fit <- init_fit } opts <- c(opts, list(return_fit = return_fit)) attr(opts, "class") <- c("stan_opts", class(opts)) diff --git a/R/regional_epinow.R b/R/regional_epinow.R index 070e75c32..23ccb52eb 100644 --- a/R/regional_epinow.R +++ b/R/regional_epinow.R @@ -113,20 +113,12 @@ regional_epinow <- function(data, verbose = FALSE, logs = tempdir(check = TRUE), ..., reported_cases) { - # Warning for deprecated arguments if (!missing(reported_cases)) { - if (!missing(data)) { - stop("Can't have `reported_cases` and `data` arguments. ", - "Use `data` instead." - ) - } - lifecycle::deprecate_warn( + lifecycle::deprecate_stop( "1.5.0", "regional_epinow(reported_cases)", - "regional_epinow(data)", - "The argument will be removed completely in the next version." + "regional_epinow(data)" ) - data <- reported_cases } # supported output output <- match_output_arguments(output, diff --git a/R/simulate_infections.R b/R/simulate_infections.R index 0bd4631bd..59ddd950c 100644 --- a/R/simulate_infections.R +++ b/R/simulate_infections.R @@ -8,10 +8,6 @@ #' standard deviation of delays or observation scaling, must be fixed. #' Uncertain parameters are not allowed. #' -#' A previous function called [simulate_infections()] that simulates from a -#' given model fit has been renamed [forecast_infections()]. Using -#' [simulate_infections()] with existing estimates is now deprecated. This -#' option will be removed in the next version. #' @param R a data frame of reproduction numbers (column `R`) by date (column #' `date`). Column `R` must be numeric and `date` must be in date format. If #' not all days between the first and last day in the `date` are present, @@ -75,16 +71,11 @@ simulate_infections <- function(estimates, R, initial_infections, pop = 0, ...) { ## deprecated usage if (!missing(estimates)) { - deprecate_warn( + deprecate_stop( "1.5.0", "simulate_infections(estimates)", - "forecast_infections()", - details = paste0( - "The `estimates` option will be removed from [simulate_infections()] ", - "in the next version." - ) + "forecast_infections()" ) - return(forecast_infections(estimates = estimates, ...)) } ## check inputs diff --git a/R/simulate_secondary.R b/R/simulate_secondary.R index ed1aabb58..956f8470b 100644 --- a/R/simulate_secondary.R +++ b/R/simulate_secondary.R @@ -41,7 +41,6 @@ simulate_secondary <- function(primary, CrIs = c(0.2, 0.5, 0.9), backend = "rstan", ...) { - ## deprecated usage assert_data_frame(primary, any.missing = FALSE) assert_subset(c("date", "primary"), colnames(primary)) assert_date(primary$date) diff --git a/man/adjust_infection_to_report.Rd b/man/adjust_infection_to_report.Rd index decaa3a95..7171307c5 100644 --- a/man/adjust_infection_to_report.Rd +++ b/man/adjust_infection_to_report.Rd @@ -46,43 +46,4 @@ A \code{data.table} containing a \code{date} variable (date of report) and a Maps from cases by date of infection to date of report via date of onset. } -\examples{ -\donttest{ -# This function is deprecated and its functionality can now be accessed -# from [simulate_secondary()]. -# Here are some examples of how to use [simulate_secondary()] to replace -# adjust_infection_to_report(). - -# Old (using adjust_infection_to_report()): -# Define example case data -cases <- data.table::copy(example_confirmed) -cases <- cases[, cases := as.integer(confirm)] -# Define a simple reporting delay distribution -delay_def <- lognorm_dist_def( - mean = 5, mean_sd = 1, sd = 3, sd_sd = 1, - max_value = 30, samples = 1, to_log = TRUE -) -report <- adjust_infection_to_report( - cases, - delay_defs = list(delay_def), - reporting_model = function(n) rpois(length(n), n) -) -print(report) - -# New (using simulate_secondary()): -cases <- data.table::copy(example_confirmed) -cases <- cases[, primary := as.integer(confirm)] -uncertain_delay <- LogNormal( - mean = Normal(5, 1), sd = Normal(3, 1), - max = 30 -) -delay <- fix_dist(uncertain_delay, strategy = "sample") -report <- simulate_secondary( - cases, - delays = delay_opts(delay), - obs = obs_opts(family = "poisson") -) -print(report) -} -} \keyword{internal} diff --git a/man/c.dist_spec.Rd b/man/c.dist_spec.Rd index 9c8415679..7f926b5a5 100644 --- a/man/c.dist_spec.Rd +++ b/man/c.dist_spec.Rd @@ -7,7 +7,7 @@ \method{c}{dist_spec}(...) } \arguments{ -\item{...}{The delay distributions (from calls to \code{\link[=dist_spec]{dist_spec()}}) to combine} +\item{...}{The delay distributions to combine} } \value{ Combined delay distributions (with class \verb{}) diff --git a/man/delay_opts.Rd b/man/delay_opts.Rd index ea5c8dccd..d6e2dc381 100644 --- a/man/delay_opts.Rd +++ b/man/delay_opts.Rd @@ -54,5 +54,5 @@ delay_opts(delay + delay) } \seealso{ \code{\link[=convert_to_logmean]{convert_to_logmean()}} \code{\link[=convert_to_logsd]{convert_to_logsd()}} -\code{\link[=bootstrapped_dist_fit]{bootstrapped_dist_fit()}} \code{\link[=dist_spec]{dist_spec()}} +\code{\link[=bootstrapped_dist_fit]{bootstrapped_dist_fit()}} \code{\link{Distributions}} } diff --git a/man/dist_spec.Rd b/man/dist_spec.Rd index 0af001f4a..6eeb683aa 100644 --- a/man/dist_spec.Rd +++ b/man/dist_spec.Rd @@ -8,10 +8,6 @@ dist_spec( distribution = c("lognormal", "normal", "gamma", "fixed", "empty"), params_mean = numeric(0), params_sd = numeric(0), - mean, - sd = 0, - mean_sd = 0, - sd_sd = 0, max = Inf, pmf = numeric(0), fixed = FALSE @@ -29,14 +25,6 @@ distribution as defined in [natural_params().} \item{params_sd}{Numeric. Standard deviations of the parameters of the distribution as defined in [natural_params().} -\item{mean}{Deprecated; use \code{params_mean} instead.} - -\item{sd}{Deprecated; use \code{params_mean} instead.} - -\item{mean_sd}{Deprecated; use \code{params_sd} instead.} - -\item{sd_sd}{Deprecated; use \code{params_sd} instead.} - \item{max}{Numeric, maximum value of the distribution. The distribution will be truncated at this value. Default: \code{Inf}, i.e. no maximum.} diff --git a/man/epinow.Rd b/man/epinow.Rd index b191cc5e1..c44770f93 100644 --- a/man/epinow.Rd +++ b/man/epinow.Rd @@ -156,7 +156,7 @@ reported_cases <- example_confirmed[1:40] # estimate Rt and nowcast/forecast cases by date of infection out <- epinow( - reported_cases = reported_cases, + data = reported_cases, generation_time = generation_time_opts(generation_time), rt = rt_opts(prior = list(mean = 2, sd = 0.1)), delays = delay_opts(incubation_period + reporting_delay) diff --git a/man/estimate_truncation.Rd b/man/estimate_truncation.Rd index d0c5dc323..ffe91f243 100644 --- a/man/estimate_truncation.Rd +++ b/man/estimate_truncation.Rd @@ -6,9 +6,6 @@ \usage{ estimate_truncation( data, - max_truncation, - trunc_max = 10, - trunc_dist = "lognormal", truncation = trunc_opts(LogNormal(meanlog = Normal(0, 1), sdlog = Normal(1, 1), max = 10)), model = NULL, @@ -28,12 +25,6 @@ and a confirm (numeric) variable. Each data set should be a snapshot of the reported data over time. All data sets must contain a complete vector of dates.} -\item{max_truncation}{Deprecated; use \code{truncation} instead.} - -\item{trunc_max}{Deprecated; use \code{truncation} instead.} - -\item{trunc_dist}{Deprecated; use \code{truncation} instead.} - \item{truncation}{A call to \code{\link[=trunc_opts]{trunc_opts()}} defining the truncation of the observed data. Defaults to \code{\link[=trunc_opts]{trunc_opts()}}, i.e. no truncation. See the \code{\link[=estimate_truncation]{estimate_truncation()}} help file for an approach to estimating this from diff --git a/man/gamma_dist_def.Rd b/man/gamma_dist_def.Rd index 760e60bb4..0ae5ea187 100644 --- a/man/gamma_dist_def.Rd +++ b/man/gamma_dist_def.Rd @@ -46,23 +46,4 @@ A \verb{} defining the distribution as used by \code{\link[=dist_ske \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Deprecated; use \code{\link[=Gamma]{Gamma()}} instead to define a gamma distribution. } -\examples{ -# using estimated shape and scale -def <- gamma_dist_def( - shape = 5.807, shape_sd = 0.2, - scale = 0.9, scale_sd = 0.05, - max_value = 20, samples = 10 -) -print(def) -def$params[[1]] - -# using mean and sd -def <- gamma_dist_def( - mean = 3, mean_sd = 0.5, - sd = 3, sd_sd = 0.1, - max_value = 20, samples = 10 -) -print(def) -def$params[[1]] -} \keyword{internal} diff --git a/man/get_dist.Rd b/man/get_dist.Rd index 36a20357c..132a06c4b 100644 --- a/man/get_dist.Rd +++ b/man/get_dist.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get.R +% Please edit documentation in R/deprecated.R \name{get_dist} \alias{get_dist} \title{Get a Literature Distribution} diff --git a/man/get_distribution.Rd b/man/get_distribution.Rd index 904cefe3c..28dfb930a 100644 --- a/man/get_distribution.Rd +++ b/man/get_distribution.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/dist_spec.R \name{get_distribution} \alias{get_distribution} -\title{Get the distribution of a \code{\link[=dist_spec]{dist_spec()}}} +\title{Get the distribution of a } \usage{ get_distribution(x, id = NULL) } diff --git a/man/get_generation_time.Rd b/man/get_generation_time.Rd index 6dc2db796..b222e1ab0 100644 --- a/man/get_generation_time.Rd +++ b/man/get_generation_time.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get.R +% Please edit documentation in R/deprecated.R \name{get_generation_time} \alias{get_generation_time} \title{Get a Literature Distribution for the Generation Time} diff --git a/man/get_incubation_period.Rd b/man/get_incubation_period.Rd index accfaaa1d..07b0b2a0c 100644 --- a/man/get_incubation_period.Rd +++ b/man/get_incubation_period.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get.R +% Please edit documentation in R/deprecated.R \name{get_incubation_period} \alias{get_incubation_period} \title{Get a Literature Distribution for the Incubation Period} diff --git a/man/lognorm_dist_def.Rd b/man/lognorm_dist_def.Rd index 5eb9b031a..bcf35d3bf 100644 --- a/man/lognorm_dist_def.Rd +++ b/man/lognorm_dist_def.Rd @@ -31,22 +31,4 @@ Generates a distribution definition when only parameter estimates are available for log normal distributed parameters. See \code{\link[=rlnorm]{rlnorm()}} for distribution information. } -\examples{ -def <- lognorm_dist_def( - mean = 1.621, mean_sd = 0.0640, - sd = 0.418, sd_sd = 0.0691, - max_value = 20, samples = 10 -) -print(def) -def$params[[1]] - -def <- lognorm_dist_def( - mean = 5, mean_sd = 1, - sd = 3, sd_sd = 1, - max_value = 20, samples = 10, - to_log = TRUE -) -print(def) -def$params[[1]] -} \keyword{internal} diff --git a/man/max.dist_spec.Rd b/man/max.dist_spec.Rd index 5e4aed9e9..c81f811ef 100644 --- a/man/max.dist_spec.Rd +++ b/man/max.dist_spec.Rd @@ -7,7 +7,7 @@ \method{max}{dist_spec}(x, ...) } \arguments{ -\item{x}{The \code{\link[=dist_spec]{dist_spec()}} to use} +\item{x}{The to use} \item{...}{Not used} } @@ -17,7 +17,7 @@ A vector of means. \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} This works out the maximum of all the (parametric / nonparametric) delay -distributions combined in the passed \code{\link[=dist_spec]{dist_spec()}} (ignoring any uncertainty +distributions combined in the passed (ignoring any uncertainty in parameters) } \examples{ diff --git a/man/mean.dist_spec.Rd b/man/mean.dist_spec.Rd index fe38f65bf..f517df066 100644 --- a/man/mean.dist_spec.Rd +++ b/man/mean.dist_spec.Rd @@ -18,7 +18,7 @@ parameters will be returned as NA.} \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} This works out the mean of all the (parametric / nonparametric) delay -distributions combined in the passed \code{\link[=dist_spec]{dist_spec()}} (ignoring any uncertainty +distributions combined in the passed (ignoring any uncertainty in parameters) } \examples{ diff --git a/man/plus-.dist_spec.Rd b/man/plus-.dist_spec.Rd index 7692bafbe..16e967faa 100644 --- a/man/plus-.dist_spec.Rd +++ b/man/plus-.dist_spec.Rd @@ -7,10 +7,10 @@ \method{+}{dist_spec}(e1, e2) } \arguments{ -\item{e1}{The first delay distribution (of type \code{\link[=dist_spec]{dist_spec()}}) to +\item{e1}{The first delay distribution (of type ) to combine.} -\item{e2}{The second delay distribution (of type \code{\link[=dist_spec]{dist_spec()}}) to +\item{e2}{The second delay distribution (of type ) to combine.} } \value{ diff --git a/man/print.dist_spec.Rd b/man/print.dist_spec.Rd index 21dbba464..c3ea43cfb 100644 --- a/man/print.dist_spec.Rd +++ b/man/print.dist_spec.Rd @@ -17,7 +17,7 @@ invisible \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} This displays the parameters of the uncertain and probability mass -functions of fixed delay distributions combined in the passed \code{\link[=dist_spec]{dist_spec()}}. +functions of fixed delay distributions combined in the passed . } \examples{ #' # A fixed lognormal distribution with mean 5 and sd 1. diff --git a/man/report_cases.Rd b/man/report_cases.Rd index a729a7c6b..500d233e7 100644 --- a/man/report_cases.Rd +++ b/man/report_cases.Rd @@ -48,35 +48,4 @@ Convolves latent infections to reported cases via an observation model. Likely to be removed/replaced in later releases by functionality drawing on the \code{stan} implementation. } -\examples{ -\donttest{ -# This function is deprecated and its functionality can now be accessed -# from [simulate_secondary()]. -# Here are some examples of how to use [simulate_secondary()] to replace -# report_cases(). -# Old (using report_cases()): -# Define case data -cases <- example_confirmed[1:40] -cases <- cases[, cases := as.integer(confirm)] -cases <- cases[, confirm := NULL][, sample := 1] -reported_cases <- report_cases( - case_estimates = cases, - delays = delay_opts(example_incubation_period + example_reporting_delay), - type = "sample" -) -print(reported_cases$samples) - -# New (using simulate_secondary()): -cases <- example_confirmed[1:40] -cases <- cases[, primary := as.integer(confirm)] -report <- simulate_secondary( - cases, - delays = delay_opts( - fix_dist(example_incubation_period + example_reporting_delay) - ), - obs = obs_opts(family = "poisson") -) -print(report) -} -} \keyword{internal} diff --git a/man/rstan_opts.Rd b/man/rstan_opts.Rd index f13484bd4..985ed4ce2 100644 --- a/man/rstan_opts.Rd +++ b/man/rstan_opts.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/opts.R +% Please edit documentation in R/deprecated.R \name{rstan_opts} \alias{rstan_opts} \title{Rstan Options} diff --git a/man/rstan_sampling_opts.Rd b/man/rstan_sampling_opts.Rd index 567e134a2..a1889d609 100644 --- a/man/rstan_sampling_opts.Rd +++ b/man/rstan_sampling_opts.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/opts.R +% Please edit documentation in R/deprecated.R \name{rstan_sampling_opts} \alias{rstan_sampling_opts} \title{Rstan Sampling Options} diff --git a/man/rstan_vb_opts.Rd b/man/rstan_vb_opts.Rd index 0ffec4c2a..9d8c9c14a 100644 --- a/man/rstan_vb_opts.Rd +++ b/man/rstan_vb_opts.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/opts.R +% Please edit documentation in R/deprecated.R \name{rstan_vb_opts} \alias{rstan_vb_opts} \title{Rstan Variational Bayes Options} diff --git a/man/sample_approx_dist.Rd b/man/sample_approx_dist.Rd index 6ac8adfdb..431ad97f7 100644 --- a/man/sample_approx_dist.Rd +++ b/man/sample_approx_dist.Rd @@ -43,62 +43,6 @@ A \verb{} of cases by date of onset } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} -Convolves cases by a PMF function. This function will soon be removed or -replaced with a more robust stan implementation. -} -\examples{ -\donttest{ -cases <- example_confirmed -cases <- cases[, cases := as.integer(confirm)] -print(cases) - -# total cases -sum(cases$cases) - -delay_fn <- function(n, dist, cum) { - if (dist) { - pgamma(n + 0.9999, 2, 1) - pgamma(n - 1e-5, 2, 1) - } else { - as.integer(rgamma(n, 2, 1)) - } -} - -onsets <- sample_approx_dist( - cases = cases, - dist_fn = delay_fn -) - -# estimated onset distribution -print(onsets) - -# check that sum is equal to reported cases -total_onsets <- median( - purrr::map_dbl( - 1:10, - ~ sum(sample_approx_dist( - cases = cases, - dist_fn = delay_fn - )$cases) - ) -) -total_onsets - - -# map from onset cases to reported -reports <- sample_approx_dist( - cases = cases, - dist_fn = delay_fn, - direction = "forwards" -) - - -# map from onset cases to reported using a mean shift -reports <- sample_approx_dist( - cases = cases, - dist_fn = delay_fn, - direction = "forwards", - type = "median" -) -} +Deprecated; Convolves cases by a PMF function. } \keyword{internal} diff --git a/man/sd_dist.Rd b/man/sd_dist.Rd index be8ef17f6..303d21a22 100644 --- a/man/sd_dist.Rd +++ b/man/sd_dist.Rd @@ -7,7 +7,7 @@ sd_dist(x) } \arguments{ -\item{x}{The \code{\link[=dist_spec]{dist_spec()}} to use} +\item{x}{The to use} } \value{ A vector of standard deviations. @@ -15,7 +15,7 @@ A vector of standard deviations. \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} This works out the standard deviation of all the (parametric / -nonparametric) delay distributions combined in the passed \code{\link[=dist_spec]{dist_spec()}}. +nonparametric) delay distributions combined in the passed . } \examples{ \dontrun{ diff --git a/man/simulate_infections.Rd b/man/simulate_infections.Rd index b3ac1147a..1853b67ec 100644 --- a/man/simulate_infections.Rd +++ b/man/simulate_infections.Rd @@ -94,11 +94,6 @@ model can be specified using the same options as in \code{\link[=estimate_infect In order to simulate, all parameters that are specified such as the mean and standard deviation of delays or observation scaling, must be fixed. Uncertain parameters are not allowed. - -A previous function called \code{\link[=simulate_infections]{simulate_infections()}} that simulates from a -given model fit has been renamed \code{\link[=forecast_infections]{forecast_infections()}}. Using -\code{\link[=simulate_infections]{simulate_infections()}} with existing estimates is now deprecated. This -option will be removed in the next version. } \examples{ \donttest{ diff --git a/man/stan_opts.Rd b/man/stan_opts.Rd index 828f1940b..6d02872a8 100644 --- a/man/stan_opts.Rd +++ b/man/stan_opts.Rd @@ -31,21 +31,8 @@ laplace algorithm ("laplace") or pathfinder ("pathfinder").} \item{backend}{Character string indicating the backend to use for fitting stan models. Supported arguments are "rstan" (default) or "cmdstanr".} -\item{init_fit}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Character string or \code{stanfit} object, defaults to NULL. Should an initial -fit be used to initialise the full fit. An example scenario would be using a -national level fit to parametrise regional level fits. Optionally a -character string can be passed with the currently supported option being -"cumulative". This fits the model to cumulative cases and may be useful for -certain data sets where the sampler gets stuck or struggles to initialise. -See \code{\link[=init_cumulative_fit]{init_cumulative_fit()}} for details. - -This implementation is based on the approach taken in -\href{https://github.com/ImperialCollegeLondon/epidemia/}{epidemia} authored by -James Scott. - -This argument is deprecated and the default (NULL) will be used from -the next version.} +\item{init_fit}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} +This argument is deprecated.} \item{return_fit}{Logical, defaults to TRUE. Should the fit stan model be returned.} diff --git a/man/trunc_opts.Rd b/man/trunc_opts.Rd index 4ea435246..7205e3566 100644 --- a/man/trunc_opts.Rd +++ b/man/trunc_opts.Rd @@ -41,5 +41,5 @@ trunc_opts(dist = LogNormal(mean = 3, sd = 2, max = 10)) } \seealso{ \code{\link[=convert_to_logmean]{convert_to_logmean()}} \code{\link[=convert_to_logsd]{convert_to_logsd()}} -\code{\link[=bootstrapped_dist_fit]{bootstrapped_dist_fit()}} \code{\link[=dist_spec]{dist_spec()}} +\code{\link[=bootstrapped_dist_fit]{bootstrapped_dist_fit()}} \code{\link{Distributions}} } diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index a5d565846..e5e31d564 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -16,6 +16,3 @@ if (identical(Sys.getenv("NOT_CRAN"), "true")) { } withr::defer(future::plan("sequential"), teardown_env()) - -## process warning once as previous behaviour has been deprecated -dummy <- suppressWarnings(dist_spec(mean = 0, sd = 1, max = 5)) diff --git a/tests/testthat/test-adjust_infection_to_report.R b/tests/testthat/test-adjust_infection_to_report.R deleted file mode 100644 index 078e7c7c1..000000000 --- a/tests/testthat/test-adjust_infection_to_report.R +++ /dev/null @@ -1,41 +0,0 @@ - -# define example cases -cases <- data.table::copy(example_confirmed)[, cases := as.integer(confirm)] - -# define a single report delay distribution -delay <- LogNormal( - meanlog = Normal(1.4, 0.3), sdlog = Normal(0.6, 0.2), max = 30 -) - -test_that("adjust_infection_to_report can correctly handle a simple mapping", { - reports <- suppressWarnings(adjust_infection_to_report( - cases, - delay_defs = example_incubation_period + delay - )) - expect_true(nrow(reports) > 80) - expect_true(all(!is.infinite(reports$cases))) - expect_true(all(!is.na(reports$cases))) -}) - -test_that("adjust_infection_to_report can correctly handle a mapping with a day - of the week effect", { - reports <- suppressWarnings(adjust_infection_to_report( - cases, - delay_defs = example_incubation_period + delay, - reporting_effect = c(1.1, rep(1, 4), 0.95, 0.95) - )) - expect_true(nrow(reports) > 80) - expect_true(all(!is.infinite(reports$cases))) - expect_true(all(!is.na(reports$cases))) -}) - -test_that("deprecated functions are deprecated", { - # define example cases - cases <- data.table::copy(example_confirmed)[, cases := as.integer(confirm)] - expect_deprecated( - adjust_infection_to_report( - cases, - delay_defs = example_incubation_period + delay, - ) - ) -}) diff --git a/tests/testthat/test-create_obs_model.R b/tests/testthat/test-create_obs_model.R index b2940a284..b704ca54d 100644 --- a/tests/testthat/test-create_obs_model.R +++ b/tests/testthat/test-create_obs_model.R @@ -67,10 +67,3 @@ test_that("create_obs_model can be used with a user set phi", { expect_equal(obs$phi_sd, 0) expect_error(obs_opts(phi = c("Hi", "World"))) }) - -test_that("using a vector for phi in create_obs_model is deprecated", { - expect_warning( - create_obs_model(dates = dates, obs = obs_opts(phi = c(10, 0.1))), - "deprecated" - ) -}) diff --git a/tests/testthat/test-dist.R b/tests/testthat/test-dist.R index 826bb04e6..1fce67f51 100644 --- a/tests/testthat/test-dist.R +++ b/tests/testthat/test-dist.R @@ -19,24 +19,3 @@ test_that("distributions are the same in R and stan", { expect_equal(pmf_r_lognormal, pmf_stan_lognormal) expect_equal(pmf_r_gamma, pmf_stan_gamma) }) - -test_that("deprecated functions are deprecated", { - delay_fn <- function(n, dist, cum) { - pgamma(n + 0.9999, 2, 1) - pgamma(n - 1e-5, 2, 1) - } - expect_deprecated( - sample_approx_dist( - cases = example_confirmed[1:5], - dist_fn = delay_fn, - direction = "forwards", - type = "median" - ) - ) - args <- list(mean = 3, mean_sd = 0, sd = 2, sd_sd = 0, max_value = 15) - expect_deprecated( - do.call(lognorm_dist_def, (c(args, list(samples = 1))))$params[[1]] - ) - expect_deprecated( - do.call(gamma_dist_def, (c(args, list(samples = 1))))$params[[1]] - ) -}) diff --git a/tests/testthat/test-dist_spec.R b/tests/testthat/test-dist_spec.R index c961c0c3e..597160835 100644 --- a/tests/testthat/test-dist_spec.R +++ b/tests/testthat/test-dist_spec.R @@ -294,7 +294,3 @@ test_that("get functions report errors", { Gamma(mean = 4, sd = 1), Gamma(mean = 4, sd = 1) )), "must be specified") }) - -test_that("deprecated functions are deprecated", { - expect_deprecated(dist_spec(params_mean = c(1.6, 0.6), max = 19)) -}) diff --git a/tests/testthat/test-epinow.R b/tests/testthat/test-epinow.R index 50264ef18..b1857ebb5 100644 --- a/tests/testthat/test-epinow.R +++ b/tests/testthat/test-epinow.R @@ -198,14 +198,3 @@ test_that("epinow fails if given variational inference arguments when using NUTs ) )))) }) - -test_that("deprecated arguments are recognised", { - expect_deprecated( - x <- capture.output(suppressMessages( - epinow( - reported_cases = reported_cases, - generation_time = generation_time_opts(Fixed(1)) - ) - )) - ) -}) diff --git a/tests/testthat/test-estimate_secondary.R b/tests/testthat/test-estimate_secondary.R index b09020bb3..d4c64e948 100644 --- a/tests/testthat/test-estimate_secondary.R +++ b/tests/testthat/test-estimate_secondary.R @@ -229,9 +229,3 @@ test_that("estimate_secondary works with zero_threshold set", { expect_s3_class(out, "estimate_secondary") expect_named(out, c("predictions", "posterior", "data", "fit")) }) - -test_that("deprecated arguments are recognised", { - expect_deprecated( - estimate_secondary(reports = inc_cases) - ) -}) \ No newline at end of file diff --git a/tests/testthat/test-estimate_truncation.R b/tests/testthat/test-estimate_truncation.R index ccd7382ac..e0851d5cb 100644 --- a/tests/testthat/test-estimate_truncation.R +++ b/tests/testthat/test-estimate_truncation.R @@ -84,21 +84,4 @@ test_that("estimate_truncation works with zero_threshold set", { expect_s3_class(out$dist, "dist_spec") }) -test_that("deprecated arguments are recognised", { - expect_error(estimate_truncation(example_truncated, - verbose = FALSE, trunc_max = 10 - ), "deprecated") - expect_error(estimate_truncation(example_truncated, - verbose = FALSE, max_truncation = 10 - ), "deprecated") - expect_error(estimate_truncation(example_truncated, - verbose = FALSE, trunc_dist = "lognormal" - ), "deprecated") - expect_deprecated( - estimate_truncation(obs = example_truncated, - verbose = FALSE - ) - ) -}) - options(old_opts) diff --git a/tests/testthat/test-forecast-infections.R b/tests/testthat/test-forecast-infections.R index 3bd49b509..d43c81eaf 100644 --- a/tests/testthat/test-forecast-infections.R +++ b/tests/testthat/test-forecast-infections.R @@ -78,9 +78,3 @@ test_that("forecast_infections works to simulate a passed in estimate_infections sims_sample <- forecast_infections(out, R_samples) expect_equal(names(sims_sample), c("samples", "summarised", "observations")) }) - -test_that("simulate_infections with a given estimate is deprecated", { - expect_deprecated( - sims <- simulate_infections(out) - ) -}) diff --git a/tests/testthat/test-get_dist.R b/tests/testthat/test-get_dist.R deleted file mode 100644 index 97cafd400..000000000 --- a/tests/testthat/test-get_dist.R +++ /dev/null @@ -1,6 +0,0 @@ -test_that("get_dist is deprecated", { - data <- data.table::data.table(mean = 1, mean_sd = 1, sd = 1, sd_sd = 1, source = "test", disease = "test", dist = "lognormal") - expect_deprecated( - get_dist(data, disease = "test", source = "test") - ) -}) diff --git a/tests/testthat/test-opts.R b/tests/testthat/test-opts.R deleted file mode 100644 index e53f812be..000000000 --- a/tests/testthat/test-opts.R +++ /dev/null @@ -1,7 +0,0 @@ -test_that("default generation time options produce a warning", { - expect_warning(generation_time_opts(), "1 day") -}) - -test_that("deprecated arguments are caught", { - expect_deprecated(stan_opts(init_fit = "cumulative")) -}) diff --git a/tests/testthat/test-regional_epinow.R b/tests/testthat/test-regional_epinow.R index 412bab8c6..830899bb1 100644 --- a/tests/testthat/test-regional_epinow.R +++ b/tests/testthat/test-regional_epinow.R @@ -109,11 +109,3 @@ test_that("regional_epinow produces expected output when run with region specifi df_non_zero(out$regional$realland$summary) expect_equal(names(out$regional$realland$plots), c("summary", "infections", "reports", "R", "growth_rate")) }) - -test_that("deprecated arguments are recognised", { - expect_deprecated( - regional_epinow( - reported_cases = cases, - generation_time = generation_time_opts(Fixed(1)) - )) -}) diff --git a/tests/testthat/test-report_cases.R b/tests/testthat/test-report_cases.R deleted file mode 100644 index e530ff746..000000000 --- a/tests/testthat/test-report_cases.R +++ /dev/null @@ -1,37 +0,0 @@ -test_that("report_cases can simulate infections forward", { - set.seed(123) - # define example cases - cases <- example_confirmed[1:10] - - # Instead of running them model we use example - # data for speed in this example. - cases <- cases[, cases := as.integer(confirm)] - cases <- cases[, confirm := NULL][, sample := 1] - reported_cases <- suppressWarnings(report_cases( - case_estimates = cases, - delays = delay_opts(example_incubation_period + example_reporting_delay), - type = "sample" - )) - expect_equal(class(reported_cases), "list") - expect_equal(class(reported_cases$samples), c("data.table", "data.frame")) - expect_equal(class(reported_cases$summarised), c("data.table", "data.frame")) - expect_equal(nrow(reported_cases$summarised), 7) - expect_equal(class(reported_cases$summarised$median), "numeric") - set.seed(Sys.time()) -}) - -test_that("deprecated functions are deprecated", { - cases <- example_confirmed[1:40] - # get example delays - #' # Instead of running them model we use example - #' # data for speed in this example. - cases <- cases[, cases := as.integer(confirm)] - cases <- cases[, confirm := NULL][, sample := 1] - expect_deprecated( - report_cases( - case_estimates = cases, - delays = delay_opts(example_incubation_period + example_reporting_delay), - type = "sample" - ) - ) -})