Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

fix_dist -> fix_parameters #733

Merged
merged 7 commits into from
Sep 20, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 3 additions & 3 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down
4 changes: 4 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
2 changes: 1 addition & 1 deletion R/create.R
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down
24 changes: 23 additions & 1 deletion R/deprecated.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
}
21 changes: 11 additions & 10 deletions R/dist_spec.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)) {
Expand Down Expand Up @@ -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.
Expand All @@ -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)

Expand Down Expand Up @@ -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)
}
Expand Down
6 changes: 3 additions & 3 deletions R/simulate_infections.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
#' )
#' }
Expand Down Expand Up @@ -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."
)
)
Expand Down
4 changes: 2 additions & 2 deletions R/simulate_secondary.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
#' )
#' }
Expand Down Expand Up @@ -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."
)
)
Expand Down
2 changes: 1 addition & 1 deletion _pkgdown.yml
Original file line number Diff line number Diff line change
Expand Up @@ -108,7 +108,7 @@ reference:
- bound_dist
- collapse
- discretise
- fix_dist
- fix_parameters
sbfnk marked this conversation as resolved.
Show resolved Hide resolved
- get_parameters
- get_pmf
- get_distribution
Expand Down
2 changes: 1 addition & 1 deletion man/dist_spec.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

24 changes: 16 additions & 8 deletions man/fix_dist.Rd → man/fix_parameters.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

4 changes: 2 additions & 2 deletions man/simulate_infections.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/simulate_secondary.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

10 changes: 7 additions & 3 deletions tests/testthat/test-dist_spec.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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", {
Expand Down Expand Up @@ -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)))
})
4 changes: 2 additions & 2 deletions tests/testthat/test-simulate-infections.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
)
Expand Down
2 changes: 1 addition & 1 deletion tests/testthat/test-simulate-secondary.R
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down
6 changes: 3 additions & 3 deletions touchstone/setup.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Loading