diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/id.R | 7 | ||||
| -rw-r--r-- | R/idea.R | 7 | ||||
| -rw-r--r-- | R/seq_bayes.R | 23 | ||||
| -rw-r--r-- | R/util.R | 55 | ||||
| -rw-r--r-- | R/wp.R | 35 |
5 files changed, 125 insertions, 2 deletions
@@ -41,5 +41,12 @@ #' # Obtain R0 when the serial distribution has a mean of three days. #' id(cases, mu = 3 / 7) id <- function(cases, mu) { + validate_cases(cases, min_length = 1, min_count = 1) + if (!is_real(mu) || mu <= 0) { + stop("The serial interval (`mu`) must be a number greater than 0.", + call. = FALSE + ) + } + exp(sum((log(cases) * mu) / seq_along(cases)) / length(cases)) } @@ -42,6 +42,13 @@ #' # Obtain R0 when the serial distribution has a mean of three days. #' idea(cases, mu = 3 / 7) idea <- function(cases, mu) { + validate_cases(cases, min_length = 2, min_count = 1) + if (!is_real(mu) || mu <= 0) { + stop("The serial interval (`mu`) must be a number greater than 0.", + call. = FALSE + ) + } + s <- seq_along(cases) / mu x1 <- sum(s) diff --git a/R/seq_bayes.R b/R/seq_bayes.R index d486d2b..ccc9a41 100644 --- a/R/seq_bayes.R +++ b/R/seq_bayes.R @@ -84,10 +84,31 @@ #' # Note that the following always holds: #' estimate == sum(posterior$supp * posterior$pmf) seq_bayes <- function(cases, mu, kappa = 20, post = FALSE) { + validate_cases(cases, min_length = 2, min_count = 0) + if (!is_real(mu) || mu <= 0) { + stop("The serial interval (`mu`) must be a number greater than 0.", + call. = FALSE + ) + } + if (!is_real(kappa) || kappa < 1) { + stop( + paste("The largest value of the uniform prior (`kappa`)", + "must be a number greater than or equal to 1." + ), call. = FALSE + ) + } + if (!identical(post, TRUE) && !identical(post, FALSE)) { + stop("The posterior flag (`post`) must be set to `TRUE` or `FALSE`.", + call. = FALSE + ) + } + if (any(cases == 0)) { times <- which(cases > 0) if (length(times) < 2) { - stop("Vector of case counts must contain at least two positive integers.") + stop("Case counts must contain at least two positive integers.", + call. = FALSE + ) } cases <- cases[times] } else { diff --git a/R/util.R b/R/util.R new file mode 100644 index 0000000..d8b0b59 --- /dev/null +++ b/R/util.R @@ -0,0 +1,55 @@ +#' Case Counts Validation +#' +#' This is an internal function called by the estimators. It validates the +#' supplied case counts by ensuring it is a vector of integers of length at +#' least `min_length` with entries greater than or equal to `min_count`. +#' Execution is halted if these requirements are not satisfied. +#' +#' @param cases The case counts to be validated. +#' @param min_length The minimum length of the vector of case counts. +#' @param min_count The minimum value of the case count vector's entries. +#' +#' @noRd +validate_cases <- function(cases, min_length, min_count) { + if (!is.vector(cases) || !is.numeric(cases) || any(floor(cases) != cases)) { + stop("Case counts must be a vector of integers.", call. = FALSE) + } + if (length(cases) < min_length) { + stop(paste("Case counts must have at least", min_length, "entries."), + call. = FALSE + ) + } + if (any(cases < min_count)) { + stop(paste0("Case counts cannot be less than ", min_count, "."), + call. = FALSE + ) + } +} + +#' Real Number Testing +#' +#' This is an internal function which checks whether the given argument is a +#' real number. +#' +#' @param x The argument to test for being a real number. +#' +#' @return `TRUE` if the argument is a real number, `FALSE` otherwise. +#' +#' @noRd +is_real <- function(x) { + is.vector(x) && is.numeric(x) && length(x) == 1 +} + +#' Integer Testing +#' +#' This is an internal function which checks whether the given argument is an +#' integer. +#' +#' @param n The argument to test for being an integer. +#' +#' @return `TRUE` if the argument is an integer, `FALSE` otherwise. +#' +#' @noRd +is_integer <- function(n) { + is_real(n) && floor(n) == n +} @@ -111,12 +111,45 @@ #' estimate$pmf wp <- function(cases, mu = NA, serial = FALSE, grid_length = 100, max_shape = 10, max_scale = 10) { - if (is.na(mu)) { + validate_cases(cases, min_length = 2, min_count = 1) + if (!identical(serial, TRUE) && !identical(serial, FALSE)) { + stop( + paste("The serial distribution flag (`serial`) must be set to", + "`TRUE` or `FALSE`." + ), call. = FALSE + ) + } + + if (identical(mu, NA)) { + if (!is_integer(grid_length) || grid_length < 1) { + stop("The grid length must be a positive integer.", call. = FALSE) + } + if (!is_real(max_shape) || max_shape <= 0) { + stop( + paste("The largest value of the shape parameter (`max_shape`)", + "must be a positive number." + ), call. = FALSE + ) + } + if (!is_real(max_scale) || max_scale <= 0) { + stop( + paste("The largest value of the scale parameter (`max_scale`)", + "must be a positive number." + ), call. = FALSE + ) + } + search <- wp_search(cases, grid_length, max_shape, max_scale) r0 <- search$r0 serial_supp <- search$supp serial_pmf <- search$pmf } else { + if (!is_real(mu) || mu <= 0) { + stop("The serial interval (`mu`) must be a positive number or `NA`.", + call. = FALSE + ) + } + max_range <- ceiling(qgamma(0.999, shape = 1, scale = mu)) serial_supp <- seq_len(max_range) serial_pmf <- diff(pgamma(0:max_range, shape = 1, scale = mu)) |