Update simulation functions

R/checkers.R

@@ -117,7 +117,7 @@
                              R,
                              serial_interval,
                              outbreak_start_date,
-                             min_chain_size,
+                             min_outbreak_size,
                              onset_to_hosp = NULL,
                              onset_to_death = NULL,
                              contact_distribution = NULL,
@@ -134,7 +134,7 @@
   checkmate::assert_number(R, lower = 0)
   .check_func_req_args(serial_interval)
   checkmate::assert_date(outbreak_start_date)
-  checkmate::assert_integerish(min_chain_size, lower = 1)
+  checkmate::assert_integerish(min_outbreak_size, lower = 1)
 
   stopifnot(
     "population_age must be two numerics or a data.frame" =

R/create_linelist.R

@@ -49,8 +49,7 @@
 #'   serial_interval = serial_interval,
 #'   onset_to_hosp = onset_to_hosp,
 #'   onset_to_death = onset_to_death,
-#'   hosp_rate = 0.5,
-#'   add_ct = TRUE
+#'   hosp_rate = 0.5
 #' )
 #' ```
 #' @return A `<data.frame>`.

R/sim_contacts.R

@@ -40,18 +40,21 @@ sim_contacts <- function(R,
                          serial_interval,
                          contact_distribution,
                          outbreak_start_date = as.Date("2023-01-01"),
-                         min_chain_size = 10,
+                         min_outbreak_size = 10,
                          population_age = c(1, 90),
                          contact_tracing_status_probs = c(
                            under_followup = 0.7,
                            lost_to_followup = 0.2,
                            unknown = 0.1
                          ),
-                         config = create_config(),
-                         ...) {
-  chkDots(...)
-
-  serial_interval <- as.function(serial_interval, func_typ = "generate")
+                         config = create_config()) {
+  # check and convert distribution to func if needed before .check_sim_input()
+  stopifnot(
+    "Input delay distributions need to be either functions or <epidist>" =
+      inherits(serial_interval, c("function", "epidist")) &&
+      inherits(contact_distribution, c("function", "epidist"))
+  )
+  serial_interval <- as.function(serial_interval, func_type = "generate")
   contact_distribution <- as.function(
     contact_distribution,
     func_type = "generate"
@@ -62,7 +65,7 @@ sim_contacts <- function(R,
     R = R,
     serial_interval = serial_interval,
     outbreak_start_date = outbreak_start_date,
-    min_chain_size = min_chain_size,
+    min_outbreak_size = min_outbreak_size,
     contact_distribution = contact_distribution,
     contact_tracing_status_probs = contact_tracing_status_probs,
     population_age = population_age
@@ -72,7 +75,7 @@ sim_contacts <- function(R,
     R = R,
     serial_interval = serial_interval,
     outbreak_start_date = outbreak_start_date,
-    min_chain_size = min_chain_size,
+    min_outbreak_size = min_outbreak_size,
     population_age = population_age,
     config = config
   )

R/sim_contacts_tbl.R

@@ -126,7 +126,7 @@
   )
 
   # remove infector col
-  contact_investigation <- contact_investigation[, -1]
+  contact_investigation$infector <- NULL
 
   # return contacts
   contact_investigation

R/sim_linelist.R

@@ -1,7 +1,7 @@
 #' Simulate a line list
 #'
 #' @description The line list is simulated using a branching process and
-#' parameterised with previously published epidemiological parameters.
+#' parameterised with user defined epidemiological parameters.
 #'
 #' @details For age-stratified hospitalised and death rates a `<data.frame>`
 #' will need to be passed to the `hosp_rate` and/or `hosp_death_rate`
@@ -46,9 +46,9 @@
 #' @param add_names A `logical` boolean for whether to add names to each row
 #' of the line list. Default is `TRUE`.
 #' @param add_ct A `logical` boolean for whether to add Ct values to each row
-#' of the line list. Default is `FALSE`.
-#' @param min_chain_size A single `numeric` defining the minimum chain size for
-#' the simulated outbreak. Default is `10`. This can be increased when the
+#' of the line list. Default is `TRUE`.
+#' @param min_outbreak_size A single `numeric` defining the minimum chain size
+#' for the simulated outbreak. Default is `10`. This can be increased when the
 #' function should simulate a larger outbreak.
 #' @param population_age Either a `numeric` vector with two elements or a
 #' `<data.frame>` with age structure in the population. Use a `numeric` vector
@@ -62,9 +62,6 @@
 #' `"confirmed"`. Values of each case type must sum to one.
 #' @param config A list of settings to adjust the randomly sampled delays and
 #' Ct values (if `add_ct = TRUE`). See [create_config()] for more information.
-#' @param ... [dots] Extra arguments to be passed to other functions.
-#' **Currently not used and will return a warning if extra arguments are
-#' supplied**.
 #'
 #' @return A line list `<data.frame>`
 #' @export
@@ -101,6 +98,7 @@
 #'   onset_to_death = onset_to_death,
 #'   hosp_rate = 0.5
 #' )
+#' head(linelist)
 #'
 #' # example with age-stratified hospitalisation rate
 #' # 20% for over 80s
@@ -117,6 +115,7 @@
 #'   onset_to_death = onset_to_death,
 #'   hosp_rate = age_dep_hosp_rate
 #' )
+#' head(linelist)
 sim_linelist <- function(R,
                          serial_interval,
                          onset_to_hosp,
@@ -126,18 +125,22 @@ sim_linelist <- function(R,
                          non_hosp_death_rate = 0.05,
                          outbreak_start_date = as.Date("2023-01-01"),
                          add_names = TRUE,
-                         add_ct = FALSE,
-                         min_chain_size = 10,
+                         add_ct = TRUE,
+                         min_outbreak_size = 10,
                          population_age = c(1, 90),
                          case_type_probs = c(
                            suspected = 0.2,
                            probable = 0.3,
                            confirmed = 0.5
                          ),
-                         config = create_config(),
-                         ...) {
-  chkDots(...)
-
+                         config = create_config()) {
+  # check and convert distribution to func if needed before .check_sim_input()
+  stopifnot(
+    "Input delay distributions need to be either functions or <epidist>" =
+      inherits(serial_interval, c("function", "epidist")) &&
+      inherits(onset_to_hosp, c("function", "epidist")) &&
+      inherits(onset_to_death, c("function", "epidist"))
+  )
   serial_interval <- as.function(serial_interval, func_type = "generate")
   onset_to_hosp <- as.function(onset_to_hosp, func_type = "generate")
   onset_to_death <- as.function(onset_to_death, func_type = "generate")
@@ -147,7 +150,7 @@ sim_linelist <- function(R,
     R = R,
     serial_interval = serial_interval,
     outbreak_start_date = outbreak_start_date,
-    min_chain_size = min_chain_size,
+    min_outbreak_size = min_outbreak_size,
     onset_to_hosp = onset_to_hosp,
     onset_to_death = onset_to_death,
     add_names = add_names,
@@ -191,7 +194,7 @@ sim_linelist <- function(R,
     R = R,
     serial_interval = serial_interval,
     outbreak_start_date = outbreak_start_date,
-    min_chain_size = min_chain_size,
+    min_outbreak_size = min_outbreak_size,
     population_age = population_age,
     config = config
   )

R/sim_outbreak.R

@@ -63,8 +63,8 @@ sim_outbreak <- function(R,
                          non_hosp_death_rate = 0.05,
                          outbreak_start_date = as.Date("2023-01-01"),
                          add_names = TRUE,
-                         add_ct = FALSE,
-                         min_chain_size = 10,
+                         add_ct = TRUE,
+                         min_outbreak_size = 10,
                          population_age = c(1, 90),
                          case_type_probs = c(
                            suspected = 0.2,
@@ -76,10 +76,15 @@ sim_outbreak <- function(R,
                            lost_to_followup = 0.2,
                            unknown = 0.1
                          ),
-                         config = create_config(),
-                         ...) {
-  chkDots(...)
-
+                         config = create_config()) {
+  # check and convert distribution to func if needed before .check_sim_input()
+  stopifnot(
+    "Input delay distributions need to be either functions or <epidist>" =
+      inherits(serial_interval, c("function", "epidist")) &&
+      inherits(onset_to_hosp, c("function", "epidist")) &&
+      inherits(onset_to_death, c("function", "epidist")) &&
+      inherits(contact_distribution, c("function", "epidist"))
+  )
   serial_interval <- as.function(serial_interval, func_type = "generate")
   onset_to_hosp <- as.function(onset_to_hosp, func_type = "generate")
   onset_to_death <- as.function(onset_to_death, func_type = "generate")
@@ -93,7 +98,7 @@ sim_outbreak <- function(R,
     R = R,
     serial_interval = serial_interval,
     outbreak_start_date = outbreak_start_date,
-    min_chain_size = min_chain_size,
+    min_outbreak_size = min_outbreak_size,
     onset_to_hosp = onset_to_hosp,
     onset_to_death = onset_to_death,
     contact_distribution = contact_distribution,
@@ -139,7 +144,7 @@ sim_outbreak <- function(R,
     R = R,
     serial_interval = serial_interval,
     outbreak_start_date = outbreak_start_date,
-    min_chain_size = min_chain_size,
+    min_outbreak_size = min_outbreak_size,
     population_age = population_age,
     config = config
   )

R/sim_utils.R

@@ -17,12 +17,13 @@ NULL
 .sim_bp_linelist <- function(R,
                              serial_interval,
                              outbreak_start_date,
-                             min_chain_size,
+                             min_outbreak_size,
                              population_age,
                              config) {
   chain_size <- 0
+  max_iter <- 0L
   # condition on a minimum chain size
-  while (chain_size < min_chain_size) {
+  while (chain_size < min_outbreak_size) {
     chain <- bpmodels::chain_sim(
       n = 1,
       offspring = "pois",
@@ -33,6 +34,14 @@ NULL
       infinite = 1000
     )
     chain_size <- max(chain$id)
+    max_iter <- max_iter + 1L
+    if (max_iter >= 1e4) {
+      stop(
+        "Exceeded maximum number of iterations for simulating outbreak. \n",
+        "Change input parameters or min_outbreak_size.",
+        call. = FALSE
+      )
+    }
   }
 
   names(chain)[names(chain) == "ancestor"] <- "infector"