fix_dist -> fix_parameters (#733)

* fix_dist -> fix_parameters * Apply suggestions from code review Co-authored-by: James Azam <james.azam@lshtm.ac.uk> * fix deprecation syntax * add deprecation test * use cli for lintr * Apply suggestions from code review Co-authored-by: James Azam <james.azam@lshtm.ac.uk> * break line for lintr --------- Co-authored-by: James Azam <james.azam@lshtm.ac.uk>
epiforecasts · Sep 20, 2024 · 998b0e5 · 998b0e5
1 parent 47af959
commit 998b0e5
Show file tree

Hide file tree

Showing 16 changed files with 81 additions and 42 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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 `<dist_spec>`
+#'
+#' @description `r lifecycle::badge("deprecated")`
+#' This function has been renamed to [fix_parameters()] as a more appropriate
+#'   name.
+#' @return A `<dist_spec>` object without uncertainty
+#' @keywords internal
+#' @importFrom cli cli_abort
+#' @param x A `<dist_spec>`
+#' @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 `<dist_spec>`
+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 <dist_spec>.")
+  }
+  fix_parameters(x, strategy)
+}
diff --git 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 `<dist_spec>`
 #'
-#' @name fix_dist
+#' @name fix_parameters
 #' @description `r lifecycle::badge("experimental")`
 #' If the given `<dist_spec>` 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
@@ -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
@@ -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
@@ -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
diff --git a/man/fix_dist.Rd → man/fix_parameters.Rd b/man/fix_dist.Rd → man/fix_parameters.Rd
diff --git a/man/simulate_infections.Rd b/man/simulate_infections.Rd
diff --git a/man/simulate_secondary.Rd b/man/simulate_secondary.Rd
diff --git 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
@@ -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
@@ -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
@@ -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)