advance deprecation cycle (#667)

* advance deprecation cycle * address check failures * remove references to dist_spec
epiforecasts · May 17, 2024 · 0936aab · 0936aab
1 parent 1da8fd9
commit 0936aab
Show file tree

Hide file tree

Showing 50 changed files with 239 additions and 1,460 deletions.
diff --git a/R/deprecated.R b/R/deprecated.R
diff --git a/R/dist_spec.R b/R/dist_spec.R
@@ -185,10 +185,10 @@ dist_skel <- function(n, dist = FALSE, cum = TRUE, model,
 #'
 #' @description `r lifecycle::badge("experimental")`
 #' @return A delay distribution representing the sum of the two delays
-#' @param e1 The first delay distribution (of type [dist_spec()]) to
+#' @param e1 The first delay distribution (of type <dist_spec>) to
 #' combine.
 #'
-#' @param e2 The second delay distribution (of type [dist_spec()]) to
+#' @param e2 The second delay distribution (of type <dist_spec>) to
 #' combine.
 #' @method + dist_spec
 #' @export
@@ -214,7 +214,7 @@ dist_skel <- function(n, dist = FALSE, cum = TRUE, model,
 #' This combines the parameters so that they can be fed as multiple delay
 #' distributions to [epinow()] or [estimate_infections()].
 #'
-#' @param ... The delay distributions (from calls to [dist_spec()]) to combine
+#' @param ... The delay distributions to combine
 #' @return Combined delay distributions (with class `<dist_spec>`)
 #' @method c dist_spec
 #' @export
@@ -248,7 +248,7 @@ c.dist_spec <- function(...) {
 #'
 #' @description `r lifecycle::badge("experimental")`
 #' This works out the mean of all the (parametric / nonparametric) delay
-#' distributions combined in the passed [dist_spec()] (ignoring any uncertainty
+#' distributions combined in the passed <dist_spec> (ignoring any uncertainty
 #' in parameters)
 #'
 #' @param x The `<dist_spec>` to use
@@ -312,9 +312,9 @@ mean.dist_spec <- function(x, ..., ignore_uncertainty = FALSE) {
 #'
 #' @description `r lifecycle::badge("experimental")`
 #' This works out the standard deviation of all the (parametric /
-#' nonparametric) delay distributions combined in the passed [dist_spec()].
+#' nonparametric) delay distributions combined in the passed <dist_spec>.
 #'
-#' @param x The [dist_spec()] to use
+#' @param x The <dist_spec> to use
 #' @return A vector of standard deviations.
 #' @importFrom utils head
 #' @keywords internal
@@ -370,10 +370,10 @@ sd_dist <- function(x) {
 #'
 #' @description `r lifecycle::badge("experimental")`
 #' This works out the maximum of all the (parametric / nonparametric) delay
-#' distributions combined in the passed [dist_spec()] (ignoring any uncertainty
+#' distributions combined in the passed <dist_spec> (ignoring any uncertainty
 #' in parameters)
 #'
-#' @param x The [dist_spec()] to use
+#' @param x The <dist_spec> to use
 #' @param ... Not used
 #' @return A vector of means.
 #' @method max dist_spec
@@ -554,7 +554,7 @@ apply_tolerance <- function(x, tolerance) {
 #'
 #' @description `r lifecycle::badge("experimental")`
 #' This displays the parameters of the uncertain and probability mass
-#' functions of fixed delay distributions combined in the passed [dist_spec()].
+#' functions of fixed delay distributions combined in the passed <dist_spec>.
 #' @param x The `<dist_spec>` to use
 #' @param ... Not used
 #' @return invisible
@@ -1186,7 +1186,7 @@ get_pmf <- function(x, id = NULL) {
   return(x[[id]]$pmf)
 }
 
-##' Get the distribution of a [dist_spec()]
+##' Get the distribution of a <dist_spec>
 ##'
 ##' @inheritParams get_dist_spec_id
 ##' @description `r lifecycle::badge("experimental")`

diff --git a/R/epinow.R b/R/epinow.R
@@ -63,7 +63,7 @@
 #'
 #' # estimate Rt and nowcast/forecast cases by date of infection
 #' out <- epinow(
-#'   reported_cases = reported_cases,
+#'   data = reported_cases,
 #'   generation_time = generation_time_opts(generation_time),
 #'   rt = rt_opts(prior = list(mean = 2, sd = 0.1)),
 #'   delays = delay_opts(incubation_period + reporting_delay)
@@ -98,20 +98,12 @@ epinow <- function(data,
                    target_folder = NULL, target_date,
                    logs = tempdir(), id = "epinow", verbose = interactive(),
                    reported_cases) {
-  # Warning for deprecated arguments
   if (!missing(reported_cases)) {
-    if (!missing(data)) {
-      stop("Can't have `reported_cases` and `data` arguments. ",
-           "Use `data` instead."
-      )
-    }
-    lifecycle::deprecate_warn(
+    lifecycle::deprecate_stop(
       "1.5.0",
       "epinow(reported_cases)",
-      "epinow(data)",
-      "The argument will be removed completely in the next version."
+      "epinow(data)"
     )
-    data <- reported_cases
   }
   # Check inputs
   assert_logical(return_output)

diff --git a/R/estimate_delay.R b/R/estimate_delay.R
@@ -183,16 +183,13 @@ bootstrapped_dist_fit <- function(values, dist = "lognormal",
 
     fit <- EpiNow2::dist_fit(values, samples = samples, dist = dist)
 
-
     out <- list()
     if (dist == "lognormal") {
-      out$mean_samples <- sample(extract(fit)$mu, samples)
-      out$sd_samples <- sample(extract(fit)$sigma, samples)
+      out$meanlog <- sample(extract(fit)$mu, samples)
+      out$sdlog <- sample(extract(fit)$sigma, samples)
     } else if (dist == "gamma") {
-      alpha_samples <- sample(extract(fit)$alpha, samples)
-      beta_samples <- sample(extract(fit)$beta, samples)
-      out$mean_samples <- alpha_samples / beta_samples
-      out$sd_samples <- sqrt(alpha_samples) / beta_samples
+      out$shape <- sample(extract(fit)$alpha, samples)
+      out$rate <- sample(extract(fit)$beta, samples)
     }
     return(out)
   }
@@ -224,17 +221,16 @@ bootstrapped_dist_fit <- function(values, dist = "lognormal",
     dist_samples <- purrr::map(dist_samples, unlist)
   }
 
-  out <- list()
-  out$mean <- mean(dist_samples$mean_samples)
-  out$mean_sd <- sd(dist_samples$mean_samples)
-  out$sd <- mean(dist_samples$sd_sample)
-  out$sd_sd <- sd(dist_samples$sd_samples)
+  params <- lapply(dist_samples, function(x) {
+    Normal(mean = mean(x), sd = sd(x))
+  })
+
   if (!missing(max_value)) {
-    out$max <- max_value
+    params$max <- max_value
   } else {
-    out$max <- max(values)
+    params$max <- max(values)
   }
-  return(do.call(dist_spec, out))
+  return(new_dist_spec(params = params, distribution = dist))
 }
 
 #' Estimate a Delay Distribution

diff --git a/R/estimate_infections.R b/R/estimate_infections.R
@@ -129,18 +129,11 @@ estimate_infections <- function(data,
                                 reported_cases) {
   # Deprecate reported_cases in favour of data
   if (!missing(reported_cases)) {
-     if (!missing(data)) {
-      stop("Can't have `reported_cases` and `data` arguments. ",
-           "Use `data` instead."
-      )
-     }
-    lifecycle::deprecate_warn(
+    lifecycle::deprecate_stop(
       "1.5.0",
       "estimate_infections(reported_cases)",
-      "estimate_infections(data)",
-      "The argument will be removed completely in the next version."
+      "estimate_infections(data)"
     )
-    data <- reported_cases
   }
   # Validate inputs
   check_reports_valid(data, model = "estimate_infections")

diff --git a/R/estimate_secondary.R b/R/estimate_secondary.R
@@ -159,16 +159,11 @@ estimate_secondary <- function(data,
                                reports) {
   # Deprecate reported_cases in favour of data
   if (!missing(reports)) {
-     if (!missing(data)) {
-      stop("Can't have `reported` and `data` arguments. Use `data` instead.")
-    }
-    lifecycle::deprecate_warn(
+    lifecycle::deprecate_stop(
       "1.5.0",
       "estimate_secondary(reports)",
-      "estimate_secondary(data)",
-      "The argument will be removed completely in the next version."
+      "estimate_secondary(data)"
     )
-    data <- reports
   }
   # Validate the inputs
   check_reports_valid(data, model = "estimate_secondary")

diff --git a/R/estimate_truncation.R b/R/estimate_truncation.R
@@ -42,12 +42,6 @@
 #'
 #' @param obs Deprecated; use `data` instead.
 #'
-#' @param max_truncation Deprecated; use `truncation` instead.
-#'
-#' @param trunc_max Deprecated; use `truncation` instead.
-#'
-#' @param trunc_dist Deprecated; use `truncation` instead.
-#'
 #' @param model A compiled stan model to override the default model. May be
 #' useful for package developers or those developing extensions.
 #'
@@ -111,8 +105,7 @@
 #' plot(out)
 #' options(old_opts)
 #' }
-estimate_truncation <- function(data, max_truncation, trunc_max = 10,
-                                trunc_dist = "lognormal",
+estimate_truncation <- function(data,
                                 truncation = trunc_opts(
                                   LogNormal(
                                     meanlog = Normal(0, 1),
@@ -131,16 +124,11 @@ estimate_truncation <- function(data, max_truncation, trunc_max = 10,
                                 obs) {
 
   if (!missing(obs)) {
-     if (!missing(data)) {
-      stop("Can't have `obs` and `data` arguments. Use `data` instead.")
-    }
-    lifecycle::deprecate_warn(
+    lifecycle::deprecate_stop(
       "1.5.0",
       "estimate_truncation(obs)",
-      "estimate_truncation(data)",
-      "The argument will be removed completely in the next version."
+      "estimate_truncation(data)"
     )
-    data <- obs
   }
   if (!is.null(model)) {
     lifecycle::deprecate_stop(
@@ -150,11 +138,10 @@ estimate_truncation <- function(data, max_truncation, trunc_max = 10,
     )
   }
   if (!missing(weigh_delay_priors)) {
-    lifecycle::deprecate_warn(
+    lifecycle::deprecate_stop(
       "1.5.0",
       "estimate_truncation(weigh_delay_priors)",
-      "trunc_opts(weight_prior)",
-      detail = "This argument will be removed completely in the next version"
+      "trunc_opts(weight_prior)"
     )
   }
    # Validate inputs
@@ -167,68 +154,6 @@ estimate_truncation <- function(data, max_truncation, trunc_max = 10,
   assert_logical(weigh_delay_priors)
   assert_logical(verbose)
 
-  ## code block to remove in next EpiNow2 version
-  construct_trunc <- FALSE
-  if (!missing(trunc_max)) {
-    if (!missing(truncation)) {
-      stop(
-        "`trunc_max` and `truncation` arguments are both given. ",
-        "Use only `truncation` instead.")
-    }
-    if (!missing(max_truncation)) {
-      stop(
-        "`max_truncation` and `trunc_max` arguments are both given. ",
-        "Use only `truncation` instead.")
-    }
-    deprecate_stop(
-      "1.4.0",
-      "estimate_truncation(trunc_max)",
-      "estimate_truncation(truncation)"
-    )
-    construct_trunc <- TRUE
-  }
-  if (!missing(max_truncation)) {
-    if (!missing(truncation)) {
-      stop(
-        "`max_truncation` and `truncation` arguments are both given. ",
-        "Use only `truncation` instead.")
-    }
-    deprecate_stop(
-      "1.4.0",
-      "estimate_truncation(max_truncation)",
-      "estimate_truncation(truncation)"
-    )
-    trunc_max <- max_truncation
-    construct_trunc <- TRUE
-  }
-  if (!missing(trunc_dist)) {
-    trunc_dist <- arg_match(trunc_dist)
-    if (!missing(truncation)) {
-      stop(
-        "`trunc_dist` and `truncation` arguments are both given. ",
-        "Use only `truncation` instead.")
-    }
-    deprecate_stop(
-      "1.4.0",
-      "estimate_truncation(trunc_dist)",
-      "estimate_truncation(truncation)"
-    )
-    construct_trunc <- TRUE
-  }
-  if (construct_trunc) {
-    params_mean <- c(0, 1)
-    params_sd <- c(1, 1)
-    parameters <- lapply(seq_along(params_mean), function(id) {
-      Normal(params_mean, params_sd)
-    })
-    names(parameters) <- natural_params(trunc_dist)
-    parameters$max <- trunc_max
-    truncation <- new_dist_spec(
-      params = parameters,
-      distribution = trunc_dist
-    )
-  }
-
   # combine into ordered matrix
   dirty_obs <- purrr::map(data, data.table::as.data.table)
   dirty_obs <- purrr::map(dirty_obs,