Clarify stat_max

R/borel.r

@@ -27,20 +27,19 @@ dborel <- function(x, mu, log = FALSE) {
 ##' Random numbers are generated by simulating from a Poisson branching process
 ##' @param n Number of random variates to generate.
 ##' @inheritParams dborel
-##' @param infinite A threshold above which the random number is set to
-##'  `Inf` as a form of truncation; A number coercible to integer. This
-##'  argument is important because `rborel()` uses `simulate_summary()`
-##'  internally with `offspring_dist = rpois`, so when `mu >= 1`, the
-##'  simulation could grow out of proportion and chain summaries (the random
-##'  numbers generated here) need to be truncated using
-##'  `infinite`.
+##' @param censor_at A stopping criterion; `<numeric>`. Defaults to `Inf`. A
+##' value above which the simulation ends and the random number is set to
+##' `Inf` (as a form of censoring). `rborel()` simulates chain sizes using
+##' [simulate_chain_stats()] with a Poisson offspring distribution, so if
+##' `mu >= 1`, the simulation could proceed unendingly. This parameter is used
+##' to prevent this.
 ##' @return A numeric vector of random numbers.
 ##' @author Sebastian Funk
 ##' @export
 ##' @examples
 ##' set.seed(32)
 ##' rborel(5, 1)
-rborel <- function(n, mu, infinite = Inf) {
+rborel <- function(n, mu, censor_at = Inf) {
   checkmate::assert_number(
     n, lower = 1, finite = TRUE, na.ok = FALSE
   )
@@ -52,7 +51,7 @@ rborel <- function(n, mu, infinite = Inf) {
     n_chains = n,
     offspring_dist = rpois,
     statistic = "size",
-    stat_max = infinite,
+    stat_threshold = censor_at,
     lambda = mu
   )
   out <- as.numeric(out)
@@ -72,7 +71,7 @@ rborel <- function(n, mu, infinite = Inf) {
 ##' @return Numeric vector of random numbers
 ##' @author Sebastian Funk
 ##' @export
-rgborel <- function(n, size, prob, mu, infinite = Inf) {
+rgborel <- function(n, size, prob, mu, censor_at = Inf) {
   ## This function was introduced to support estimating likelihoods using a
   ## Gamma-Borel mixture distribution. It is not actually called (it only needs)
   ## to exist and could be a dummy. However, the function is here included with
@@ -98,5 +97,7 @@ rgborel <- function(n, size, prob, mu, infinite = Inf) {
   ## first, sample from gamma
   x <- rgamma(n, shape = size, rate = size / mu)
   ## then, sample from borel
-  return(vapply(x, rborel, n = 1, infinite = infinite, FUN.VALUE = numeric(1)))
+  return(vapply(
+    x, rborel, n = 1, censor_at = censor_at, FUN.VALUE = numeric(1)
+  ))
 }

R/checks.R

@@ -28,7 +28,7 @@
     n_chains,
     statistic,
     offspring_dist,
-    stat_max,
+    stat_threshold,
     pop,
     percent_immune) {
   # Input checking
@@ -41,7 +41,7 @@
   # check that arguments related to the statistic are valid
   .check_statistic_args(
     statistic,
-    stat_max
+    stat_threshold
   )
   checkmate::assert(
     is.infinite(pop) ||
@@ -54,7 +54,7 @@
   invisible(NULL)
 }
 
-#' Check that the `statistic` and `stat_max` arguments are valid
+#' Check that the `statistic` and `stat_threshold` arguments are valid
 #'
 #' @inheritParams simulate_chains
 #' @description
@@ -64,15 +64,15 @@
 #' @return NULL; called for side effects
 #' @keywords internal
 .check_statistic_args <- function(statistic,
-                                  stat_max) {
+                                  stat_threshold) {
   checkmate::assert_choice(
     statistic,
     choices = c("size", "length")
   )
   checkmate::assert(
-    is.infinite(stat_max),
+    is.infinite(stat_threshold),
       checkmate::check_integerish(
-        stat_max,
+        stat_threshold,
         lower = 1,
         null.ok = FALSE
     ),

R/epichains.R

@@ -19,15 +19,15 @@
                                n_chains,
                                statistic,
                                offspring_dist,
-                               stat_max,
+                               stat_threshold,
                                track_pop) {
   # Assemble the elements of the object
   obj <- sim_df
   class(obj) <- c("epichains", class(obj))
   attr(obj, "n_chains") <- n_chains
   attr(obj, "statistic") <- statistic
   attr(obj, "offspring_dist") <- offspring_dist
-  attr(obj, "stat_max") <- stat_max
+  attr(obj, "stat_threshold") <- stat_threshold
   attr(obj, "track_pop") <- track_pop
   return(obj)
 }
@@ -59,7 +59,7 @@
                       offspring_dist,
                       track_pop,
                       statistic = c("size", "length"),
-                      stat_max = Inf) {
+                      stat_threshold = Inf) {
   # Check that inputs are well specified
   checkmate::assert_data_frame(sim_df, min.cols = 3, min.rows = n_chains)
   checkmate::assert_integerish(
@@ -74,16 +74,16 @@
   .check_offspring_func_valid(offspring_dist)
   checkmate::assert_logical(track_pop, len = 1L)
   checkmate::assert(
-    is.infinite(stat_max),
-    checkmate::check_integerish(stat_max, lower = 1L)
+    is.infinite(stat_threshold),
+    checkmate::check_integerish(stat_threshold, lower = 1L)
   )
   # Create <epichains> object
   epichains <- .new_epichains(
     sim_df = sim_df,
     n_chains = n_chains,
     statistic = statistic,
     offspring_dist = offspring_dist,
-    stat_max = stat_max,
+    stat_threshold = stat_threshold,
     track_pop = track_pop
   )
 
@@ -107,22 +107,22 @@
 #' new `<epichains_summary>` object safely, use `epichains_summary()`.
 #'
 #' @param chains_summary A numeric `<vector>` of chain sizes and lengths.
+#' @inheritParams simulate_chain_stats
 #' @inheritParams .new_epichains
-#' @inheritParams simulate_chains
 #' @author James M. Azam
 #' @keywords internal
 .new_epichains_summary <- function(chains_summary,
                                   n_chains,
                                   statistic,
                                   offspring_dist,
-                                  stat_max) {
+                                  stat_threshold) {
   # Assemble the elements of the object
   obj <- chains_summary
   class(obj) <- c("epichains_summary", class(chains_summary))
   attr(obj, "n_chains") <- n_chains
   attr(obj, "statistic") <- statistic
   attr(obj, "offspring_dist") <- offspring_dist
-  attr(obj, "stat_max") <- stat_max
+  attr(obj, "stat_threshold") <- stat_threshold
   return(obj)
 }
 
@@ -144,7 +144,7 @@
                               n_chains,
                               offspring_dist,
                               statistic = c("size", "length"),
-                              stat_max = Inf) {
+                              stat_threshold = Inf) {
   # chain_summary can sometimes contain infinite values, so check
   # that finite elements are integerish.
   checkmate::check_integerish(
@@ -162,8 +162,8 @@
   statistic <- match.arg(statistic, c("size", "length"))
   .check_offspring_func_valid(offspring_dist)
   checkmate::assert(
-    is.infinite(stat_max),
-    checkmate::check_integerish(stat_max, lower = 1L)
+    is.infinite(stat_threshold),
+    checkmate::check_integerish(stat_threshold, lower = 1L)
   )
 
   # Create <epichains_summary> object
@@ -172,7 +172,7 @@
     n_chains = n_chains,
     statistic = statistic,
     offspring_dist = offspring_dist,
-    stat_max = stat_max
+    stat_threshold = stat_threshold
   )
 
   # Validate the created object
@@ -201,8 +201,8 @@ print.epichains <- function(x, ...) {
 #' prints the number of chains simulated, and the range of
 #' the statistic, represented as the maximum (`max_stat`) and minimum
 #' (`min_stat`). If the minimum or maximum is infinite, it is represented as
-#' `>= stat_max` where `stat_max` is the value of the censoring limit. See
-#' `?epichains_summary()` for the definition of `stat_max`.
+#' `>= stat_threshold` where `stat_threshold` is the value of the censoring
+#' limit. See `?epichains_summary()` for the definition of `stat_threshold`.
 #' @param ... Not used.
 #' @return Invisibly returns an `<epichains_summary>`. Called for
 #' side-effects.
@@ -296,7 +296,7 @@ format.epichains_summary <- function(x, ...) {
         ifelse(
           is.infinite(
             statistics[["max_stat"]]),
-            paste0(">=", attr(x, "stat_max")
+            paste0(">=", attr(x, "stat_threshold")
           ),
           statistics[["max_stat"]]
         )
@@ -306,7 +306,7 @@ format.epichains_summary <- function(x, ...) {
         ifelse(
           is.infinite(
             statistics[["min_stat"]]),
-          paste0(">=", attr(x, "stat_max")
+          paste0(">=", attr(x, "stat_threshold")
           ),
           statistics[["min_stat"]]
         )
@@ -344,7 +344,7 @@ format.epichains_summary <- function(x, ...) {
 #'   percent_immune = 0,
 #'   statistic = "size",
 #'   offspring_dist = rnbinom,
-#'   stat_max = 10,
+#'   stat_threshold = 10,
 #'   mu = 2,
 #'   size = 0.2
 #' )
@@ -360,7 +360,7 @@ format.epichains_summary <- function(x, ...) {
 #'   percent_immune = 0,
 #'   statistic = "size",
 #'   offspring_dist = rnbinom,
-#'   stat_max = 10,
+#'   stat_threshold = 10,
 #'   mu = 2,
 #'   size = 0.2
 #' )
@@ -392,19 +392,19 @@ summary.epichains <- function(object, ...) {
     }
   }
   # Get other required attributes from passed object
-  stat_max <- attr(object, "stat_max")
+  stat_threshold <- attr(object, "stat_threshold")
   offspring_dist <- attr(object, "offspring_dist")
 
   # Apply truncation
-  chain_summaries[chain_summaries >= stat_max] <- Inf
+  chain_summaries[chain_summaries >= stat_threshold] <- Inf
 
   # Return an <epichains_summary> object
   chain_summaries <- .epichains_summary(
     chains_summary = chain_summaries,
     n_chains = n_chains,
     statistic = statistic,
     offspring_dist = offspring_dist,
-    stat_max = stat_max
+    stat_threshold = stat_threshold
   )
   return(chain_summaries)
 }
@@ -536,7 +536,7 @@ summary.epichains_summary <- function(object, ...) {
 #'   n_chains = 10,
 #'   statistic = "size",
 #'   offspring_dist = rpois,
-#'   stat_max = 10,
+#'   stat_threshold = 10,
 #'   generation_time = function(n) rep(3, n),
 #'   lambda = 2
 #' )
@@ -557,7 +557,7 @@ head.epichains <- function(x, ...) {
 #'   n_chains = 10,
 #'   statistic = "size",
 #'   offspring_dist = rpois,
-#'   stat_max = 10,
+#'   stat_threshold = 10,
 #'   generation_time = function(n) rep(3, n),
 #'   lambda = 2
 #' )
@@ -590,7 +590,7 @@ tail.epichains <- function(x, ...) {
 #'   n_chains = 10,
 #'   statistic = "size",
 #'   offspring_dist = rpois,
-#'   stat_max = 10,
+#'   stat_threshold = 10,
 #'   generation_time = function(n) rep(3, n),
 #'   lambda = 2
 #' )

R/likelihood.R

@@ -46,7 +46,7 @@
 #' )
 #' @export
 likelihood <- function(chains, statistic = c("size", "length"), offspring_dist,
-                       nsim_obs, obs_prob = 1, log = TRUE, stat_max = Inf,
+                       nsim_obs, obs_prob = 1, log = TRUE, stat_threshold = Inf,
                        exclude = NULL, individual = FALSE, ...) {
   statistic <- match.arg(statistic)
 
@@ -63,7 +63,7 @@ likelihood <- function(chains, statistic = c("size", "length"), offspring_dist,
   # check that arguments related to the statistic are valid
   .check_statistic_args(
     statistic,
-    stat_max
+    stat_threshold
   )
   .check_offspring_func_valid(offspring_dist)
   checkmate::assert_number(
@@ -90,22 +90,22 @@ likelihood <- function(chains, statistic = c("size", "length"), offspring_dist,
         length(chains),
         chains, obs_prob
       ),
-      stat_max
+      stat_threshold
     ), simplify = FALSE)
     stat_rep_vect <- unlist(stat_rep_list)
-    if (!is.finite(stat_max)) {
-      stat_max <- max(stat_rep_vect) + 1
+    if (!is.finite(stat_threshold)) {
+      stat_threshold <- max(stat_rep_vect) + 1
     }
   } else {
-    chains[chains >= stat_max] <- stat_max
+    chains[chains >= stat_threshold] <- stat_threshold
     stat_rep_vect <- chains
     stat_rep_list <- list(chains)
   }
 
   ## determine for which sizes to calculate the log-likelihood
   ## (for true chain size)
-  if (any(stat_rep_vect == stat_max)) {
-    calc_sizes <- seq_len(stat_max - 1)
+  if (any(stat_rep_vect == stat_threshold)) {
+    calc_sizes <- seq_len(stat_threshold - 1)
   } else {
     calc_sizes <- unique(c(stat_rep_vect, exclude))
   }
@@ -136,16 +136,16 @@ likelihood <- function(chains, statistic = c("size", "length"), offspring_dist,
             x = calc_sizes,
             offspring_dist = offspring_dist,
             statistic = statistic,
-            stat_max = stat_max
+            stat_threshold = stat_threshold
           ),
           pars
         )
       )
   }
 
-  ## assign probabilities to stat_max outbreak sizes
-  if (any(stat_rep_vect == stat_max)) {
-    likelihoods[stat_max] <- .complementary_logprob(likelihoods)
+  ## assign probabilities to stat_threshold outbreak sizes
+  if (any(stat_rep_vect == stat_threshold)) {
+    likelihoods[stat_threshold] <- .complementary_logprob(likelihoods)
   }
 
   if (!missing(exclude)) {