diff --git a/NAMESPACE b/NAMESPACE index 1da104c88..4d9ed33bd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,8 +4,8 @@ S3method("+",dist_spec) S3method(c,dist_spec) S3method(discretise,dist_spec) S3method(discretise,multi_dist_spec) -S3method(fix_dist,dist_spec) -S3method(fix_dist,multi_dist_spec) +S3method(fix_parameters,dist_spec) +S3method(fix_parameters,multi_dist_spec) S3method(is_constrained,dist_spec) S3method(is_constrained,multi_dist_spec) S3method(max,dist_spec) @@ -57,7 +57,7 @@ export(extract_CrIs) export(extract_inits) export(extract_samples) export(extract_stan_param) -export(fix_dist) +export(fix_parameters) export(forecast_infections) export(forecast_secondary) export(gamma_dist_def) diff --git a/NEWS.md b/NEWS.md index 7fa1e344f..f91dce13e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -24,6 +24,10 @@ - Switch to broadcasting the day of the week effect. By @seabbs in #746 and reviewed by @jamesmbaazam. - A warning is now thrown if nonparametric PMFs passed to delay options have consecutive tail values that are below a certain low threshold as these lead to loss in speed with little gain in accuracy. By @jamesmbaazam in #752 and reviewed by @seabbs. +## Package changes + +- `fix_dist()` has been renamed to `fix_parameters()` because it removes the uncertainty in a distribution's parameters. By @sbfnk in #733 and reviewed by @jamesmbaazam. + ## Bug fixes - a bug was fixed that caused delay option functions to report an error if only the tolerance was specified. By @sbfnk in #716 and reviewed by @jamesmbaazam. diff --git a/R/create.R b/R/create.R index fb9677f50..5a456d1e8 100644 --- a/R/create.R +++ b/R/create.R @@ -783,7 +783,7 @@ create_stan_delays <- function(..., time_points = 1L) { ## discretise delays <- map(delays, discretise, strict = FALSE) ## get maximum delays - bounded_delays <- map(delays, function(x) discretise(fix_dist(x))) + bounded_delays <- map(delays, function(x) discretise(fix_parameters(x))) max_delay <- unname(as.numeric(flatten(map(bounded_delays, max)))) ## number of different non-empty types type_n <- vapply(delays, ndist, integer(1)) diff --git a/R/deprecated.R b/R/deprecated.R index 61a288e5b..3cc3d90a4 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -67,7 +67,7 @@ adjust_infection_to_report <- function(infections, delay_defs, #' probability mass function of the delay (starting with 0); defaults to an #' empty vector corresponding to a parametric specification of the distribution #' (using \code{params_mean}, and \code{params_sd}. -#' @param fixed Deprecated, use [fix_dist()] instead. +#' @param fixed Deprecated, use [fix_parameters()] instead. #' @return A list of distribution options. #' @importFrom rlang warn arg_match #' @keywords internal @@ -623,3 +623,25 @@ apply_tolerance <- function(x, tolerance) { attributes(y) <- attributes(x) return(y) } + +#' Remove uncertainty in the parameters of a `` +#' +#' @description `r lifecycle::badge("deprecated")` +#' This function has been renamed to [fix_parameters()] as a more appropriate +#' name. +#' @return A `` object without uncertainty +#' @keywords internal +#' @importFrom cli cli_abort +#' @param x A `` +#' @param strategy Character; either "mean" (use the mean estimates of the +#' mean and standard deviation) or "sample" (randomly sample mean and +#' standard deviation from uncertainty given in the `` +fix_dist <- function(x, strategy = c("mean", "sample")) { + lifecycle::deprecate_warn( + "1.6.0", "fix_dist()", "fix_parameters()" + ) + if (!is(x, "dist_spec")) { + cli_abort("!" = "Can only fix distributions in a .") + } + fix_parameters(x, strategy) +} diff --git a/R/dist_spec.R b/R/dist_spec.R index 25a0a1aa4..7b672fe32 100644 --- a/R/dist_spec.R +++ b/R/dist_spec.R @@ -648,7 +648,7 @@ plot.dist_spec <- function(x, samples = 50L, res = 1, cumulative = TRUE, ...) { samples <- 1 ## only need 1 sample if fixed } dists <- lapply(seq_len(samples), function(y) { - fix_dist(extract_single_dist(x, i), strategy = "sample") + fix_parameters(extract_single_dist(x, i), strategy = "sample") }) tolerance <- attr(x, "tolerance") if (is.null(tolerance)) { @@ -743,12 +743,12 @@ extract_single_dist <- function(x, i) { } #' @export -fix_dist <- function(x, ...) { - UseMethod("fix_dist") +fix_parameters <- function(x, ...) { + UseMethod("fix_parameters") } #' Fix the parameters of a `` #' -#' @name fix_dist +#' @name fix_parameters #' @description `r lifecycle::badge("experimental")` #' If the given `` has any uncertainty, it is removed and the #' corresponding distribution converted into a fixed one. @@ -761,15 +761,15 @@ fix_dist <- function(x, ...) { #' @param ... ignored #' @importFrom truncnorm rtruncnorm #' @importFrom rlang arg_match -#' @method fix_dist dist_spec +#' @method fix_parameters dist_spec #' @examples #' # An uncertain gamma distribution with mean 3 and sd 2 #' dist <- LogNormal( #' meanlog = Normal(3, 0.5), sdlog = Normal(2, 0.5), max = 20 #' ) #' -#' fix_dist(dist) -fix_dist.dist_spec <- function(x, strategy = c("mean", "sample"), ...) { +#' fix_parameters(dist) +fix_parameters.dist_spec <- function(x, strategy = c("mean", "sample"), ...) { ## match strategy argument to options strategy <- arg_match(strategy) @@ -798,10 +798,11 @@ fix_dist.dist_spec <- function(x, strategy = c("mean", "sample"), ...) { } #' @export -#' @method fix_dist multi_dist_spec -fix_dist.multi_dist_spec <- function(x, strategy = c("mean", "sample"), ...) { +#' @method fix_parameters multi_dist_spec +fix_parameters.multi_dist_spec <- function(x, strategy = + c("mean", "sample"), ...) { for (i in seq_len(ndist(x))) { - x[[i]] <- fix_dist(x[[i]]) + x[[i]] <- fix_parameters(x[[i]]) } return(x) } diff --git a/R/simulate_infections.R b/R/simulate_infections.R index f7ade498b..f2b106b48 100644 --- a/R/simulate_infections.R +++ b/R/simulate_infections.R @@ -54,9 +54,9 @@ #' R = R, #' initial_infections = 100, #' generation_time = generation_time_opts( -#' fix_dist(example_generation_time) +#' fix_parameters(example_generation_time) #' ), -#' delays = delay_opts(fix_dist(example_reporting_delay)), +#' delays = delay_opts(fix_parameters(example_reporting_delay)), #' obs = obs_opts(family = "poisson") #' ) #' } @@ -138,7 +138,7 @@ simulate_infections <- function(estimates, R, initial_infections, cli_abort( c( "!" = "Cannot simulate from uncertain parameters.", - "i" = "Use {.fn fix_dist} to set the parameters of uncertain + "i" = "Use {.fn fix_parameters} to set the parameters of uncertain distributions using either the mean or a randomly sampled value." ) ) diff --git a/R/simulate_secondary.R b/R/simulate_secondary.R index c639c3bd8..0bcb82314 100644 --- a/R/simulate_secondary.R +++ b/R/simulate_secondary.R @@ -29,7 +29,7 @@ #' cases <- as.data.table(example_confirmed)[, primary := confirm] #' sim <- simulate_secondary( #' cases, -#' delays = delay_opts(fix_dist(example_reporting_delay)), +#' delays = delay_opts(fix_parameters(example_reporting_delay)), #' obs = obs_opts(family = "poisson") #' ) #' } @@ -80,7 +80,7 @@ simulate_secondary <- function(primary, cli_abort( c( "!" = "Cannot simulate from uncertain parameters.", - "i" = "Use {.fn fix_dist} to set the parameters of uncertain + "i" = "Use {.fn fix_parameters} to set the parameters of uncertain distributions either using the mean or a randomly sampled value." ) ) diff --git a/_pkgdown.yml b/_pkgdown.yml index 82060b9fb..cb3d82d27 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -108,7 +108,7 @@ reference: - bound_dist - collapse - discretise - - fix_dist + - fix_parameters - get_parameters - get_pmf - get_distribution diff --git a/man/dist_spec.Rd b/man/dist_spec.Rd index 6eeb683aa..b97e9779c 100644 --- a/man/dist_spec.Rd +++ b/man/dist_spec.Rd @@ -33,7 +33,7 @@ probability mass function of the delay (starting with 0); defaults to an empty vector corresponding to a parametric specification of the distribution (using \code{params_mean}, and \code{params_sd}.} -\item{fixed}{Deprecated, use \code{\link[=fix_dist]{fix_dist()}} instead.} +\item{fixed}{Deprecated, use \code{\link[=fix_parameters]{fix_parameters()}} instead.} } \value{ A list of distribution options. diff --git a/man/fix_dist.Rd b/man/fix_parameters.Rd similarity index 61% rename from man/fix_dist.Rd rename to man/fix_parameters.Rd index 1a1df94c3..453c6208f 100644 --- a/man/fix_dist.Rd +++ b/man/fix_parameters.Rd @@ -1,25 +1,32 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dist_spec.R -\name{fix_dist} -\alias{fix_dist} -\alias{fix_dist.dist_spec} +% Please edit documentation in R/deprecated.R, R/dist_spec.R +\name{fix_parameters} +\alias{fix_parameters} +\alias{fix_parameters.dist_spec} \title{Fix the parameters of a \verb{}} \usage{ -\method{fix_dist}{dist_spec}(x, strategy = c("mean", "sample"), ...) +fix_parameters(x, ...) + +\method{fix_parameters}{dist_spec}(x, strategy = c("mean", "sample"), ...) } \arguments{ \item{x}{A \verb{}} +\item{...}{ignored} + \item{strategy}{Character; either "mean" (use the mean estimates of the mean and standard deviation) or "sample" (randomly sample mean and standard deviation from uncertainty given in the \verb{}} - -\item{...}{ignored} } \value{ +A \verb{} object without uncertainty + A \verb{} object without uncertainty } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} +This function has been renamed to \code{\link[=fix_parameters]{fix_parameters()}}. + \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} If the given \verb{} has any uncertainty, it is removed and the corresponding distribution converted into a fixed one. @@ -30,5 +37,6 @@ dist <- LogNormal( meanlog = Normal(3, 0.5), sdlog = Normal(2, 0.5), max = 20 ) -fix_dist(dist) +fix_parameters(dist) } +\keyword{internal} diff --git a/man/simulate_infections.Rd b/man/simulate_infections.Rd index 70bad6010..bc012013f 100644 --- a/man/simulate_infections.Rd +++ b/man/simulate_infections.Rd @@ -105,9 +105,9 @@ Uncertain parameters are not allowed. R = R, initial_infections = 100, generation_time = generation_time_opts( - fix_dist(example_generation_time) + fix_parameters(example_generation_time) ), - delays = delay_opts(fix_dist(example_reporting_delay)), + delays = delay_opts(fix_parameters(example_reporting_delay)), obs = obs_opts(family = "poisson") ) } diff --git a/man/simulate_secondary.Rd b/man/simulate_secondary.Rd index 83b6afe0b..cf607dd5e 100644 --- a/man/simulate_secondary.Rd +++ b/man/simulate_secondary.Rd @@ -78,7 +78,7 @@ available as `convolve_and_scale() cases <- as.data.table(example_confirmed)[, primary := confirm] sim <- simulate_secondary( cases, - delays = delay_opts(fix_dist(example_reporting_delay)), + delays = delay_opts(fix_parameters(example_reporting_delay)), obs = obs_opts(family = "poisson") ) } diff --git a/tests/testthat/test-dist_spec.R b/tests/testthat/test-dist_spec.R index 593bad907..d7655f0f1 100644 --- a/tests/testthat/test-dist_spec.R +++ b/tests/testthat/test-dist_spec.R @@ -33,7 +33,7 @@ test_that("dist_spec returns correct output for gamma distribution parameterised test_that("dist_spec returns correct output for fixed distribution", { result <- discretise( - fix_dist(LogNormal(meanlog = Normal(5, 3), sdlog = 1, max = 19)) + fix_parameters(LogNormal(meanlog = Normal(5, 3), sdlog = 1, max = 19)) ) expect_equal(get_distribution(result), "nonparametric") expect_equal(max(result), 19) @@ -201,11 +201,11 @@ test_that("plot.dist_spec correctly plots a combination of fixed distributions", expect_equal(length(plot$facet$params$facets), 1) }) -test_that("fix_dist works with composite delay distributions", { +test_that("fix_parameters works with composite delay distributions", { dist1 <- LogNormal(meanlog = Normal(1, 0.1), sdlog = 1, max = 19) dist2 <- Gamma(mean = 3, sd = 2, max = 19) dist <- dist1 + dist2 - expect_equal(ndist(collapse(discretise(fix_dist(dist)))), 1L) + expect_equal(ndist(collapse(discretise(fix_parameters(dist)))), 1L) }) test_that("composite delay distributions can be disassembled", { @@ -323,3 +323,7 @@ test_that("get functions report errors", { Gamma(mean = 4, sd = 1), Gamma(mean = 4, sd = 1) )), "must be specified") }) + +test_that("fix_dist() is deprecated", { + expect_deprecated(fix_dist(LogNormal(meanlog = Normal(4, 1), sdlog = 1))) +}) diff --git a/tests/testthat/test-simulate-infections.R b/tests/testthat/test-simulate-infections.R index d8ce11f74..0314806de 100644 --- a/tests/testthat/test-simulate-infections.R +++ b/tests/testthat/test-simulate-infections.R @@ -28,8 +28,8 @@ test_that("simulate_infections works as expected with standard parameters", { test_that("simulate_infections works as expected with additional parameters", { set.seed(123) sim <- test_simulate_infections( - generation_time = gt_opts(fix_dist(example_generation_time)), - delays = delay_opts(fix_dist(example_reporting_delay)), + generation_time = gt_opts(fix_parameters(example_generation_time)), + delays = delay_opts(fix_parameters(example_reporting_delay)), obs = obs_opts(family = "negbin", phi = list(mean = 0.5, sd = 0)), seeding_time = 10 ) diff --git a/tests/testthat/test-simulate-secondary.R b/tests/testthat/test-simulate-secondary.R index 77b295f7b..f78c91de7 100644 --- a/tests/testthat/test-simulate-secondary.R +++ b/tests/testthat/test-simulate-secondary.R @@ -21,7 +21,7 @@ test_that("simulate_secondary works as expected with standard parameters", { test_that("simulate_secondary works as expected with additional parameters", { set.seed(123) sim <- test_simulate_secondary( - delays = delay_opts(fix_dist(example_reporting_delay)), + delays = delay_opts(fix_parameters(example_reporting_delay)), obs = obs_opts(family = "negbin", phi = list(mean = 0.5, sd = 0)) ) expect_equal(nrow(sim), nrow(cases)) diff --git a/touchstone/setup.R b/touchstone/setup.R index edda5c8bf..ec56e7f3b 100644 --- a/touchstone/setup.R +++ b/touchstone/setup.R @@ -2,9 +2,9 @@ library("EpiNow2") reported_cases <- example_confirmed[1:60] -fixed_generation_time <- fix_dist(example_generation_time) -fixed_incubation_period <- fix_dist(example_incubation_period) -fixed_reporting_delay <- fix_dist(example_reporting_delay) +fixed_generation_time <- fix_parameters(example_generation_time) +fixed_incubation_period <- fix_parameters(example_incubation_period) +fixed_reporting_delay <- fix_parameters(example_reporting_delay) delays <- delay_opts(example_incubation_period + example_reporting_delay) fixed_delays <- delay_opts(fixed_incubation_period + fixed_reporting_delay)