Add self-isolation to simulation model

R/checking.R

@@ -48,3 +48,38 @@ check_dist_func <- function(func,
 
   TRUE
 }
+
+#' Cross-check `*_opts()` lists to run the \pkg{ringbp} model
+#'
+#' @details Currently the only cross-checking is between
+#'   `onset_to_self_isolation` from [delay_opts()] and
+#'   `symptomatic_self_isolate` from [event_prob_opts()].
+#'
+#' @inheritParams outbreak_step
+#'
+#' @return `TRUE` if all the checks pass or an error or warning is thrown if
+#'   the simulation options are incompatible.
+#' @keywords internal
+cross_check_opts <- function(delays, event_probs) {
+  if (is.null(delays$onset_to_self_isolation) &&
+      event_probs$symptomatic_self_isolate > 0) {
+    stop(
+      "A non-zero `symptomatic_self_isolate` has been specified in ",
+      "`event_prob_opts()`, but `onset_to_self_isolation` is `NULL`.\n",
+      "Please specify an `onset_to_self_isolation` function for a proportion ",
+      "of symptomatic infections to self-isolate.",
+      call. = FALSE)
+  }
+  if (is.function(delays$onset_to_self_isolation) &&
+      event_probs$symptomatic_self_isolate == 0) {
+    warning(
+      "An `onset_to_self_isolation` delay has been specified in ",
+      "`delay_opts()`, but the `symptomatic_self_isolate` in ",
+      "`event_prob_opts()` is zero.\nIgnoring `onset_to_self_isolation`.\n",
+      "Please specify a non-zero value to `symptomatic_self_isolate` for a ",
+      "proportion of symptomatic infections to self-isolate.",
+      call. = FALSE
+    )
+  }
+  TRUE
+}

R/globals.R

@@ -23,6 +23,7 @@ utils::globalVariables(c(
   "asymptomatic", # <outbreak_step>
   "onset", # <outbreak_step>
   "exposure", # <outbreak_step>
+  "self_isolate", # <outbreak_step>
   "infector_asymptomatic", # <outbreak_step>
   "traced", # <outbreak_step>
   "test_positive", # <outbreak_step>

R/opts.R

@@ -73,6 +73,19 @@ offspring_opts <- function(community, isolated, asymptomatic = community) {
 #'   presymptomatic transmission, depending on the `incubation_period`
 #'   distribution and `presymptomatic_transmission` (in [event_prob_opts()]).
 #'
+#' @param onset_to_self_isolation a `function`: a random number generating
+#'   `function` that samples from the onset-to-self-isolation distribution,
+#'   the `function` accepts a single `integer` argument specifying the length
+#'   of the `function` output.
+#'
+#'   By default `onset_to_self_isolation` is `NULL`. An onset-to-self-isolation
+#'   `function` only needs to be specified if a non-zero value is specified to
+#'   `symptomatic_self_isolate` in [event_prob_opts()] (which by default is 0).
+#'   If `onset_to_self_isolation` is specified but `symptomatic_self_isolate`
+#'   is zero, a warning will be thrown and the `onset_to_self_isolation`
+#'   will be ignored; if `symptomatic_self_isolate` is non-zero and
+#'   `onset_to_self_isolation` is `NULL`, [scenario_sim()] will error.
+#'
 #' @return A `list` with class `<ringbp_delay_opts>`.
 #' @export
 #'
@@ -83,11 +96,18 @@ offspring_opts <- function(community, isolated, asymptomatic = community) {
 #' )
 delay_opts <- function(incubation_period,
                        onset_to_isolation,
-                       latent_period = 0) {
+                       latent_period = 0,
+                       onset_to_self_isolation = NULL) {
 
   check_dist_func(incubation_period, dist_name = "incubation_period")
   check_dist_func(onset_to_isolation, dist_name = "onset_to_isolation")
   checkmate::assert_number(latent_period, lower = 0, finite = TRUE)
+  if (!is.null(onset_to_self_isolation)) {
+    check_dist_func(
+      onset_to_self_isolation,
+      dist_name = "onset_to_self_isolation"
+    )
+  }
 
   if (latent_period > 0) {
     warning(
@@ -103,7 +123,8 @@ delay_opts <- function(incubation_period,
   opts <- list(
     incubation_period = incubation_period,
     onset_to_isolation = onset_to_isolation,
-    latent_period = latent_period
+    latent_period = latent_period,
+    onset_to_self_isolation = onset_to_self_isolation
   )
 
   class(opts) <- "ringbp_delay_opts"
@@ -119,6 +140,15 @@ delay_opts <- function(incubation_period,
 #' @param symptomatic_traced a `numeric` scalar probability (between 0
 #'   and 1 inclusive): proportion of infectious contacts ascertained by contact
 #'   tracing
+#' @param symptomatic_self_isolate a `numeric` scalar probability (between 0
+#'   and 1 inclusive): proportion of cases that self-isolate when they become
+#'   symptomatic. These individuals do not get tested and do not require a
+#'   positive test result to enter isolation. Default is 0 (i.e. no infectious
+#'   individuals self-isolate).
+#'
+#'   If `symptomatic_self_isolate` is non-zero a random number generating
+#'   `function` needs to be specified in the `onset_to_self_isolation` argument
+#'   in the [delay_opts()] function, otherwise the [scenario_sim()] will error.
 #'
 #' @return A `list` with class `<ringbp_event_prob_opts>`.
 #' @export
@@ -131,11 +161,13 @@ delay_opts <- function(incubation_period,
 #' )
 event_prob_opts <- function(asymptomatic,
                             presymptomatic_transmission,
-                            symptomatic_traced) {
+                            symptomatic_traced,
+                            symptomatic_self_isolate = 0) {
 
   checkmate::assert_number(asymptomatic, lower = 0, upper = 1)
   checkmate::assert_number(presymptomatic_transmission, lower = 0, upper = 1)
   checkmate::assert_number(symptomatic_traced, lower = 0, upper = 1)
+  checkmate::assert_number(symptomatic_self_isolate, lower = 0, upper = 1)
 
   # calculate alpha parameter from presymptomatic_transmission
   alpha <- presymptomatic_transmission_to_alpha(
@@ -146,7 +178,8 @@ event_prob_opts <- function(asymptomatic,
     asymptomatic = asymptomatic,
     presymptomatic_transmission = presymptomatic_transmission,
     alpha = alpha,
-    symptomatic_traced = symptomatic_traced
+    symptomatic_traced = symptomatic_traced,
+    symptomatic_self_isolate = symptomatic_self_isolate
   )
 
   class(opts) <- "ringbp_event_prob_opts"

R/outbreak_model.R

@@ -56,6 +56,7 @@ outbreak_model <- function(initial_cases,
   checkmate::assert_class(event_probs, "ringbp_event_prob_opts")
   checkmate::assert_class(interventions, "ringbp_intervention_opts")
   checkmate::assert_class(sim, "ringbp_sim_opts")
+  cross_check_opts(delays, event_probs)
 
   # Initial setup
   case_data <- outbreak_setup(

R/outbreak_setup.R

@@ -13,6 +13,7 @@
 #' * `$traced`: `logical`
 #' * `$onset`: `numeric`
 #' * `$new_cases`: `integer`
+#' * `$self_isolate`: `logical`
 #' * `$isolated_time`: `numeric`
 #' * `$sampled`: `logical`
 #' @autoglobal
@@ -53,6 +54,7 @@ outbreak_setup <- function(initial_cases, delays, event_probs) {
     traced = FALSE,
     onset = delays$incubation_period(initial_cases),
     new_cases = NA_integer_,
+    self_isolate = FALSE,
     isolated_time = Inf,
     sampled = FALSE
   )

R/outbreak_step.R

@@ -8,15 +8,17 @@
 #'   and `asymptomatic`
 #' @param delays a `list` with class `<ringbp_delay_opts>`: the
 #'   delay distribution `function`s for the \pkg{ringbp} model, returned
-#'   by [delay_opts()]. Contains two elements: `incubation_period` and
-#'   `onset_to_isolation`
+#'   by [delay_opts()]. Contains 4 elements: `incubation_period`,
+#'   `onset_to_isolation`, `latent_period` and `onset_to_self_isolation`
 #' @param event_probs a `list` with class `<ringbp_event_prob_opts>`: the
 #'   event probabilities for the \pkg{ringbp} model, returned by
-#'   [event_prob_opts()]. Contains three elements: `asymptomatic`,
-#'   `presymptomatic_transmission` and `symptomatic_traced`
+#'   [event_prob_opts()]. Contains 5 elements: `asymptomatic`,
+#'   `presymptomatic_transmission`, `alpha`, `symptomatic_traced` and
+#'   `symptomatic_self_isolate`
 #' @param interventions a `list` with class `<ringbp_intervention_opts>`:
 #'   the intervention settings for the \pkg{ringbp} model, returned by
-#'   [intervention_opts()]. Contains one element: `quarantine`
+#'   [intervention_opts()]. Contains 2 elements: `quarantine` and
+#'   `test_sensitivity`
 #'
 #' @importFrom data.table data.table rbindlist fcase fifelse copy
 #' @importFrom stats runif rnbinom rbinom
@@ -122,41 +124,56 @@ outbreak_step <- function(case_data,
     sampled = FALSE,
     # assign negative test result (FALSE) as placeholder;
     # will draw test result for symptomatic cases below
-    test_positive = FALSE
+    test_positive = FALSE,
+    # assign no isolation as placeholder; symptomatic, test-positive,
+    # traced or quarantined isolation time sampled below
+    isolated_time = Inf
   )][,
     # draws a sample to see if this person is asymptomatic
     asymptomatic := runif(.N) < event_probs$asymptomatic
   ][,
     # onset of new case is exposure + incubation period sample
     onset := exposure + delays$incubation_period(.N)
+  ][
+    # draw a sample to see if each person self-isolates if symptomatic
+    asymptomatic == FALSE,
+    self_isolate := runif(.N) < event_probs$symptomatic_self_isolate
   ]
 
   # draw a sample for missing and test result
   prob_samples[
     infector_asymptomatic == FALSE,
     traced := runif(.N) < event_probs$symptomatic_traced
   ][
-    asymptomatic == FALSE,
+    asymptomatic == FALSE & self_isolate == FALSE,
     test_positive := runif(.N) <= interventions$test_sensitivity
   ]
 
-  prob_samples[, isolated_time := {
-    ref_time <- onset + delays$onset_to_isolation(.N)
-    fcase(
-      # asymptomatic: never isolated
-      asymptomatic, Inf,
-      # symptomatic, false-negative test: never isolated
-      !test_positive, Inf,
-      # symptomatic, test-positive, not traced: isolated at symptom onset + delay
-      !traced, ref_time,
-      # symptomatic, test-positive, traced, quarantine:
-      # earliest of infector / infectee isolation time
-      rep(interventions$quarantine, .N), pmin(ref_time, infector_isolation_time),
-      # symptomatic, test-positive, traced, no quarantine:
-      # earliest of symptom onset + delay / infector isolation time
-      default = pmin(ref_time, pmax(onset, infector_isolation_time))
-    )
-  }]
+  # symptomatic, self-isolate, not tested:
+  # isolated at symptom onset + self-isolation delay
+  prob_samples[
+    self_isolate == TRUE,
+    isolated_time := onset + delays$onset_to_self_isolation(.N)
+  ]
+
+  # asymptomatic and symptomatic with false-negative test:
+  # never isolated remain Inf
+  prob_samples[
+    !self_isolate & !asymptomatic & test_positive,
+    isolated_time := {
+      ref_time <- onset + delays$onset_to_isolation(.N)
+      fcase(
+        # symptomatic, test-positive, not traced: isolated at symptom onset + delay
+        !traced, ref_time,
+        # symptomatic, test-positive, traced, quarantine:
+        # earliest of infector / infectee isolation time
+        rep(interventions$quarantine, .N), pmin(ref_time, infector_isolation_time),
+        # symptomatic, test-positive, traced, no quarantine:
+        # earliest of symptom onset + delay / infector isolation time
+        default = pmin(ref_time, pmax(onset, infector_isolation_time))
+      )
+    }
+  ]
 
   # Chop out unneeded sample columns
   prob_samples[

R/scenario_sim.R

@@ -63,6 +63,7 @@ scenario_sim <- function(n,
   checkmate::assert_class(event_probs, "ringbp_event_prob_opts")
   checkmate::assert_class(interventions, "ringbp_intervention_opts")
   checkmate::assert_class(sim, "ringbp_sim_opts")
+  cross_check_opts(delays, event_probs)
 
   # Run n number of model runs and put them all together in a big data.frame
   res <- replicate(