fix_dist -> fix_parameters

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)

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 #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.

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))

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,24 @@ apply_tolerance <- function(x, tolerance) {
   attributes(y) <- attributes(x)
   return(y)
 }
+
+#' Fix the parameters of a `<dist_spec>`
+#'
+#' @description `r lifecycle::badge("deprecated")`
+#' This function has been renamed to [fix_parameters()].
+#' @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)
+}

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 `<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.
@@ -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)
 }

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."
       )
     )

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."
       )
     )

_pkgdown.yml

@@ -108,7 +108,7 @@ reference:
       - bound_dist
       - collapse
       - discretise
-      - fix_dist
+      - fix_parameters
       - get_parameters
       - get_pmf
       - get_distribution

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)))
+})

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
   )

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))

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)