From 998b0e5f093d80f5c8ee0a28692b6484877543a9 Mon Sep 17 00:00:00 2001 From: Sebastian Funk Date: Fri, 20 Sep 2024 16:33:08 +0100 Subject: [PATCH] fix_dist -> fix_parameters (#733) * fix_dist -> fix_parameters * Apply suggestions from code review Co-authored-by: James Azam * fix deprecation syntax * add deprecation test * use cli for lintr * Apply suggestions from code review Co-authored-by: James Azam * break line for lintr --------- Co-authored-by: James Azam --- NAMESPACE | 6 +++--- NEWS.md | 4 ++++ R/create.R | 2 +- R/deprecated.R | 24 ++++++++++++++++++++++- R/dist_spec.R | 21 ++++++++++---------- R/simulate_infections.R | 6 +++--- R/simulate_secondary.R | 4 ++-- _pkgdown.yml | 2 +- man/dist_spec.Rd | 2 +- man/{fix_dist.Rd => fix_parameters.Rd} | 24 +++++++++++++++-------- man/simulate_infections.Rd | 4 ++-- man/simulate_secondary.Rd | 2 +- tests/testthat/test-dist_spec.R | 10 +++++++--- tests/testthat/test-simulate-infections.R | 4 ++-- tests/testthat/test-simulate-secondary.R | 2 +- touchstone/setup.R | 6 +++--- 16 files changed, 81 insertions(+), 42 deletions(-) rename man/{fix_dist.Rd => fix_parameters.Rd} (61%) diff --git a/NAMESPACE b/NAMESPACE index 2b0f2b52d..0e9622605 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,8 +6,8 @@ S3method(collapse,dist_spec) S3method(collapse,multi_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) @@ -59,7 +59,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 5bd05b5b5..84e61898b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -25,6 +25,10 @@ - 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. - `dist_fit()` can now accept any number of `samples` without throwing a warning when `samples` < 1000 in #751 by @jamesmbaazam and reviewed by @seabbs and @sbfnk. +## 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 CDF cutoff was specified. By @sbfnk in #716 and reviewed by @jamesmbaazam. diff --git a/R/create.R b/R/create.R index 71cfdec68..154b28b86 100644 --- a/R/create.R +++ b/R/create.R @@ -784,7 +784,7 @@ create_stan_delays <- function(..., time_points = 1L) { delays <- map(delays, discretise, strict = FALSE) delays <- map(delays, collapse) ## 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 62e769a3b..f6fa29434 100644 --- a/R/dist_spec.R +++ b/R/dist_spec.R @@ -659,7 +659,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") }) cdf_cutoff <- attr(x, "cdf_cutoff") if (is.null(cdf_cutoff)) { @@ -754,12 +754,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. @@ -772,15 +772,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) @@ -809,10 +809,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 ee8de9390..af4c14a7a 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", { @@ -325,3 +325,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)