From 9b7963109401be5a92a35dfcf01a6938cfa6d705 Mon Sep 17 00:00:00 2001 From: Sebastian Funk Date: Fri, 2 Aug 2024 11:10:10 +0000 Subject: [PATCH 1/7] fix_dist -> fix_parameters --- NAMESPACE | 6 +++--- NEWS.md | 4 ++++ R/create.R | 2 +- R/deprecated.R | 22 ++++++++++++++++++++- R/dist_spec.R | 21 ++++++++++---------- R/simulate_infections.R | 6 +++--- R/simulate_secondary.R | 4 ++-- _pkgdown.yml | 3 ++- 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 | 6 +++--- tests/testthat/test-simulate-infections.R | 4 ++-- tests/testthat/test-simulate-secondary.R | 2 +- touchstone/setup.R | 6 +++--- 16 files changed, 76 insertions(+), 42 deletions(-) rename man/{fix_dist.Rd => fix_parameters.Rd} (61%) 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..3332dc540 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()`. By @sbfnk in and reviewed by. + ## 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..a8061f5cb 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,23 @@ apply_tolerance <- function(x, tolerance) { attributes(y) <- attributes(x) return(y) } + +#' Fix the parameters of a `` +#' +#' @description `r lifecycle::badge("deprecated")` +#' This function has been renamed to [fix_parameters()]. +#' @return A `` object without uncertainty +#' @keywords internal +#' @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_parameters <- function(x, strategy = c("mean", "sample")) { + lifecycle::deprecate_warn( + "1.6.0", "fix_parameters()", "fix_parameters()" + ) + if (!is(x, "dist_spec")) { + stop("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..ec995441d 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -108,7 +108,8 @@ reference: - bound_dist - collapse - discretise - - fix_dist + - fix_parameters + - 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..987ea895b 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", { 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) From c416f5149c2e324b56c0f5d7794fdea3d8911afa Mon Sep 17 00:00:00 2001 From: Sebastian Funk Date: Thu, 19 Sep 2024 13:36:39 +0100 Subject: [PATCH 2/7] Apply suggestions from code review Co-authored-by: James Azam --- NEWS.md | 2 +- R/deprecated.R | 2 +- _pkgdown.yml | 1 - 3 files changed, 2 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 3332dc540..098fad95f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -26,7 +26,7 @@ ## Package changes -- `fix_dist()` has been renamed to `fix_parameters()`. By @sbfnk in and reviewed by. +- `fix_dist()` has been renamed to `fix_parameters()`. By @sbfnk in #733 and reviewed by @jamesmbaazam. ## Bug fixes diff --git a/R/deprecated.R b/R/deprecated.R index a8061f5cb..70ffe26dc 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -634,7 +634,7 @@ apply_tolerance <- function(x, tolerance) { #' @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_parameters <- function(x, strategy = c("mean", "sample")) { +fix_dist <- function(x, strategy = c("mean", "sample")) { lifecycle::deprecate_warn( "1.6.0", "fix_parameters()", "fix_parameters()" ) diff --git a/_pkgdown.yml b/_pkgdown.yml index ec995441d..cb3d82d27 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -109,7 +109,6 @@ reference: - collapse - discretise - fix_parameters - - fix_parameters - get_parameters - get_pmf - get_distribution From 6216df5ccda4721704274161890834f956d3210b Mon Sep 17 00:00:00 2001 From: Sebastian Funk Date: Thu, 19 Sep 2024 13:47:53 +0100 Subject: [PATCH 3/7] fix deprecation syntax --- R/deprecated.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/deprecated.R b/R/deprecated.R index 70ffe26dc..a98558e8d 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -636,7 +636,7 @@ apply_tolerance <- function(x, tolerance) { #' standard deviation from uncertainty given in the `` fix_dist <- function(x, strategy = c("mean", "sample")) { lifecycle::deprecate_warn( - "1.6.0", "fix_parameters()", "fix_parameters()" + "1.6.0", "fix_dist()", "fix_parameters()" ) if (!is(x, "dist_spec")) { stop("Can only fix distributions in a .") From ce9bf9d3546ce688e97e3d345636bb00833b80b4 Mon Sep 17 00:00:00 2001 From: Sebastian Funk Date: Thu, 19 Sep 2024 13:48:00 +0100 Subject: [PATCH 4/7] add deprecation test --- tests/testthat/test-dist_spec.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/testthat/test-dist_spec.R b/tests/testthat/test-dist_spec.R index 987ea895b..d7655f0f1 100644 --- a/tests/testthat/test-dist_spec.R +++ b/tests/testthat/test-dist_spec.R @@ -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))) +}) From 20451cc39ef4061c39515377081ba17d0f478a54 Mon Sep 17 00:00:00 2001 From: Sebastian Funk Date: Fri, 20 Sep 2024 09:23:39 +0100 Subject: [PATCH 5/7] use cli for lintr --- R/deprecated.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/deprecated.R b/R/deprecated.R index a98558e8d..72f066f27 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -630,6 +630,7 @@ apply_tolerance <- function(x, tolerance) { #' This function has been renamed to [fix_parameters()]. #' @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 @@ -639,7 +640,7 @@ fix_dist <- function(x, strategy = c("mean", "sample")) { "1.6.0", "fix_dist()", "fix_parameters()" ) if (!is(x, "dist_spec")) { - stop("Can only fix distributions in a .") + cli_abort("!" = "Can only fix distributions in a .") } fix_parameters(x, strategy) } From 46793c08fce311e79499270757ebce4ce5ef8035 Mon Sep 17 00:00:00 2001 From: Sebastian Funk Date: Fri, 20 Sep 2024 11:23:28 +0100 Subject: [PATCH 6/7] Apply suggestions from code review Co-authored-by: James Azam --- NEWS.md | 2 +- R/deprecated.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 098fad95f..f91dce13e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -26,7 +26,7 @@ ## Package changes -- `fix_dist()` has been renamed to `fix_parameters()`. By @sbfnk in #733 and reviewed by @jamesmbaazam. +- `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 diff --git a/R/deprecated.R b/R/deprecated.R index 72f066f27..917827cf8 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -624,10 +624,10 @@ apply_tolerance <- function(x, tolerance) { return(y) } -#' Fix the parameters of a `` +#' Remove uncertainty in the parameters of a `` #' #' @description `r lifecycle::badge("deprecated")` -#' This function has been renamed to [fix_parameters()]. +#' This function has been renamed to [fix_parameters()] as the former was a misnomer. #' @return A `` object without uncertainty #' @keywords internal #' @importFrom cli cli_abort From e01dc6a2014c2be47397dc88324c26eb24dcbbd7 Mon Sep 17 00:00:00 2001 From: Sebastian Funk Date: Fri, 20 Sep 2024 11:43:36 +0100 Subject: [PATCH 7/7] break line for lintr --- R/deprecated.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/deprecated.R b/R/deprecated.R index 917827cf8..3cc3d90a4 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -627,7 +627,8 @@ apply_tolerance <- function(x, tolerance) { #' Remove uncertainty in the parameters of a `` #' #' @description `r lifecycle::badge("deprecated")` -#' This function has been renamed to [fix_parameters()] as the former was a misnomer. +#' This function has been renamed to [fix_parameters()] as a more appropriate +#' name. #' @return A `` object without uncertainty #' @keywords internal #' @importFrom cli cli_abort