From fedc789984b880b50cb3e22e8128da16051754e0 Mon Sep 17 00:00:00 2001 From: James Azam Date: Mon, 26 Feb 2024 07:49:52 +0000 Subject: [PATCH] Move secondary_opts to opts.R (#570) * Move secondary_opts to opts.R * Move sencondary_opts() down --- R/estimate_secondary.R | 72 ------------------------------------------ R/opts.R | 72 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+), 72 deletions(-) diff --git a/R/estimate_secondary.R b/R/estimate_secondary.R index b31b418c5..285ceb2a8 100644 --- a/R/estimate_secondary.R +++ b/R/estimate_secondary.R @@ -233,78 +233,6 @@ estimate_secondary <- function(reports, return(out) } -#' Secondary Reports Options -#' -#' @description `r lifecycle::badge("stable")` -#' Returns a list of options defining the secondary model used in -#' [estimate_secondary()]. This model is a combination of a convolution of -#' previously observed primary reports combined with current primary reports -#' (either additive or subtractive). It can optionally be cumulative. See the -#' documentation of `type` for sensible options to cover most use cases and the -#' returned values of [secondary_opts()] for all currently supported options. -#' -#' @param type A character string indicating the type of observation the -#' secondary reports are. Options include: -#' -#' - "incidence": Assumes that secondary reports equal a convolution of -#' previously observed primary reported cases. An example application is deaths -#' from an infectious disease predicted by reported cases of that disease (or -#' estimated infections). -#' -#' - "prevalence": Assumes that secondary reports are cumulative and are -#' defined by currently observed primary reports minus a convolution of -#' secondary reports. An example application is hospital bed usage predicted by -#' hospital admissions. -#' -#' @param ... Overwrite options defined by type. See the returned values for all -#' options that can be passed. -#' @importFrom rlang arg_match -#' @seealso [estimate_secondary()] -#' @return A `` object of binary options summarising secondary -#' model used in [estimate_secondary()]. Options returned are `cumulative` -#' (should the secondary report be cumulative), `historic` (should a -#' convolution of primary reported cases be used to predict secondary reported -#' cases), `primary_hist_additive` (should the historic convolution of primary -#' reported cases be additive or subtractive), `current` (should currently -#' observed primary reported cases contribute to current secondary reported -#' cases), `primary_current_additive` (should current primary reported cases be -#' additive or subtractive). -#' -#' @export -#' @author Sam Abbott -#' @examples -#' # incidence model -#' secondary_opts("incidence") -#' -#' # prevalence model -#' secondary_opts("prevalence") -secondary_opts <- function(type = "incidence", ...) { - type <- arg_match( - type, - values = c("incidence", "prevalence") - ) - if (type == "incidence") { - data <- list( - cumulative = 0, - historic = 1, - primary_hist_additive = 1, - current = 0, - primary_current_additive = 0 - ) - } else if (type == "prevalence") { - data <- list( - cumulative = 1, - historic = 1, - primary_hist_additive = 0, - current = 1, - primary_current_additive = 1 - ) - } - data <- modifyList(data, list(...)) - attr(data, "class") <- c("secondary_opts", class(data)) - return(data) -} - #' Update estimate_secondary default priors #' #' @description `r lifecycle::badge("stable")` diff --git a/R/opts.R b/R/opts.R index b27a67453..c4dae704f 100644 --- a/R/opts.R +++ b/R/opts.R @@ -99,6 +99,78 @@ generation_time_opts <- function(dist = dist_spec(mean = 1), ..., return(dist) } +#' Secondary Reports Options +#' +#' @description `r lifecycle::badge("stable")` +#' Returns a list of options defining the secondary model used in +#' [estimate_secondary()]. This model is a combination of a convolution of +#' previously observed primary reports combined with current primary reports +#' (either additive or subtractive). It can optionally be cumulative. See the +#' documentation of `type` for sensible options to cover most use cases and the +#' returned values of [secondary_opts()] for all currently supported options. +#' +#' @param type A character string indicating the type of observation the +#' secondary reports are. Options include: +#' +#' - "incidence": Assumes that secondary reports equal a convolution of +#' previously observed primary reported cases. An example application is deaths +#' from an infectious disease predicted by reported cases of that disease (or +#' estimated infections). +#' +#' - "prevalence": Assumes that secondary reports are cumulative and are +#' defined by currently observed primary reports minus a convolution of +#' secondary reports. An example application is hospital bed usage predicted by +#' hospital admissions. +#' +#' @param ... Overwrite options defined by type. See the returned values for all +#' options that can be passed. +#' @importFrom rlang arg_match +#' @seealso [estimate_secondary()] +#' @return A `` object of binary options summarising secondary +#' model used in [estimate_secondary()]. Options returned are `cumulative` +#' (should the secondary report be cumulative), `historic` (should a +#' convolution of primary reported cases be used to predict secondary reported +#' cases), `primary_hist_additive` (should the historic convolution of primary +#' reported cases be additive or subtractive), `current` (should currently +#' observed primary reported cases contribute to current secondary reported +#' cases), `primary_current_additive` (should current primary reported cases be +#' additive or subtractive). +#' +#' @export +#' @author Sam Abbott +#' @examples +#' # incidence model +#' secondary_opts("incidence") +#' +#' # prevalence model +#' secondary_opts("prevalence") +secondary_opts <- function(type = "incidence", ...) { + type <- arg_match( + type, + values = c("incidence", "prevalence") + ) + if (type == "incidence") { + data <- list( + cumulative = 0, + historic = 1, + primary_hist_additive = 1, + current = 0, + primary_current_additive = 0 + ) + } else if (type == "prevalence") { + data <- list( + cumulative = 1, + historic = 1, + primary_hist_additive = 0, + current = 1, + primary_current_additive = 1 + ) + } + data <- modifyList(data, list(...)) + attr(data, "class") <- c("secondary_opts", class(data)) + return(data) +} + #' Delay Distribution Options #' #' @description `r lifecycle::badge("stable")`