diff --git a/CITATION.cff b/CITATION.cff index 8c91cec8..6d4c926a 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -1,7 +1,7 @@ -# ----------------------------------------------------------- -# CITATION file created with {cffr} R package, v1.0.0 +# -------------------------------------------- +# CITATION file created with {cffr} R package # See also: https://docs.ropensci.org/cffr/ -# ----------------------------------------------------------- +# -------------------------------------------- cff-version: 1.2.0 message: 'To cite package "simulist" in publications use:' @@ -347,3 +347,4 @@ references: identifiers: - type: url value: https://epiverse-trace.github.io/simulist/ + diff --git a/R/add_cols.R b/R/add_cols.R index 9d77b98b..73e3108e 100644 --- a/R/add_cols.R +++ b/R/add_cols.R @@ -122,7 +122,8 @@ NULL onset_to_death, onset_to_recovery, hosp_death_risk, - non_hosp_death_risk) { + non_hosp_death_risk, + config) { infected_idx <- .data$infected == "infected" num_infected <- sum(infected_idx) .data$outcome <- "contact" @@ -130,43 +131,74 @@ NULL .data$outcome[infected_idx] <- "recovered" .data$outcome_time[infected_idx] <- .data$time[infected_idx] + onset_to_recovery(num_infected) - hosp_idx <- !is.na(.data$hospitalisation) - non_hosp_idx <- is.na(.data$hospitalisation) + hosp_idx <- !is.na(.data$hospitalisation) & infected_idx + non_hosp_idx <- is.na(.data$hospitalisation) & infected_idx - apply_death_risk <- function(.data, risk, idx) { + # internal function only called in .add_outcome() + # assign deaths using population or age-stratified death risk + # if risk is NA then no deaths are assigned + apply_death_risk <- function(.data, risk, idx, config) { if (!is_na(risk)) { + # single population risk is a special case of the age-strat risk + # convert population risk to data.frame to apply the same operations if (is.numeric(risk)) { - # size is converted to an integer internally in sample() - pop_sample <- sample( - which(idx), - replace = FALSE, - size = risk * sum(idx) + risk <- data.frame( + min_age = min(.data$age), + max_age = max(.data$age), + risk = risk + ) + } + # find risk group for each individual based on age + # findInterval indexes from 0 so plus 1 for R vec indexing + # oldest age group is inclusive at upper bound so rightmost.closed = TRUE + risk_group_idx <- findInterval( + x = .data$age, + vec = risk$max_age, + rightmost.closed = TRUE + ) + 1 + # assign risk to each individual given age group + risk_ <- risk$risk[risk_group_idx] + if (is.function(config$time_varying_death_risk)) { + .check_func_req_args( + config$time_varying_death_risk, + func_name = "time_varying_death_risk", + n_req_args = 2, + req_arg_names = c("risk", "time") ) - .data$outcome[pop_sample] <- "died" - .data$outcome_time[pop_sample] <- .data$time[pop_sample] + - onset_to_death(length(pop_sample)) - } else { - for (i in seq_len(nrow(risk))) { - age_bracket <- risk$min_age[i]:risk$max_age[i] - age_group <- which(.data$age %in% age_bracket & idx) - # size is converted to an integer internally in sample() - age_group_sample <- sample( - age_group, - replace = FALSE, - size = risk$risk[i] * length(age_group) + risk_ <- config$time_varying_death_risk( + risk = risk$risk[risk_group_idx], + time = .data$time + ) + valid_risk <- checkmate::test_numeric( + risk_, + lower = 0, + upper = 1, + any.missing = FALSE + ) + if (!valid_risk) { + stop( + "Time-varying death risk outside [0,1]. \n", + "Check time-varying function.", + call. = FALSE ) - .data$outcome[age_group_sample] <- "died" - .data$outcome_time[age_group_sample] <- .data$time[age_group_sample] + - onset_to_death(length(age_group_sample)) } } + # sample individuals to die given risk group + died_idx <- stats::rbinom(n = length(risk_), size = 1, prob = risk_) + # died index requires individuals to be in idx group (e.g. hosp) + died_idx <- as.logical(died_idx) & idx + .data$outcome[died_idx] <- "died" + .data$outcome_time[died_idx] <- .data$time[died_idx] + + onset_to_death(sum(died_idx)) } .data } - .data <- apply_death_risk(.data, risk = hosp_death_risk, idx = hosp_idx) .data <- apply_death_risk( - .data, risk = non_hosp_death_risk, idx = non_hosp_idx + .data, risk = hosp_death_risk, idx = hosp_idx, config = config + ) + .data <- apply_death_risk( + .data, risk = non_hosp_death_risk, idx = non_hosp_idx, config = config ) # return data diff --git a/R/checkers.R b/R/checkers.R index 0fdefa6f..898a1e0d 100644 --- a/R/checkers.R +++ b/R/checkers.R @@ -133,8 +133,8 @@ sim_type <- match.arg(sim_type) checkmate::assert_number(prob_infect, lower = 0, upper = 1) - .check_func_req_args(contact_distribution) - .check_func_req_args(infect_period) + .check_func_req_args(contact_distribution, func_name = "contact_distribution") + .check_func_req_args(infect_period, func_name = "infect_period") checkmate::assert_date(outbreak_start_date) checkmate::assert_integerish(outbreak_size, lower = 1, len = 2) @@ -145,9 +145,9 @@ ) if (sim_type %in% c("linelist", "outbreak")) { - .check_func_req_args(onset_to_hosp) - .check_func_req_args(onset_to_death) - .check_func_req_args(onset_to_recovery) + .check_func_req_args(onset_to_hosp, func_name = "onset_to_hosp") + .check_func_req_args(onset_to_death, func_name = "onset_to_death") + .check_func_req_args(onset_to_recovery, func_name = "onset_to_recovery") checkmate::assert_logical(add_names, len = 1) checkmate::assert_logical(add_ct, len = 1) checkmate::assert_numeric(case_type_probs, len = 3, lower = 0, upper = 1) @@ -160,15 +160,23 @@ "The values in the case_type_prob vector must sum to 1" = sum(case_type_probs) == 1, "hosp_risk must be a single numeric or a data.frame" = - is.numeric(hosp_risk) && length(hosp_risk) == 1 || - is.data.frame(hosp_risk) || is_na(hosp_risk), + is.numeric(hosp_risk) || is.data.frame(hosp_risk) || is_na(hosp_risk), "hosp_death_risk must be a single numeric or a data.frame" = - is.numeric(hosp_death_risk) && length(hosp_death_risk) == 1 || - is.data.frame(hosp_death_risk) || is_na(hosp_death_risk), + is.numeric(hosp_death_risk) || is.data.frame(hosp_death_risk) || + is_na(hosp_death_risk), "non_hosp_death_risk must be a single numeric or a data.frame" = - is.numeric(non_hosp_death_risk) && length(non_hosp_death_risk) == 1 || - is.data.frame(non_hosp_death_risk) || is_na(non_hosp_death_risk) + is.numeric(non_hosp_death_risk) || is.data.frame(non_hosp_death_risk) || + is_na(non_hosp_death_risk) ) + if (is.numeric(hosp_risk)) { + checkmate::assert_number(hosp_risk, lower = 0, upper = 1) + } + if (is.numeric(hosp_death_risk)) { + checkmate::assert_number(hosp_death_risk, lower = 0, upper = 1) + } + if (is.numeric(non_hosp_death_risk)) { + checkmate::assert_number(non_hosp_death_risk, lower = 0, upper = 1) + } } if (sim_type %in% c("contacts", "outbreak")) { @@ -198,16 +206,37 @@ #' @return A `logical`. #' @keywords internal #' @noRd -.check_func_req_args <- function(func, n_req_args = 1) { +.check_func_req_args <- function(func, + func_name, + n_req_args = 1, + req_arg_names = NULL) { checkmate::assert_function(func) checkmate::assert_count(n_req_args, positive = TRUE) # using formals(args(fn)) to allow checking args of builtin primitives # for which formals(fn) would return NULL and cause the check to error # errors non-informatively for specials such as `if` - checkmate::test_function(func) && + valid_func <- checkmate::test_function(func) && sum(mapply(function(x, y) { # nolint undesirable function is.name(x) && y != "..." }, formals(args(func)), names(formals(args(func))))) == n_req_args + + + msg <- character(0) + if (!valid_func) { + msg <- c(msg, paste( + func_name, "supplied must have", n_req_args, "arguments." + )) + } + if (!is.null(req_arg_names) && + !identical(names(formals(func)), req_arg_names)) { + msg <- c(msg, paste( + func_name, "supplied must have", paste(req_arg_names, collapse = " & "), + "arguments." + )) + } + if (length(msg) > 0) { + stop("\n", sprintf(" - %s\n", msg), call. = FALSE) + } } #' Cross check the onset-to-hospitalisation or -death arguments are diff --git a/R/create_config.R b/R/create_config.R index 94d9c5e3..107b88b2 100644 --- a/R/create_config.R +++ b/R/create_config.R @@ -4,7 +4,8 @@ #' around time windows around infections (time of first contact and last #' contact with infector), and the distribution of the Cycle threshold (Ct) #' value from a Real-time PCR or quantitative PCR (qPCR) for confirmed -#' cases. +#' cases, the network effect in the simulation, and if there is a time-varying +#' death risk. #' #' Accepted arguments and their defaults are: #' * `last_contact_distribution = "pois"` @@ -14,6 +15,7 @@ #' * `ct_distribution = "norm"` #' * `ct_distribution_params = c(mean = 25, sd = 2)` #' * `network = "adjusted"` +#' * `time_varying_death_risk = NULL` #' #' These parameters do not warrant their own arguments in #' [sim_linelist()] as they rarely need to be changed from their default @@ -57,7 +59,8 @@ create_config <- function(...) { first_contact_distribution_params = c(lambda = 3), ct_distribution = "norm", ct_distribution_params = c(mean = 25, sd = 2), - network = "adjusted" + network = "adjusted", + time_varying_death_risk = NULL ) # capture dynamic dots diff --git a/R/sim_internal.R b/R/sim_internal.R index 9f97bf53..73f77d90 100644 --- a/R/sim_internal.R +++ b/R/sim_internal.R @@ -115,7 +115,8 @@ onset_to_death = onset_to_death, onset_to_recovery = onset_to_recovery, hosp_death_risk = hosp_death_risk, - non_hosp_death_risk = non_hosp_death_risk + non_hosp_death_risk = non_hosp_death_risk, + config = config ) # add hospitalisation and death dates diff --git a/R/sim_linelist.R b/R/sim_linelist.R index 7495c546..4d244be2 100644 --- a/R/sim_linelist.R +++ b/R/sim_linelist.R @@ -53,13 +53,17 @@ #' specific hospitalised death risks Default is 50% death risk in hospitals #' (`0.5`) for the entire population. If the `onset_to_death` argument is set #' to `NA` this argument should also be set to `NA`. See details and examples -#' for more information. +#' for more information. If a time-varying death risk is specified in the +#' `config` the `hosp_death_risk` is interpreted as the maximum risk across +#' the epidemic. #' @param non_hosp_death_risk Either a single `numeric` for the death risk for #' outside of hospitals across the population, or a `` with age #' specific death risks outside of hospitals. Default is 5% death risk outside #' of hospitals (`0.05`) for the entire population. If the `onset_to_death` #' argument is set to `NA` this argument should also be set to `NA`. See -#' details and examples for more information. +#' details and examples for more information. If a time-varying death risk is +#' specified in the `config` the `non_hosp_death_risk` is interpreted as the +#' maximum risk across the epidemic. #' @param outbreak_start_date A `date` for the start of the outbreak. #' @param add_names A `logical` boolean for whether to add names to each row #' of the line list. Default is `TRUE`. diff --git a/_pkgdown.yml b/_pkgdown.yml index 7f62032a..e30026ef 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -23,6 +23,7 @@ articles: contents: - age-strat-risks - age-struct-pop + - time-varying-cfr - vis-linelist - title: Developer Documentation navbar: Developer Documentation diff --git a/inst/WORDLIST b/inst/WORDLIST index 32bc7226..32bcd2d2 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,15 +1,21 @@ +aes apyramid bookdown +bw +cfr CMD codecov Codecov com +config CoV COVID Ct ct db +df dist +dplyr epi Epi epicontacts @@ -58,6 +64,7 @@ svg tabset testthat threejs +tidyr Tidyverse visNetwork yaml diff --git a/man/create_config.Rd b/man/create_config.Rd index f2e449bb..291c4ecb 100644 --- a/man/create_config.Rd +++ b/man/create_config.Rd @@ -22,7 +22,8 @@ The \code{config} argument in \code{\link[=sim_linelist]{sim_linelist()}} contro around time windows around infections (time of first contact and last contact with infector), and the distribution of the Cycle threshold (Ct) value from a Real-time PCR or quantitative PCR (qPCR) for confirmed -cases. +cases, the network effect in the simulation, and if there is a time-varying +death risk. Accepted arguments and their defaults are: \itemize{ @@ -33,6 +34,7 @@ Accepted arguments and their defaults are: \item \code{ct_distribution = "norm"} \item \code{ct_distribution_params = c(mean = 25, sd = 2)} \item \code{network = "adjusted"} +\item \code{time_varying_death_risk = NULL} } These parameters do not warrant their own arguments in diff --git a/man/dot-add_date.Rd b/man/dot-add_date.Rd index 64e77276..f0a87cf7 100644 --- a/man/dot-add_date.Rd +++ b/man/dot-add_date.Rd @@ -22,7 +22,8 @@ onset_to_death, onset_to_recovery, hosp_death_risk, - non_hosp_death_risk + non_hosp_death_risk, + config ) } \arguments{ @@ -65,14 +66,21 @@ hospitalised individuals across the population, or a \verb{} with ag specific hospitalised death risks Default is 50\% death risk in hospitals (\code{0.5}) for the entire population. If the \code{onset_to_death} argument is set to \code{NA} this argument should also be set to \code{NA}. See details and examples -for more information.} +for more information. If a time-varying death risk is specified in the +\code{config} the \code{hosp_death_risk} is interpreted as the maximum risk across +the epidemic.} \item{non_hosp_death_risk}{Either a single \code{numeric} for the death risk for outside of hospitals across the population, or a \verb{} with age specific death risks outside of hospitals. Default is 5\% death risk outside of hospitals (\code{0.05}) for the entire population. If the \code{onset_to_death} argument is set to \code{NA} this argument should also be set to \code{NA}. See -details and examples for more information.} +details and examples for more information. If a time-varying death risk is +specified in the \code{config} the \code{non_hosp_death_risk} is interpreted as the +maximum risk across the epidemic.} + +\item{config}{A list of settings to adjust the randomly sampled delays and +Ct values (if \code{add_ct = TRUE}). See \code{\link[=create_config]{create_config()}} for more information.} } \value{ A \verb{} with one more column than input into \code{.data}. diff --git a/man/dot-check_sim_input.Rd b/man/dot-check_sim_input.Rd index 3f4904de..2b44e8da 100644 --- a/man/dot-check_sim_input.Rd +++ b/man/dot-check_sim_input.Rd @@ -98,14 +98,18 @@ hospitalised individuals across the population, or a \verb{} with ag specific hospitalised death risks Default is 50\% death risk in hospitals (\code{0.5}) for the entire population. If the \code{onset_to_death} argument is set to \code{NA} this argument should also be set to \code{NA}. See details and examples -for more information.} +for more information. If a time-varying death risk is specified in the +\code{config} the \code{hosp_death_risk} is interpreted as the maximum risk across +the epidemic.} \item{non_hosp_death_risk}{Either a single \code{numeric} for the death risk for outside of hospitals across the population, or a \verb{} with age specific death risks outside of hospitals. Default is 5\% death risk outside of hospitals (\code{0.05}) for the entire population. If the \code{onset_to_death} argument is set to \code{NA} this argument should also be set to \code{NA}. See -details and examples for more information.} +details and examples for more information. If a time-varying death risk is +specified in the \code{config} the \code{non_hosp_death_risk} is interpreted as the +maximum risk across the epidemic.} \item{population_age}{Either a \code{numeric} vector with two elements or a \verb{} with age structure in the population. Use a \code{numeric} vector diff --git a/man/dot-cross_check_sim_input.Rd b/man/dot-cross_check_sim_input.Rd index 1f354975..c42419ef 100644 --- a/man/dot-cross_check_sim_input.Rd +++ b/man/dot-cross_check_sim_input.Rd @@ -33,14 +33,18 @@ hospitalised individuals across the population, or a \verb{} with ag specific hospitalised death risks Default is 50\% death risk in hospitals (\code{0.5}) for the entire population. If the \code{onset_to_death} argument is set to \code{NA} this argument should also be set to \code{NA}. See details and examples -for more information.} +for more information. If a time-varying death risk is specified in the +\code{config} the \code{hosp_death_risk} is interpreted as the maximum risk across +the epidemic.} \item{non_hosp_death_risk}{Either a single \code{numeric} for the death risk for outside of hospitals across the population, or a \verb{} with age specific death risks outside of hospitals. Default is 5\% death risk outside of hospitals (\code{0.05}) for the entire population. If the \code{onset_to_death} argument is set to \code{NA} this argument should also be set to \code{NA}. See -details and examples for more information.} +details and examples for more information. If a time-varying death risk is +specified in the \code{config} the \code{non_hosp_death_risk} is interpreted as the +maximum risk across the epidemic.} } \value{ Invisibly return the \code{onset_to_hosp} argument. The function is diff --git a/man/dot-sim_internal.Rd b/man/dot-sim_internal.Rd index 04668f25..6095f279 100644 --- a/man/dot-sim_internal.Rd +++ b/man/dot-sim_internal.Rd @@ -70,14 +70,18 @@ hospitalised individuals across the population, or a \verb{} with ag specific hospitalised death risks Default is 50\% death risk in hospitals (\code{0.5}) for the entire population. If the \code{onset_to_death} argument is set to \code{NA} this argument should also be set to \code{NA}. See details and examples -for more information.} +for more information. If a time-varying death risk is specified in the +\code{config} the \code{hosp_death_risk} is interpreted as the maximum risk across +the epidemic.} \item{non_hosp_death_risk}{Either a single \code{numeric} for the death risk for outside of hospitals across the population, or a \verb{} with age specific death risks outside of hospitals. Default is 5\% death risk outside of hospitals (\code{0.05}) for the entire population. If the \code{onset_to_death} argument is set to \code{NA} this argument should also be set to \code{NA}. See -details and examples for more information.} +details and examples for more information. If a time-varying death risk is +specified in the \code{config} the \code{non_hosp_death_risk} is interpreted as the +maximum risk across the epidemic.} \item{outbreak_start_date}{A \code{date} for the start of the outbreak.} diff --git a/man/sim_linelist.Rd b/man/sim_linelist.Rd index 03a371d4..b5f0dba9 100644 --- a/man/sim_linelist.Rd +++ b/man/sim_linelist.Rd @@ -64,14 +64,18 @@ hospitalised individuals across the population, or a \verb{} with ag specific hospitalised death risks Default is 50\% death risk in hospitals (\code{0.5}) for the entire population. If the \code{onset_to_death} argument is set to \code{NA} this argument should also be set to \code{NA}. See details and examples -for more information.} +for more information. If a time-varying death risk is specified in the +\code{config} the \code{hosp_death_risk} is interpreted as the maximum risk across +the epidemic.} \item{non_hosp_death_risk}{Either a single \code{numeric} for the death risk for outside of hospitals across the population, or a \verb{} with age specific death risks outside of hospitals. Default is 5\% death risk outside of hospitals (\code{0.05}) for the entire population. If the \code{onset_to_death} argument is set to \code{NA} this argument should also be set to \code{NA}. See -details and examples for more information.} +details and examples for more information. If a time-varying death risk is +specified in the \code{config} the \code{non_hosp_death_risk} is interpreted as the +maximum risk across the epidemic.} \item{outbreak_start_date}{A \code{date} for the start of the outbreak.} diff --git a/man/sim_outbreak.Rd b/man/sim_outbreak.Rd index ed2e5bca..224a93d0 100644 --- a/man/sim_outbreak.Rd +++ b/man/sim_outbreak.Rd @@ -66,14 +66,18 @@ hospitalised individuals across the population, or a \verb{} with ag specific hospitalised death risks Default is 50\% death risk in hospitals (\code{0.5}) for the entire population. If the \code{onset_to_death} argument is set to \code{NA} this argument should also be set to \code{NA}. See details and examples -for more information.} +for more information. If a time-varying death risk is specified in the +\code{config} the \code{hosp_death_risk} is interpreted as the maximum risk across +the epidemic.} \item{non_hosp_death_risk}{Either a single \code{numeric} for the death risk for outside of hospitals across the population, or a \verb{} with age specific death risks outside of hospitals. Default is 5\% death risk outside of hospitals (\code{0.05}) for the entire population. If the \code{onset_to_death} argument is set to \code{NA} this argument should also be set to \code{NA}. See -details and examples for more information.} +details and examples for more information. If a time-varying death risk is +specified in the \code{config} the \code{non_hosp_death_risk} is interpreted as the +maximum risk across the epidemic.} \item{outbreak_start_date}{A \code{date} for the start of the outbreak.} diff --git a/tests/testthat/_snaps/sim_linelist.md b/tests/testthat/_snaps/sim_linelist.md index 7b4b5ae4..8411350e 100644 --- a/tests/testthat/_snaps/sim_linelist.md +++ b/tests/testthat/_snaps/sim_linelist.md @@ -4,32 +4,32 @@ sim_linelist(contact_distribution = contact_distribution, infect_period = infect_period, prob_infect = 0.5, onset_to_hosp = onset_to_hosp, onset_to_death = onset_to_death) Output - id case_name case_type sex age date_onset date_admission - 1 1 Damion Hamm confirmed m 35 2023-01-01 - 2 2 Ignacio Hernandez confirmed m 43 2023-01-01 - 3 3 Bryce Donnelly confirmed m 1 2023-01-01 - 4 5 David Arrieta confirmed m 78 2023-01-01 - 5 6 Kristina Vazquez Pallares confirmed f 22 2023-01-01 - 6 8 Nusaiba el-Farah suspected f 28 2023-01-01 - 7 11 Dominic Kills In Sight probable m 46 2023-01-01 2023-01-13 - 8 12 Violet Watts confirmed f 67 2023-01-01 - 9 13 Khristopher Cunniff confirmed m 86 2023-01-01 2023-01-01 - 10 18 Paige Reich probable f 60 2023-01-02 - 11 20 Jackson Carlson confirmed m 49 2023-01-02 - 12 22 Cassandra Smith suspected f 7 2023-01-02 2023-01-02 + id case_name case_type sex age date_onset date_admission + 1 1 Dominic Sundara probable m 35 2023-01-01 + 2 2 Preston Montgomery suspected m 43 2023-01-01 + 3 3 Reece Chittum probable m 1 2023-01-01 + 4 5 Michael Cheek confirmed m 78 2023-01-01 + 5 6 Jennifer Smith confirmed f 22 2023-01-01 + 6 8 Erika Quintero confirmed f 28 2023-01-01 + 7 11 Isaiah Patterson suspected m 46 2023-01-01 2023-01-13 + 8 12 Cicely Anderson suspected f 67 2023-01-01 + 9 13 Michael John probable m 86 2023-01-01 2023-01-01 + 10 18 Giovana Magana Aguirre suspected f 60 2023-01-02 + 11 20 Mudrik al-Hallal suspected m 49 2023-01-02 + 12 22 Tea Slaughter probable f 7 2023-01-02 2023-01-02 outcome date_outcome date_first_contact date_last_contact ct_value - 1 recovered 25.6 - 2 recovered 2022-12-30 2023-01-05 25.6 - 3 recovered 2022-12-30 2023-01-02 25.6 - 4 recovered 2022-12-29 2023-01-02 25.6 - 5 recovered 2023-01-01 2023-01-03 25.6 - 6 recovered 2023-01-03 2023-01-04 NA + 1 recovered NA + 2 recovered 2022-12-30 2023-01-05 NA + 3 recovered 2022-12-30 2023-01-02 NA + 4 recovered 2022-12-29 2023-01-02 23.1 + 5 recovered 2023-01-01 2023-01-03 23.1 + 6 recovered 2023-01-03 2023-01-04 23.1 7 recovered 2023-01-04 2023-01-05 NA - 8 recovered 2023-01-01 2023-01-04 25.6 - 9 recovered 2022-12-31 2023-01-03 25.6 + 8 recovered 2023-01-01 2023-01-04 NA + 9 died 2023-01-12 2022-12-31 2023-01-03 NA 10 recovered 2022-12-30 2023-01-03 NA - 11 recovered 2023-01-01 2023-01-04 25.6 - 12 died 2023-01-16 2023-01-01 2023-01-03 NA + 11 recovered 2023-01-01 2023-01-04 NA + 12 recovered 2023-01-01 2023-01-03 NA # sim_linelist works as expected with age-strat risks @@ -39,32 +39,32 @@ hosp_risk = age_dep_hosp_risk, hosp_death_risk = age_dep_hosp_death_risk, non_hosp_death_risk = age_dep_non_hosp_death_risk) Output - id case_name case_type sex age date_onset date_admission - 1 1 David Garcia Mayen probable m 35 2023-01-01 - 2 2 Rory Kills In Sight confirmed m 43 2023-01-01 - 3 3 Sheldon Martinez confirmed m 1 2023-01-01 2023-01-11 - 4 5 Bryce Cunniff probable m 78 2023-01-01 - 5 6 Lien Whitworth confirmed f 22 2023-01-01 - 6 8 Tiffany Weiss suspected f 28 2023-01-01 - 7 11 Cleatus Kacprowicz probable m 46 2023-01-01 - 8 12 Taylor Moore confirmed f 67 2023-01-01 - 9 13 Tyler Carlson confirmed m 86 2023-01-01 2023-01-01 - 10 18 Grayson Lovelace confirmed f 60 2023-01-02 - 11 20 Abdul Maalik al-Ishak suspected m 49 2023-01-02 2023-01-09 - 12 22 Kendra Newton confirmed f 7 2023-01-02 - outcome date_outcome date_first_contact date_last_contact ct_value - 1 recovered NA - 2 recovered 2022-12-30 2023-01-05 25 - 3 recovered 2022-12-30 2023-01-02 25 - 4 recovered 2022-12-29 2023-01-02 NA - 5 recovered 2023-01-01 2023-01-03 25 - 6 recovered 2023-01-03 2023-01-04 NA - 7 recovered 2023-01-04 2023-01-05 NA - 8 recovered 2023-01-01 2023-01-04 25 - 9 recovered 2022-12-31 2023-01-03 25 - 10 recovered 2022-12-30 2023-01-03 25 - 11 recovered 2023-01-01 2023-01-04 NA - 12 recovered 2023-01-01 2023-01-03 25 + id case_name case_type sex age date_onset date_admission outcome + 1 1 Cass Duran probable m 35 2023-01-01 recovered + 2 2 Mudrik al-Hallal suspected m 43 2023-01-01 recovered + 3 3 Jareer al-Safar probable m 1 2023-01-01 2023-01-11 recovered + 4 5 Raashid el-Huda confirmed m 78 2023-01-01 recovered + 5 6 Erika Sierra confirmed f 22 2023-01-01 recovered + 6 8 Jennifer Hong confirmed f 28 2023-01-01 recovered + 7 11 Donald Childs suspected m 46 2023-01-01 recovered + 8 12 Kayla Johnson suspected f 67 2023-01-01 died + 9 13 Avery Johnston probable m 86 2023-01-01 2023-01-01 recovered + 10 18 Giovana Segarra suspected f 60 2023-01-02 recovered + 11 20 Donald Root suspected m 49 2023-01-02 2023-01-09 recovered + 12 22 Kiona Dalke probable f 7 2023-01-02 recovered + date_outcome date_first_contact date_last_contact ct_value + 1 NA + 2 2022-12-30 2023-01-05 NA + 3 2022-12-30 2023-01-02 NA + 4 2022-12-29 2023-01-02 23.1 + 5 2023-01-01 2023-01-03 23.1 + 6 2023-01-03 2023-01-04 23.1 + 7 2023-01-04 2023-01-05 NA + 8 2023-01-14 2023-01-01 2023-01-04 NA + 9 2022-12-31 2023-01-03 NA + 10 2022-12-30 2023-01-03 NA + 11 2023-01-01 2023-01-04 NA + 12 2023-01-01 2023-01-03 NA # sim_linelist works as expected without Ct @@ -73,19 +73,19 @@ prob_infect = 0.5, onset_to_hosp = onset_to_hosp, onset_to_death = onset_to_death, add_ct = FALSE) Output - id case_name case_type sex age date_onset date_admission - 1 1 Damion Hamm confirmed m 35 2023-01-01 - 2 2 Ignacio Hernandez confirmed m 43 2023-01-01 - 3 3 Bryce Donnelly confirmed m 1 2023-01-01 - 4 5 David Arrieta confirmed m 78 2023-01-01 - 5 6 Kristina Vazquez Pallares confirmed f 22 2023-01-01 - 6 8 Nusaiba el-Farah suspected f 28 2023-01-01 - 7 11 Dominic Kills In Sight probable m 46 2023-01-01 2023-01-13 - 8 12 Violet Watts confirmed f 67 2023-01-01 - 9 13 Khristopher Cunniff confirmed m 86 2023-01-01 2023-01-01 - 10 18 Paige Reich probable f 60 2023-01-02 - 11 20 Jackson Carlson confirmed m 49 2023-01-02 - 12 22 Cassandra Smith suspected f 7 2023-01-02 2023-01-02 + id case_name case_type sex age date_onset date_admission + 1 1 Dominic Sundara probable m 35 2023-01-01 + 2 2 Preston Montgomery suspected m 43 2023-01-01 + 3 3 Reece Chittum probable m 1 2023-01-01 + 4 5 Michael Cheek confirmed m 78 2023-01-01 + 5 6 Jennifer Smith confirmed f 22 2023-01-01 + 6 8 Erika Quintero confirmed f 28 2023-01-01 + 7 11 Isaiah Patterson suspected m 46 2023-01-01 2023-01-13 + 8 12 Cicely Anderson suspected f 67 2023-01-01 + 9 13 Michael John probable m 86 2023-01-01 2023-01-01 + 10 18 Giovana Magana Aguirre suspected f 60 2023-01-02 + 11 20 Mudrik al-Hallal suspected m 49 2023-01-02 + 12 22 Tea Slaughter probable f 7 2023-01-02 2023-01-02 outcome date_outcome date_first_contact date_last_contact 1 recovered 2 recovered 2022-12-30 2023-01-05 @@ -95,10 +95,10 @@ 6 recovered 2023-01-03 2023-01-04 7 recovered 2023-01-04 2023-01-05 8 recovered 2023-01-01 2023-01-04 - 9 recovered 2022-12-31 2023-01-03 + 9 died 2023-01-12 2022-12-31 2023-01-03 10 recovered 2022-12-30 2023-01-03 11 recovered 2023-01-01 2023-01-04 - 12 died 2023-01-16 2023-01-01 2023-01-03 + 12 recovered 2023-01-01 2023-01-03 # sim_linelist works as expected with anonymous @@ -109,30 +109,30 @@ Output id case_type sex age date_onset date_admission outcome date_outcome 1 1 confirmed m 35 2023-01-01 recovered - 2 2 confirmed m 43 2023-01-01 recovered - 3 3 confirmed m 1 2023-01-01 recovered + 2 2 suspected m 43 2023-01-01 recovered + 3 3 probable m 1 2023-01-01 recovered 4 5 confirmed m 78 2023-01-01 recovered - 5 6 suspected f 22 2023-01-01 recovered - 6 8 probable f 28 2023-01-01 recovered + 5 6 confirmed f 22 2023-01-01 recovered + 6 8 confirmed f 28 2023-01-01 recovered 7 11 confirmed m 46 2023-01-01 2023-01-13 recovered - 8 12 confirmed f 67 2023-01-01 recovered - 9 13 probable m 86 2023-01-01 2023-01-01 recovered - 10 18 probable f 60 2023-01-02 recovered + 8 12 suspected f 67 2023-01-01 recovered + 9 13 confirmed m 86 2023-01-01 2023-01-01 died 2023-01-12 + 10 18 suspected f 60 2023-01-02 recovered 11 20 confirmed m 49 2023-01-02 recovered - 12 22 confirmed f 7 2023-01-02 2023-01-02 died 2023-01-16 + 12 22 confirmed f 7 2023-01-02 2023-01-02 recovered date_first_contact date_last_contact ct_value - 1 25.7 - 2 2022-12-30 2023-01-05 25.7 - 3 2022-12-30 2023-01-02 25.7 - 4 2022-12-29 2023-01-02 25.7 - 5 2023-01-01 2023-01-03 NA - 6 2023-01-03 2023-01-04 NA - 7 2023-01-04 2023-01-05 25.7 - 8 2023-01-01 2023-01-04 25.7 - 9 2022-12-31 2023-01-03 NA + 1 23.9 + 2 2022-12-30 2023-01-05 NA + 3 2022-12-30 2023-01-02 NA + 4 2022-12-29 2023-01-02 23.9 + 5 2023-01-01 2023-01-03 23.9 + 6 2023-01-03 2023-01-04 23.9 + 7 2023-01-04 2023-01-05 23.9 + 8 2023-01-01 2023-01-04 NA + 9 2022-12-31 2023-01-03 23.9 10 2022-12-30 2023-01-03 NA - 11 2023-01-01 2023-01-04 25.7 - 12 2023-01-01 2023-01-03 25.7 + 11 2023-01-01 2023-01-04 23.9 + 12 2023-01-01 2023-01-03 23.9 # sim_linelist works as expected with age structure @@ -141,32 +141,32 @@ prob_infect = 0.5, onset_to_hosp = onset_to_hosp, onset_to_death = onset_to_death, population_age = age_struct) Output - id case_name case_type sex age date_onset date_admission outcome - 1 1 Mark Beard confirmed m 44 2023-01-01 recovered - 2 2 Brian Mccracken confirmed m 13 2023-01-01 recovered - 3 3 Jesus Garduno confirmed m 22 2023-01-01 2023-01-09 died - 4 5 Taalib al-Naqvi confirmed m 85 2023-01-01 recovered - 5 6 Kelly Geist confirmed f 41 2023-01-01 recovered - 6 8 Madison Krause suspected f 89 2023-01-01 2023-01-02 recovered - 7 11 Jonathon Lujano probable m 69 2023-01-01 recovered - 8 12 Ashlan Allen confirmed f 23 2023-01-01 recovered - 9 13 Dhaahir el-Hariri confirmed m 9 2023-01-01 recovered - 10 18 Korren Hart probable f 62 2023-01-02 recovered - 11 20 Isaac Huff confirmed m 52 2023-01-02 2023-01-15 recovered - 12 22 Ryanna Watts suspected f 76 2023-01-02 recovered + id case_name case_type sex age date_onset date_admission outcome + 1 1 Kyle Crane suspected m 44 2023-01-01 recovered + 2 2 Ghaamid el-Ishmael confirmed m 13 2023-01-01 recovered + 3 3 Faatih el-Kaiser confirmed m 22 2023-01-01 2023-01-09 recovered + 4 5 Va'Aahi Galligan suspected m 85 2023-01-01 recovered + 5 6 Katelyn Catlin confirmed f 41 2023-01-01 recovered + 6 8 Lynsey Duron confirmed f 89 2023-01-01 2023-01-02 died + 7 11 Wajdi al-Demian confirmed m 69 2023-01-01 recovered + 8 12 Jacy Cousins confirmed f 23 2023-01-01 recovered + 9 13 Travis Foster confirmed m 9 2023-01-01 recovered + 10 18 Maria Eberhart probable f 62 2023-01-02 recovered + 11 20 Mubarak el-Vaziri suspected m 52 2023-01-02 2023-01-15 recovered + 12 22 Erin Payson confirmed f 76 2023-01-02 recovered date_outcome date_first_contact date_last_contact ct_value - 1 25.6 - 2 2022-12-30 2023-01-05 25.6 - 3 2023-01-09 2022-12-30 2023-01-02 25.6 - 4 2022-12-29 2023-01-02 25.6 - 5 2023-01-01 2023-01-03 25.6 - 6 2023-01-03 2023-01-04 NA - 7 2023-01-04 2023-01-05 NA - 8 2023-01-01 2023-01-04 25.6 - 9 2022-12-31 2023-01-03 25.6 + 1 NA + 2 2022-12-30 2023-01-05 25.1 + 3 2022-12-30 2023-01-02 25.1 + 4 2022-12-29 2023-01-02 NA + 5 2023-01-01 2023-01-03 25.1 + 6 2023-01-26 2023-01-03 2023-01-04 25.1 + 7 2023-01-04 2023-01-05 25.1 + 8 2023-01-01 2023-01-04 25.1 + 9 2022-12-31 2023-01-03 25.1 10 2022-12-30 2023-01-03 NA - 11 2023-01-01 2023-01-04 25.6 - 12 2023-01-01 2023-01-03 NA + 11 2023-01-01 2023-01-04 NA + 12 2023-01-01 2023-01-03 25.1 # sim_linelist works as expected with age-strat risks & age struct @@ -175,31 +175,31 @@ prob_infect = 0.5, onset_to_hosp = onset_to_hosp, onset_to_death = onset_to_death, hosp_risk = age_dep_hosp_risk, population_age = age_struct) Output - id case_name case_type sex age date_onset date_admission outcome - 1 1 Taylor Swift probable m 44 2023-01-01 recovered - 2 2 Devion Thomas confirmed m 13 2023-01-01 recovered - 3 3 Dustin Bellow confirmed m 22 2023-01-01 recovered - 4 5 Shabaan el-Laham confirmed m 85 2023-01-01 2023-01-01 recovered - 5 6 Nadheera el-Wakim confirmed f 41 2023-01-01 recovered - 6 8 Mariah Makris confirmed f 89 2023-01-01 recovered - 7 11 Devyn Garcia Mayen confirmed m 69 2023-01-01 recovered - 8 12 Kaylynn Grip suspected f 23 2023-01-01 recovered - 9 13 Bryce Lehmkuhl probable m 9 2023-01-01 recovered - 10 18 Aaliyah Trent confirmed f 62 2023-01-02 recovered - 11 20 Ignacio Abeyta confirmed m 52 2023-01-02 recovered - 12 22 Tiffany Wolfchief probable f 76 2023-01-02 recovered + id case_name case_type sex age date_onset date_admission outcome + 1 1 Maazin el-Othman probable m 44 2023-01-01 recovered + 2 2 Faisal el-Vaziri confirmed m 13 2023-01-01 recovered + 3 3 Jorge Marten suspected m 22 2023-01-01 recovered + 4 5 Kaleb Natarelli confirmed m 85 2023-01-01 2023-01-01 recovered + 5 6 Hope Arshad suspected f 41 2023-01-01 recovered + 6 8 Shanta Holiday probable f 89 2023-01-01 recovered + 7 11 Nicholas Orgill probable m 69 2023-01-01 recovered + 8 12 Chandra Kilian suspected f 23 2023-01-01 recovered + 9 13 Corey Alcala confirmed m 9 2023-01-01 recovered + 10 18 Kanani Nguyen confirmed f 62 2023-01-02 recovered + 11 20 Sean Shrestha probable m 52 2023-01-02 recovered + 12 22 Annie Carter probable f 76 2023-01-02 recovered date_outcome date_first_contact date_last_contact ct_value 1 NA - 2 2022-12-30 2023-01-05 24.9 - 3 2022-12-30 2023-01-02 24.9 - 4 2022-12-29 2023-01-02 24.9 - 5 2023-01-01 2023-01-03 24.9 - 6 2023-01-03 2023-01-04 24.9 - 7 2023-01-04 2023-01-05 24.9 + 2 2022-12-30 2023-01-05 24.1 + 3 2022-12-30 2023-01-02 NA + 4 2022-12-29 2023-01-02 24.1 + 5 2023-01-01 2023-01-03 NA + 6 2023-01-03 2023-01-04 NA + 7 2023-01-04 2023-01-05 NA 8 2023-01-01 2023-01-04 NA - 9 2022-12-31 2023-01-03 NA - 10 2022-12-30 2023-01-03 24.9 - 11 2023-01-01 2023-01-04 24.9 + 9 2022-12-31 2023-01-03 24.1 + 10 2022-12-30 2023-01-03 24.1 + 11 2023-01-01 2023-01-04 NA 12 2023-01-01 2023-01-03 NA # sim_linelist works as expected with modified config @@ -210,32 +210,32 @@ config = create_config(last_contact_distribution = "geom", last_contact_distribution_params = c(prob = 0.5))) Output - id case_name case_type sex age date_onset date_admission - 1 1 Lilibeth Depoyster suspected f 20 2023-01-01 - 2 2 Mubarak el-Othman confirmed m 24 2023-01-01 - 3 3 Tae Woo Karman confirmed m 51 2023-01-01 2023-01-07 - 4 5 Raakaan el-Vaziri suspected m 16 2023-01-01 - 5 6 Jaasim al-Shams confirmed m 83 2023-01-01 - 6 8 Jared Chambers confirmed m 48 2023-01-01 - 7 11 Muneer al-Miah confirmed m 77 2023-01-01 2023-01-01 - 8 12 Abdul Khaliq al-Youssef confirmed m 90 2023-01-01 - 9 13 Cheyenne Garcia confirmed f 66 2023-01-01 - 10 18 Shaakira al-Gaber probable f 31 2023-01-02 2023-01-02 - 11 20 Miguel Stimack suspected m 46 2023-01-02 - 12 22 Benito Casarez confirmed m 75 2023-01-02 - outcome date_outcome date_first_contact date_last_contact ct_value - 1 recovered NA - 2 recovered 2022-12-30 2023-01-01 25.1 - 3 died 2023-01-10 2022-12-31 2023-01-02 25.1 - 4 recovered 2022-12-30 2023-01-02 NA - 5 recovered 2022-12-31 2023-01-01 25.1 - 6 recovered 2022-12-31 2023-01-01 25.1 - 7 recovered 2022-12-30 2023-01-02 25.1 - 8 recovered 2022-12-30 2023-01-01 25.1 - 9 recovered 2022-12-29 2023-01-01 25.1 - 10 recovered 2022-12-30 2023-01-01 NA - 11 recovered 2022-12-30 2023-01-01 NA - 12 recovered 2022-12-30 2023-01-02 25.1 + id case_name case_type sex age date_onset date_admission outcome + 1 1 Lily Camacho confirmed f 20 2023-01-01 recovered + 2 2 Sad el-Irani suspected m 24 2023-01-01 recovered + 3 3 Tristan Benjamin suspected m 51 2023-01-01 2023-01-07 recovered + 4 5 Treven Cornejo probable m 16 2023-01-01 recovered + 5 6 Kevin Contreras suspected m 83 2023-01-01 recovered + 6 8 Tyler Garcia suspected m 48 2023-01-01 recovered + 7 11 Royse Beltran probable m 77 2023-01-01 2023-01-01 recovered + 8 12 Clayton Falcon confirmed m 90 2023-01-01 recovered + 9 13 Halle Batchelder confirmed f 66 2023-01-01 recovered + 10 18 Morgan Grant-Perry confirmed f 31 2023-01-02 2023-01-02 recovered + 11 20 Bowen Apodaca confirmed m 46 2023-01-02 recovered + 12 22 Haaroon el-Firman confirmed m 75 2023-01-02 recovered + date_outcome date_first_contact date_last_contact ct_value + 1 24.7 + 2 2022-12-30 2023-01-01 NA + 3 2022-12-31 2023-01-02 NA + 4 2022-12-30 2023-01-02 NA + 5 2022-12-31 2023-01-01 NA + 6 2022-12-31 2023-01-01 NA + 7 2022-12-30 2023-01-02 NA + 8 2022-12-30 2023-01-01 24.7 + 9 2022-12-29 2023-01-01 24.7 + 10 2022-12-30 2023-01-01 24.7 + 11 2022-12-30 2023-01-01 24.7 + 12 2022-12-30 2023-01-02 24.7 # sim_linelist works as expected with modified config parameters @@ -244,30 +244,100 @@ prob_infect = 0.5, onset_to_hosp = onset_to_hosp, onset_to_death = onset_to_death, config = create_config(last_contact_distribution_params = c(lambda = 5))) Output - id case_name case_type sex age date_onset date_admission - 1 1 Damion Hamm confirmed m 35 2023-01-01 - 2 2 Ignacio Hernandez confirmed m 43 2023-01-01 - 3 3 Bryce Donnelly confirmed m 1 2023-01-01 - 4 5 David Arrieta confirmed m 78 2023-01-01 - 5 6 Kristina Vazquez Pallares confirmed f 22 2023-01-01 - 6 8 Nusaiba el-Farah suspected f 28 2023-01-01 - 7 11 Dominic Kills In Sight probable m 46 2023-01-01 2023-01-13 - 8 12 Violet Watts confirmed f 67 2023-01-01 - 9 13 Khristopher Cunniff confirmed m 86 2023-01-01 2023-01-01 - 10 18 Paige Reich probable f 60 2023-01-02 - 11 20 Jackson Carlson confirmed m 49 2023-01-02 - 12 22 Cassandra Smith suspected f 7 2023-01-02 2023-01-02 + id case_name case_type sex age date_onset date_admission + 1 1 Dominic Sundara probable m 35 2023-01-01 + 2 2 Preston Montgomery suspected m 43 2023-01-01 + 3 3 Reece Chittum probable m 1 2023-01-01 + 4 5 Michael Cheek confirmed m 78 2023-01-01 + 5 6 Jennifer Smith confirmed f 22 2023-01-01 + 6 8 Erika Quintero confirmed f 28 2023-01-01 + 7 11 Isaiah Patterson suspected m 46 2023-01-01 2023-01-13 + 8 12 Cicely Anderson suspected f 67 2023-01-01 + 9 13 Michael John probable m 86 2023-01-01 2023-01-01 + 10 18 Giovana Magana Aguirre suspected f 60 2023-01-02 + 11 20 Mudrik al-Hallal suspected m 49 2023-01-02 + 12 22 Tea Slaughter probable f 7 2023-01-02 2023-01-02 outcome date_outcome date_first_contact date_last_contact ct_value - 1 recovered 25.6 - 2 recovered 2023-01-01 2023-01-07 25.6 - 3 recovered 2022-12-31 2023-01-03 25.6 - 4 recovered 2022-12-31 2023-01-04 25.6 - 5 recovered 2023-01-02 2023-01-04 25.6 - 6 recovered 2023-01-06 2023-01-07 NA + 1 recovered NA + 2 recovered 2023-01-01 2023-01-07 NA + 3 recovered 2022-12-31 2023-01-03 NA + 4 recovered 2022-12-31 2023-01-04 23.1 + 5 recovered 2023-01-02 2023-01-04 23.1 + 6 recovered 2023-01-06 2023-01-07 23.1 7 recovered 2023-01-07 2023-01-08 NA - 8 recovered 2023-01-03 2023-01-06 25.6 - 9 recovered 2023-01-02 2023-01-05 25.6 + 8 recovered 2023-01-03 2023-01-06 NA + 9 died 2023-01-12 2023-01-02 2023-01-05 NA 10 recovered 2023-01-01 2023-01-05 NA - 11 recovered 2023-01-04 2023-01-07 25.6 - 12 died 2023-01-16 2023-01-03 2023-01-05 NA + 11 recovered 2023-01-04 2023-01-07 NA + 12 recovered 2023-01-03 2023-01-05 NA + +# sim_linelist works as expected with time-varying cfr + + Code + sim_linelist(contact_distribution = contact_distribution, infect_period = infect_period, + prob_infect = 0.5, onset_to_hosp = onset_to_hosp, onset_to_death = onset_to_death, + config = create_config(time_varying_death_risk = function(risk, time) risk * + exp(-time))) + Output + id case_name case_type sex age date_onset date_admission outcome + 1 1 Anthony Raigoza suspected m 35 2023-01-01 recovered + 2 2 Joseph Begay probable m 43 2023-01-01 recovered + 3 3 Andi Lee probable m 1 2023-01-01 recovered + 4 5 Robert Duran suspected m 78 2023-01-01 recovered + 5 6 Mikhaila Guyon confirmed f 22 2023-01-01 recovered + 6 8 Kanani Ahn confirmed f 28 2023-01-01 recovered + 7 11 Michael Chittum probable m 46 2023-01-01 2023-01-13 recovered + 8 12 Hope Cobb probable f 67 2023-01-01 recovered + 9 13 Eric Lopez confirmed m 86 2023-01-01 2023-01-01 recovered + 10 18 Kelly Carter probable f 60 2023-01-02 recovered + 11 20 Turki el-Vaziri probable m 49 2023-01-02 recovered + 12 22 Cicely Shangreaux confirmed f 7 2023-01-02 2023-01-02 recovered + date_outcome date_first_contact date_last_contact ct_value + 1 NA + 2 2022-12-30 2023-01-05 NA + 3 2022-12-30 2023-01-02 NA + 4 2022-12-29 2023-01-02 NA + 5 2023-01-01 2023-01-03 25.4 + 6 2023-01-03 2023-01-04 25.4 + 7 2023-01-04 2023-01-05 NA + 8 2023-01-01 2023-01-04 NA + 9 2022-12-31 2023-01-03 25.4 + 10 2022-12-30 2023-01-03 NA + 11 2023-01-01 2023-01-04 NA + 12 2023-01-01 2023-01-03 25.4 + +# sim_linelist works as expected with time-varying cfr & age-strat + + Code + sim_linelist(contact_distribution = contact_distribution, infect_period = infect_period, + prob_infect = 0.5, onset_to_hosp = onset_to_hosp, onset_to_death = onset_to_death, + hosp_death_risk = age_dep_hosp_death_risk, config = create_config( + time_varying_death_risk = function(risk, time) risk * exp(-time))) + Output + id case_name case_type sex age date_onset date_admission outcome + 1 1 Anthony Raigoza suspected m 35 2023-01-01 recovered + 2 2 Joseph Begay probable m 43 2023-01-01 recovered + 3 3 Andi Lee probable m 1 2023-01-01 recovered + 4 5 Robert Duran suspected m 78 2023-01-01 recovered + 5 6 Mikhaila Guyon confirmed f 22 2023-01-01 recovered + 6 8 Kanani Ahn confirmed f 28 2023-01-01 recovered + 7 11 Michael Chittum probable m 46 2023-01-01 2023-01-13 recovered + 8 12 Hope Cobb probable f 67 2023-01-01 recovered + 9 13 Eric Lopez confirmed m 86 2023-01-01 2023-01-01 recovered + 10 18 Kelly Carter probable f 60 2023-01-02 recovered + 11 20 Turki el-Vaziri probable m 49 2023-01-02 recovered + 12 22 Cicely Shangreaux confirmed f 7 2023-01-02 2023-01-02 recovered + date_outcome date_first_contact date_last_contact ct_value + 1 NA + 2 2022-12-30 2023-01-05 NA + 3 2022-12-30 2023-01-02 NA + 4 2022-12-29 2023-01-02 NA + 5 2023-01-01 2023-01-03 25.4 + 6 2023-01-03 2023-01-04 25.4 + 7 2023-01-04 2023-01-05 NA + 8 2023-01-01 2023-01-04 NA + 9 2022-12-31 2023-01-03 25.4 + 10 2022-12-30 2023-01-03 NA + 11 2023-01-01 2023-01-04 NA + 12 2023-01-01 2023-01-03 25.4 diff --git a/tests/testthat/_snaps/sim_outbreak.md b/tests/testthat/_snaps/sim_outbreak.md index 73a8984f..a02f8b01 100644 --- a/tests/testthat/_snaps/sim_outbreak.md +++ b/tests/testthat/_snaps/sim_outbreak.md @@ -5,78 +5,78 @@ prob_infect = 0.5, onset_to_hosp = onset_to_hosp, onset_to_death = onset_to_death) Output $linelist - id case_name case_type sex age date_onset date_admission - 1 1 Damion Hamm confirmed m 35 2023-01-01 - 2 2 Ignacio Hernandez confirmed m 43 2023-01-01 - 3 3 Bryce Donnelly confirmed m 1 2023-01-01 - 4 5 David Arrieta confirmed m 78 2023-01-01 - 5 6 Kristina Vazquez Pallares confirmed f 22 2023-01-01 - 6 8 Nusaiba el-Farah suspected f 28 2023-01-01 - 7 11 Dominic Kills In Sight probable m 46 2023-01-01 2023-01-13 - 8 12 Violet Watts confirmed f 67 2023-01-01 - 9 13 Khristopher Cunniff confirmed m 86 2023-01-01 2023-01-01 - 10 18 Paige Reich probable f 60 2023-01-02 - 11 20 Jackson Carlson confirmed m 49 2023-01-02 - 12 22 Cassandra Smith suspected f 7 2023-01-02 2023-01-02 + id case_name case_type sex age date_onset date_admission + 1 1 Dominic Sundara probable m 35 2023-01-01 + 2 2 Preston Montgomery suspected m 43 2023-01-01 + 3 3 Reece Chittum probable m 1 2023-01-01 + 4 5 Michael Cheek confirmed m 78 2023-01-01 + 5 6 Jennifer Smith confirmed f 22 2023-01-01 + 6 8 Erika Quintero confirmed f 28 2023-01-01 + 7 11 Isaiah Patterson suspected m 46 2023-01-01 2023-01-13 + 8 12 Cicely Anderson suspected f 67 2023-01-01 + 9 13 Michael John probable m 86 2023-01-01 2023-01-01 + 10 18 Giovana Magana Aguirre suspected f 60 2023-01-02 + 11 20 Mudrik al-Hallal suspected m 49 2023-01-02 + 12 22 Tea Slaughter probable f 7 2023-01-02 2023-01-02 outcome date_outcome date_first_contact date_last_contact ct_value - 1 recovered 25.6 - 2 recovered 2022-12-30 2023-01-05 25.6 - 3 recovered 2022-12-30 2023-01-02 25.6 - 4 recovered 2022-12-29 2023-01-02 25.6 - 5 recovered 2023-01-01 2023-01-03 25.6 - 6 recovered 2023-01-03 2023-01-04 NA + 1 recovered NA + 2 recovered 2022-12-30 2023-01-05 NA + 3 recovered 2022-12-30 2023-01-02 NA + 4 recovered 2022-12-29 2023-01-02 23.1 + 5 recovered 2023-01-01 2023-01-03 23.1 + 6 recovered 2023-01-03 2023-01-04 23.1 7 recovered 2023-01-04 2023-01-05 NA - 8 recovered 2023-01-01 2023-01-04 25.6 - 9 recovered 2022-12-31 2023-01-03 25.6 + 8 recovered 2023-01-01 2023-01-04 NA + 9 died 2023-01-12 2022-12-31 2023-01-03 NA 10 recovered 2022-12-30 2023-01-03 NA - 11 recovered 2023-01-01 2023-01-04 25.6 - 12 died 2023-01-16 2023-01-01 2023-01-03 NA + 11 recovered 2023-01-01 2023-01-04 NA + 12 recovered 2023-01-01 2023-01-03 NA $contacts - from to age sex - 1 Damion Hamm Ignacio Hernandez 43 m - 2 Damion Hamm Bryce Donnelly 1 m - 3 Ignacio Hernandez Ashlan Krause 29 f - 4 Ignacio Hernandez David Arrieta 78 m - 5 Bryce Donnelly Kristina Vazquez Pallares 22 f - 6 Bryce Donnelly Morgan Vermillion 70 m - 7 Bryce Donnelly Nusaiba el-Farah 28 f - 8 David Arrieta Ryanna Hart 37 f - 9 Kristina Vazquez Pallares Shan Klutke 61 f - 10 Nusaiba el-Farah Dominic Kills In Sight 46 m - 11 Nusaiba el-Farah Violet Watts 67 f - 12 Nusaiba el-Farah Khristopher Cunniff 86 m - 13 Dominic Kills In Sight Tyler Kelley 71 m - 14 Dominic Kills In Sight Janayva Allen 51 f - 15 Dominic Kills In Sight Sheldon Martinez 44 m - 16 Violet Watts Lien Saldanha 49 f - 17 Khristopher Cunniff Paige Reich 60 f - 18 Khristopher Cunniff Brianna Pollard 56 f - 19 Khristopher Cunniff Jackson Carlson 49 m - 20 Khristopher Cunniff Raynaldo Santistevan 50 m - 21 Paige Reich Cassandra Smith 7 f - date_first_contact date_last_contact was_case status - 1 2022-12-30 2023-01-05 Y case - 2 2022-12-30 2023-01-02 Y case - 3 2022-12-27 2023-01-03 N under_followup - 4 2022-12-29 2023-01-02 Y case - 5 2023-01-01 2023-01-03 Y case - 6 2022-12-30 2023-01-02 N under_followup - 7 2023-01-03 2023-01-04 Y case - 8 2023-01-06 2023-01-06 N lost_to_followup - 9 2023-01-01 2023-01-05 N under_followup - 10 2023-01-04 2023-01-05 Y case - 11 2023-01-01 2023-01-04 Y case - 12 2022-12-31 2023-01-03 Y case - 13 2022-12-28 2023-01-05 N under_followup - 14 2023-01-01 2023-01-04 N under_followup - 15 2023-01-02 2023-01-05 N lost_to_followup - 16 2023-01-02 2023-01-03 N under_followup - 17 2022-12-30 2023-01-03 Y case - 18 2023-01-06 2023-01-09 N lost_to_followup - 19 2023-01-01 2023-01-04 Y case - 20 2023-01-01 2023-01-03 N unknown - 21 2023-01-01 2023-01-03 Y case + from to age sex date_first_contact + 1 Dominic Sundara Preston Montgomery 43 m 2022-12-30 + 2 Dominic Sundara Reece Chittum 1 m 2022-12-30 + 3 Preston Montgomery Kayla Hill 29 f 2022-12-27 + 4 Preston Montgomery Michael Cheek 78 m 2022-12-29 + 5 Reece Chittum Jennifer Smith 22 f 2023-01-01 + 6 Reece Chittum Jaylyn Childs 70 m 2022-12-30 + 7 Reece Chittum Erika Quintero 28 f 2023-01-03 + 8 Michael Cheek Kelly Fitzsimmons 37 f 2023-01-06 + 9 Jennifer Smith Audreon Starkey 61 f 2023-01-01 + 10 Erika Quintero Isaiah Patterson 46 m 2023-01-04 + 11 Erika Quintero Cicely Anderson 67 f 2023-01-01 + 12 Erika Quintero Michael John 86 m 2022-12-31 + 13 Isaiah Patterson Muneeb al-Jamil 71 m 2022-12-28 + 14 Isaiah Patterson Juwairiya el-Abdelrahman 51 f 2023-01-01 + 15 Isaiah Patterson Bishr al-Youssef 44 m 2023-01-02 + 16 Cicely Anderson Samantha Gonzalez 49 f 2023-01-02 + 17 Michael John Giovana Magana Aguirre 60 f 2022-12-30 + 18 Michael John Michiyo Batara 56 f 2023-01-06 + 19 Michael John Mudrik al-Hallal 49 m 2023-01-01 + 20 Michael John Dominic Gonzales 50 m 2023-01-01 + 21 Giovana Magana Aguirre Tea Slaughter 7 f 2023-01-01 + date_last_contact was_case status + 1 2023-01-05 Y case + 2 2023-01-02 Y case + 3 2023-01-03 N under_followup + 4 2023-01-02 Y case + 5 2023-01-03 Y case + 6 2023-01-02 N under_followup + 7 2023-01-04 Y case + 8 2023-01-06 N under_followup + 9 2023-01-05 N under_followup + 10 2023-01-05 Y case + 11 2023-01-04 Y case + 12 2023-01-03 Y case + 13 2023-01-05 N under_followup + 14 2023-01-04 N under_followup + 15 2023-01-05 N under_followup + 16 2023-01-03 N under_followup + 17 2023-01-03 Y case + 18 2023-01-09 N unknown + 19 2023-01-04 Y case + 20 2023-01-03 N under_followup + 21 2023-01-03 Y case # sim_outbreak works as expected with add_names = FALSE @@ -89,76 +89,76 @@ $linelist id case_type sex age date_onset date_admission outcome date_outcome 1 1 confirmed m 35 2023-01-01 recovered - 2 2 confirmed m 43 2023-01-01 recovered - 3 3 confirmed m 1 2023-01-01 recovered + 2 2 suspected m 43 2023-01-01 recovered + 3 3 probable m 1 2023-01-01 recovered 4 5 confirmed m 78 2023-01-01 recovered - 5 6 suspected f 22 2023-01-01 recovered - 6 8 probable f 28 2023-01-01 recovered + 5 6 confirmed f 22 2023-01-01 recovered + 6 8 confirmed f 28 2023-01-01 recovered 7 11 confirmed m 46 2023-01-01 2023-01-13 recovered - 8 12 confirmed f 67 2023-01-01 recovered - 9 13 probable m 86 2023-01-01 2023-01-01 recovered - 10 18 probable f 60 2023-01-02 recovered + 8 12 suspected f 67 2023-01-01 recovered + 9 13 confirmed m 86 2023-01-01 2023-01-01 died 2023-01-12 + 10 18 suspected f 60 2023-01-02 recovered 11 20 confirmed m 49 2023-01-02 recovered - 12 22 confirmed f 7 2023-01-02 2023-01-02 died 2023-01-16 + 12 22 confirmed f 7 2023-01-02 2023-01-02 recovered date_first_contact date_last_contact ct_value - 1 25.7 - 2 2022-12-30 2023-01-05 25.7 - 3 2022-12-30 2023-01-02 25.7 - 4 2022-12-29 2023-01-02 25.7 - 5 2023-01-01 2023-01-03 NA - 6 2023-01-03 2023-01-04 NA - 7 2023-01-04 2023-01-05 25.7 - 8 2023-01-01 2023-01-04 25.7 - 9 2022-12-31 2023-01-03 NA + 1 23.9 + 2 2022-12-30 2023-01-05 NA + 3 2022-12-30 2023-01-02 NA + 4 2022-12-29 2023-01-02 23.9 + 5 2023-01-01 2023-01-03 23.9 + 6 2023-01-03 2023-01-04 23.9 + 7 2023-01-04 2023-01-05 23.9 + 8 2023-01-01 2023-01-04 NA + 9 2022-12-31 2023-01-03 23.9 10 2022-12-30 2023-01-03 NA - 11 2023-01-01 2023-01-04 25.7 - 12 2023-01-01 2023-01-03 25.7 + 11 2023-01-01 2023-01-04 23.9 + 12 2023-01-01 2023-01-03 23.9 $contacts - from to age sex date_first_contact - 1 John Sheldon Abdul Maalik al-Sarwar 43 m 2022-12-30 - 2 John Sheldon Jeffrey Le 1 m 2022-12-30 - 3 Abdul Maalik al-Sarwar Taylor Graves 29 f 2022-12-27 - 4 Abdul Maalik al-Sarwar Grayson Black 78 m 2022-12-29 - 5 Jeffrey Le Carolyn Moore 22 f 2023-01-01 - 6 Jeffrey Le Tyler Kelley 70 m 2022-12-30 - 7 Jeffrey Le Cheyenne Sayavong 28 f 2023-01-03 - 8 Grayson Black Mercedes Lovelace 37 f 2023-01-06 - 9 Carolyn Moore Chantelle Vazquez-Luevano 61 f 2023-01-01 - 10 Cheyenne Sayavong Jackson Carlson 46 m 2023-01-04 - 11 Cheyenne Sayavong Kendra To 67 f 2023-01-01 - 12 Cheyenne Sayavong Rushdi al-Bahri 86 m 2022-12-31 - 13 Jackson Carlson Bassaam el-Laham 71 m 2022-12-28 - 14 Jackson Carlson Megan Hayes 51 f 2023-01-01 - 15 Jackson Carlson John Khanthavong 44 m 2023-01-02 - 16 Kendra To Amanda Larochelle 49 f 2023-01-02 - 17 Rushdi al-Bahri Dominique Raymond 60 f 2022-12-30 - 18 Rushdi al-Bahri Natalie Newton 56 f 2023-01-06 - 19 Rushdi al-Bahri Qaaid al-Chahine 49 m 2023-01-01 - 20 Rushdi al-Bahri Abdul Kader el-Jabour 50 m 2023-01-01 - 21 Dominique Raymond Susana Varela 7 f 2023-01-01 - date_last_contact was_case status - 1 2023-01-05 Y case - 2 2023-01-02 Y case - 3 2023-01-03 N under_followup - 4 2023-01-02 Y case - 5 2023-01-03 Y case - 6 2023-01-02 N under_followup - 7 2023-01-04 Y case - 8 2023-01-06 N unknown - 9 2023-01-05 N lost_to_followup - 10 2023-01-05 Y case - 11 2023-01-04 Y case - 12 2023-01-03 Y case - 13 2023-01-05 N under_followup - 14 2023-01-04 N under_followup - 15 2023-01-05 N under_followup - 16 2023-01-03 N lost_to_followup - 17 2023-01-03 Y case - 18 2023-01-09 N under_followup - 19 2023-01-04 Y case - 20 2023-01-03 N under_followup - 21 2023-01-03 Y case + from to age sex date_first_contact + 1 Jonah Hord Benjamin Flowers 43 m 2022-12-30 + 2 Jonah Hord Rito Cooper 1 m 2022-12-30 + 3 Benjamin Flowers Claire Hicks 29 f 2022-12-27 + 4 Benjamin Flowers Jeremy Loughridge 78 m 2022-12-29 + 5 Rito Cooper Ashwini Ali 22 f 2023-01-01 + 6 Rito Cooper Rory Jumbo 70 m 2022-12-30 + 7 Rito Cooper Danielle Kuhn 28 f 2023-01-03 + 8 Jeremy Loughridge Gicell Cisneros 37 f 2023-01-06 + 9 Ashwini Ali Lauren Nguyen 61 f 2023-01-01 + 10 Danielle Kuhn Thaamir al-Amini 46 m 2023-01-04 + 11 Danielle Kuhn Selena Chun 67 f 2023-01-01 + 12 Danielle Kuhn Charles Stuart Rasi 86 m 2022-12-31 + 13 Thaamir al-Amini Jose Hurtado 71 m 2022-12-28 + 14 Thaamir al-Amini Brianne Shahid 51 f 2023-01-01 + 15 Thaamir al-Amini Efren Armijo 44 m 2023-01-02 + 16 Selena Chun Juanita Martinez 49 f 2023-01-02 + 17 Charles Stuart Rasi Hannah Bodnar 60 f 2022-12-30 + 18 Charles Stuart Rasi Kifaaya el-Ameen 56 f 2023-01-06 + 19 Charles Stuart Rasi Enrique Ponce 49 m 2023-01-01 + 20 Charles Stuart Rasi Jaarallah al-Masood 50 m 2023-01-01 + 21 Hannah Bodnar Ashley Isaac 7 f 2023-01-01 + date_last_contact was_case status + 1 2023-01-05 Y case + 2 2023-01-02 Y case + 3 2023-01-03 N under_followup + 4 2023-01-02 Y case + 5 2023-01-03 Y case + 6 2023-01-02 N under_followup + 7 2023-01-04 Y case + 8 2023-01-06 N under_followup + 9 2023-01-05 N under_followup + 10 2023-01-05 Y case + 11 2023-01-04 Y case + 12 2023-01-03 Y case + 13 2023-01-05 N unknown + 14 2023-01-04 N under_followup + 15 2023-01-05 N under_followup + 16 2023-01-03 N under_followup + 17 2023-01-03 Y case + 18 2023-01-09 N under_followup + 19 2023-01-04 Y case + 20 2023-01-03 N unknown + 21 2023-01-03 Y case # sim_outbreak works as expected with age-strat risks @@ -170,78 +170,78 @@ non_hosp_death_risk = age_dep_non_hosp_death_risk) Output $linelist - id case_name case_type sex age date_onset date_admission - 1 1 David Garcia Mayen probable m 35 2023-01-01 - 2 2 Rory Kills In Sight confirmed m 43 2023-01-01 - 3 3 Sheldon Martinez confirmed m 1 2023-01-01 2023-01-11 - 4 5 Bryce Cunniff probable m 78 2023-01-01 - 5 6 Lien Whitworth confirmed f 22 2023-01-01 - 6 8 Tiffany Weiss suspected f 28 2023-01-01 - 7 11 Cleatus Kacprowicz probable m 46 2023-01-01 - 8 12 Taylor Moore confirmed f 67 2023-01-01 - 9 13 Tyler Carlson confirmed m 86 2023-01-01 2023-01-01 - 10 18 Grayson Lovelace confirmed f 60 2023-01-02 - 11 20 Abdul Maalik al-Ishak suspected m 49 2023-01-02 2023-01-09 - 12 22 Kendra Newton confirmed f 7 2023-01-02 - outcome date_outcome date_first_contact date_last_contact ct_value - 1 recovered NA - 2 recovered 2022-12-30 2023-01-05 25 - 3 recovered 2022-12-30 2023-01-02 25 - 4 recovered 2022-12-29 2023-01-02 NA - 5 recovered 2023-01-01 2023-01-03 25 - 6 recovered 2023-01-03 2023-01-04 NA - 7 recovered 2023-01-04 2023-01-05 NA - 8 recovered 2023-01-01 2023-01-04 25 - 9 recovered 2022-12-31 2023-01-03 25 - 10 recovered 2022-12-30 2023-01-03 25 - 11 recovered 2023-01-01 2023-01-04 NA - 12 recovered 2023-01-01 2023-01-03 25 + id case_name case_type sex age date_onset date_admission outcome + 1 1 Cass Duran probable m 35 2023-01-01 recovered + 2 2 Mudrik al-Hallal suspected m 43 2023-01-01 recovered + 3 3 Jareer al-Safar probable m 1 2023-01-01 2023-01-11 recovered + 4 5 Raashid el-Huda confirmed m 78 2023-01-01 recovered + 5 6 Erika Sierra confirmed f 22 2023-01-01 recovered + 6 8 Jennifer Hong confirmed f 28 2023-01-01 recovered + 7 11 Donald Childs suspected m 46 2023-01-01 recovered + 8 12 Kayla Johnson suspected f 67 2023-01-01 died + 9 13 Avery Johnston probable m 86 2023-01-01 2023-01-01 recovered + 10 18 Giovana Segarra suspected f 60 2023-01-02 recovered + 11 20 Donald Root suspected m 49 2023-01-02 2023-01-09 recovered + 12 22 Kiona Dalke probable f 7 2023-01-02 recovered + date_outcome date_first_contact date_last_contact ct_value + 1 NA + 2 2022-12-30 2023-01-05 NA + 3 2022-12-30 2023-01-02 NA + 4 2022-12-29 2023-01-02 23.1 + 5 2023-01-01 2023-01-03 23.1 + 6 2023-01-03 2023-01-04 23.1 + 7 2023-01-04 2023-01-05 NA + 8 2023-01-14 2023-01-01 2023-01-04 NA + 9 2022-12-31 2023-01-03 NA + 10 2022-12-30 2023-01-03 NA + 11 2023-01-01 2023-01-04 NA + 12 2023-01-01 2023-01-03 NA $contacts - from to age sex date_first_contact - 1 David Garcia Mayen Rory Kills In Sight 43 m 2022-12-30 - 2 David Garcia Mayen Sheldon Martinez 1 m 2022-12-30 - 3 Rory Kills In Sight Violet Harrison 29 f 2022-12-27 - 4 Rory Kills In Sight Bryce Cunniff 78 m 2022-12-29 - 5 Sheldon Martinez Lien Whitworth 22 f 2023-01-01 - 6 Sheldon Martinez Khristopher Kelley 70 m 2022-12-30 - 7 Sheldon Martinez Tiffany Weiss 28 f 2023-01-03 - 8 Bryce Cunniff Caroline Hergenreter 37 f 2023-01-06 - 9 Lien Whitworth Cassandra Sayavong 61 f 2023-01-01 - 10 Tiffany Weiss Cleatus Kacprowicz 46 m 2023-01-04 - 11 Tiffany Weiss Taylor Moore 67 f 2023-01-01 - 12 Tiffany Weiss Tyler Carlson 86 m 2022-12-31 - 13 Cleatus Kacprowicz Raynaldo Abeyta 71 m 2022-12-28 - 14 Cleatus Kacprowicz Carolyn Raymond 51 f 2023-01-01 - 15 Cleatus Kacprowicz Jelani Sheldon 44 m 2023-01-02 - 16 Taylor Moore Harleigh To 49 f 2023-01-02 - 17 Tyler Carlson Grayson Lovelace 60 f 2022-12-30 - 18 Tyler Carlson Angel Vazquez-Luevano 56 f 2023-01-06 - 19 Tyler Carlson Abdul Maalik al-Ishak 49 m 2023-01-01 - 20 Tyler Carlson Joewid Le 50 m 2023-01-01 - 21 Grayson Lovelace Kendra Newton 7 f 2023-01-01 - date_last_contact was_case status - 1 2023-01-05 Y case - 2 2023-01-02 Y case - 3 2023-01-03 N lost_to_followup - 4 2023-01-02 Y case - 5 2023-01-03 Y case - 6 2023-01-02 N under_followup - 7 2023-01-04 Y case - 8 2023-01-06 N lost_to_followup - 9 2023-01-05 N unknown - 10 2023-01-05 Y case - 11 2023-01-04 Y case - 12 2023-01-03 Y case - 13 2023-01-05 N under_followup - 14 2023-01-04 N under_followup - 15 2023-01-05 N under_followup - 16 2023-01-03 N under_followup - 17 2023-01-03 Y case - 18 2023-01-09 N lost_to_followup - 19 2023-01-04 Y case - 20 2023-01-03 N under_followup - 21 2023-01-03 Y case + from to age sex date_first_contact + 1 Cass Duran Mudrik al-Hallal 43 m 2022-12-30 + 2 Cass Duran Jareer al-Safar 1 m 2022-12-30 + 3 Mudrik al-Hallal Kaitlynne Rieger 29 f 2022-12-27 + 4 Mudrik al-Hallal Raashid el-Huda 78 m 2022-12-29 + 5 Jareer al-Safar Erika Sierra 22 f 2023-01-01 + 6 Jareer al-Safar Preston Huerta 70 m 2022-12-30 + 7 Jareer al-Safar Jennifer Hong 28 f 2023-01-03 + 8 Raashid el-Huda Kaitlin Gonzalez 37 f 2023-01-06 + 9 Erika Sierra Marissa Slaughter 61 f 2023-01-01 + 10 Jennifer Hong Donald Childs 46 m 2023-01-04 + 11 Jennifer Hong Kayla Johnson 67 f 2023-01-01 + 12 Jennifer Hong Avery Johnston 86 m 2022-12-31 + 13 Donald Childs Lorenzo Gaynor 71 m 2022-12-28 + 14 Donald Childs Michiyo Tran 51 f 2023-01-01 + 15 Donald Childs Ethan Black 44 m 2023-01-02 + 16 Kayla Johnson Marzooqa el-Abdelrahman 49 f 2023-01-02 + 17 Avery Johnston Giovana Segarra 60 f 2022-12-30 + 18 Avery Johnston Kaylie Shangreaux 56 f 2023-01-06 + 19 Avery Johnston Donald Root 49 m 2023-01-01 + 20 Avery Johnston Hunter Simmons 50 m 2023-01-01 + 21 Giovana Segarra Kiona Dalke 7 f 2023-01-01 + date_last_contact was_case status + 1 2023-01-05 Y case + 2 2023-01-02 Y case + 3 2023-01-03 N under_followup + 4 2023-01-02 Y case + 5 2023-01-03 Y case + 6 2023-01-02 N under_followup + 7 2023-01-04 Y case + 8 2023-01-06 N under_followup + 9 2023-01-05 N under_followup + 10 2023-01-05 Y case + 11 2023-01-04 Y case + 12 2023-01-03 Y case + 13 2023-01-05 N under_followup + 14 2023-01-04 N under_followup + 15 2023-01-05 N under_followup + 16 2023-01-03 N under_followup + 17 2023-01-03 Y case + 18 2023-01-09 N unknown + 19 2023-01-04 Y case + 20 2023-01-03 N under_followup + 21 2023-01-03 Y case # sim_outbreak works as expected with age structure @@ -252,56 +252,56 @@ population_age = age_struct) Output $linelist - id case_name case_type sex age date_onset date_admission outcome - 1 1 Mark Beard confirmed m 44 2023-01-01 recovered - 2 2 Brian Mccracken confirmed m 13 2023-01-01 recovered - 3 3 Jesus Garduno confirmed m 22 2023-01-01 2023-01-09 died - 4 5 Taalib al-Naqvi confirmed m 85 2023-01-01 recovered - 5 6 Kelly Geist confirmed f 41 2023-01-01 recovered - 6 8 Madison Krause suspected f 89 2023-01-01 2023-01-02 recovered - 7 11 Jonathon Lujano probable m 69 2023-01-01 recovered - 8 12 Ashlan Allen confirmed f 23 2023-01-01 recovered - 9 13 Dhaahir el-Hariri confirmed m 9 2023-01-01 recovered - 10 18 Korren Hart probable f 62 2023-01-02 recovered - 11 20 Isaac Huff confirmed m 52 2023-01-02 2023-01-15 recovered - 12 22 Ryanna Watts suspected f 76 2023-01-02 recovered + id case_name case_type sex age date_onset date_admission outcome + 1 1 Kyle Crane suspected m 44 2023-01-01 recovered + 2 2 Ghaamid el-Ishmael confirmed m 13 2023-01-01 recovered + 3 3 Faatih el-Kaiser confirmed m 22 2023-01-01 2023-01-09 recovered + 4 5 Va'Aahi Galligan suspected m 85 2023-01-01 recovered + 5 6 Katelyn Catlin confirmed f 41 2023-01-01 recovered + 6 8 Lynsey Duron confirmed f 89 2023-01-01 2023-01-02 died + 7 11 Wajdi al-Demian confirmed m 69 2023-01-01 recovered + 8 12 Jacy Cousins confirmed f 23 2023-01-01 recovered + 9 13 Travis Foster confirmed m 9 2023-01-01 recovered + 10 18 Maria Eberhart probable f 62 2023-01-02 recovered + 11 20 Mubarak el-Vaziri suspected m 52 2023-01-02 2023-01-15 recovered + 12 22 Erin Payson confirmed f 76 2023-01-02 recovered date_outcome date_first_contact date_last_contact ct_value - 1 25.6 - 2 2022-12-30 2023-01-05 25.6 - 3 2023-01-09 2022-12-30 2023-01-02 25.6 - 4 2022-12-29 2023-01-02 25.6 - 5 2023-01-01 2023-01-03 25.6 - 6 2023-01-03 2023-01-04 NA - 7 2023-01-04 2023-01-05 NA - 8 2023-01-01 2023-01-04 25.6 - 9 2022-12-31 2023-01-03 25.6 + 1 NA + 2 2022-12-30 2023-01-05 25.1 + 3 2022-12-30 2023-01-02 25.1 + 4 2022-12-29 2023-01-02 NA + 5 2023-01-01 2023-01-03 25.1 + 6 2023-01-26 2023-01-03 2023-01-04 25.1 + 7 2023-01-04 2023-01-05 25.1 + 8 2023-01-01 2023-01-04 25.1 + 9 2022-12-31 2023-01-03 25.1 10 2022-12-30 2023-01-03 NA - 11 2023-01-01 2023-01-04 25.6 - 12 2023-01-01 2023-01-03 NA + 11 2023-01-01 2023-01-04 NA + 12 2023-01-01 2023-01-03 25.1 $contacts - from to age sex date_first_contact - 1 Mark Beard Brian Mccracken 13 m 2022-12-30 - 2 Mark Beard Jesus Garduno 22 m 2022-12-30 - 3 Brian Mccracken Alivia Estrada 5 f 2022-12-27 - 4 Brian Mccracken Taalib al-Naqvi 85 m 2022-12-29 - 5 Jesus Garduno Kelly Geist 41 f 2023-01-01 - 6 Jesus Garduno Umar al-Basa 2 m 2022-12-30 - 7 Jesus Garduno Madison Krause 89 f 2023-01-03 - 8 Taalib al-Naqvi Mawhiba al-Bilal 86 f 2023-01-06 - 9 Kelly Geist Destiny Bailey 82 f 2023-01-01 - 10 Madison Krause Jonathon Lujano 69 m 2023-01-04 - 11 Madison Krause Ashlan Allen 23 f 2023-01-01 - 12 Madison Krause Dhaahir el-Hariri 9 m 2022-12-31 - 13 Jonathon Lujano Andres Garza 79 m 2022-12-28 - 14 Jonathon Lujano Nicole Wright 29 f 2023-01-01 - 15 Jonathon Lujano Raj Ament 4 m 2023-01-02 - 16 Ashlan Allen Turfa el-Farah 13 f 2023-01-02 - 17 Dhaahir el-Hariri Korren Hart 62 f 2022-12-30 - 18 Dhaahir el-Hariri Shan Klutke 24 f 2023-01-06 - 19 Dhaahir el-Hariri Isaac Huff 52 m 2023-01-01 - 20 Dhaahir el-Hariri Darienne Knost 74 m 2023-01-01 - 21 Korren Hart Ryanna Watts 76 f 2023-01-01 + from to age sex date_first_contact + 1 Kyle Crane Ghaamid el-Ishmael 13 m 2022-12-30 + 2 Kyle Crane Faatih el-Kaiser 22 m 2022-12-30 + 3 Ghaamid el-Ishmael Carisa Flores-Gonzalez 5 f 2022-12-27 + 4 Ghaamid el-Ishmael Va'Aahi Galligan 85 m 2022-12-29 + 5 Faatih el-Kaiser Katelyn Catlin 41 f 2023-01-01 + 6 Faatih el-Kaiser Aiman el-Riaz 2 m 2022-12-30 + 7 Faatih el-Kaiser Lynsey Duron 89 f 2023-01-03 + 8 Va'Aahi Galligan Amaani al-Gaber 86 f 2023-01-06 + 9 Katelyn Catlin Lilibeth Black 82 f 2023-01-01 + 10 Lynsey Duron Wajdi al-Demian 69 m 2023-01-04 + 11 Lynsey Duron Jacy Cousins 23 f 2023-01-01 + 12 Lynsey Duron Travis Foster 9 m 2022-12-31 + 13 Wajdi al-Demian Raymond Murray 79 m 2022-12-28 + 14 Wajdi al-Demian Marquaja Johnson 29 f 2023-01-01 + 15 Wajdi al-Demian Raaid el-Diab 4 m 2023-01-02 + 16 Jacy Cousins Kayla Tudor 13 f 2023-01-02 + 17 Travis Foster Maria Eberhart 62 f 2022-12-30 + 18 Travis Foster Katja Muetz 24 f 2023-01-06 + 19 Travis Foster Mubarak el-Vaziri 52 m 2023-01-01 + 20 Travis Foster Alexandre Guerrero 74 m 2023-01-01 + 21 Maria Eberhart Erin Payson 76 f 2023-01-01 date_last_contact was_case status 1 2023-01-05 Y case 2 2023-01-02 Y case @@ -310,19 +310,19 @@ 5 2023-01-03 Y case 6 2023-01-02 N under_followup 7 2023-01-04 Y case - 8 2023-01-06 N lost_to_followup - 9 2023-01-05 N under_followup + 8 2023-01-06 N under_followup + 9 2023-01-05 N unknown 10 2023-01-05 Y case 11 2023-01-04 Y case 12 2023-01-03 Y case 13 2023-01-05 N under_followup - 14 2023-01-04 N under_followup + 14 2023-01-04 N lost_to_followup 15 2023-01-05 N lost_to_followup 16 2023-01-03 N under_followup 17 2023-01-03 Y case 18 2023-01-09 N lost_to_followup 19 2023-01-04 Y case - 20 2023-01-03 N unknown + 20 2023-01-03 N under_followup 21 2023-01-03 Y case diff --git a/tests/testthat/test-add_cols.R b/tests/testthat/test-add_cols.R index c5d76efb..0d21dcf6 100644 --- a/tests/testthat/test-add_cols.R +++ b/tests/testthat/test-add_cols.R @@ -182,7 +182,8 @@ test_that(".add_outcome works as expected", { onset_to_death = onset_to_death, onset_to_recovery = onset_to_recovery, hosp_death_risk = 0.5, - non_hosp_death_risk = 0.5 + non_hosp_death_risk = 0.5, + config = create_config() ) expect_s3_class(linelist, class = "data.frame") expect_type(linelist$outcome, type = "character") @@ -201,7 +202,8 @@ test_that(".add_outcome works as expected with different parameter", { onset_to_death = onset_to_death, onset_to_recovery = onset_to_recovery, hosp_death_risk = 0.9, - non_hosp_death_risk = 0.1 + non_hosp_death_risk = 0.1, + config = create_config() ) expect_s3_class(linelist, class = "data.frame") expect_type(linelist$outcome, type = "character") @@ -230,7 +232,8 @@ test_that(".add_outcome works as expected with age-strat risks", { onset_to_death = onset_to_death, onset_to_recover = onset_to_recovery, hosp_death_risk = age_dep_hosp_death_risk, - non_hosp_death_risk = age_dep_non_hosp_death_risk + non_hosp_death_risk = age_dep_non_hosp_death_risk, + config = create_config() ) expect_s3_class(linelist, class = "data.frame") expect_type(linelist$outcome, type = "character") diff --git a/tests/testthat/test-checkers.R b/tests/testthat/test-checkers.R index cab951fb..b5297835 100644 --- a/tests/testthat/test-checkers.R +++ b/tests/testthat/test-checkers.R @@ -444,3 +444,45 @@ test_that(".cross_check_sim_input warns as expected", { ) ) }) + +test_that(".check_func_req_args works as expected", { + expect_silent(.check_func_req_args(func = function(x) x + 1, n_req_args = 1)) + expect_null(.check_func_req_args(func = function(x) x + 1, n_req_args = 1)) +}) + +test_that(".check_func_req_args works with more than 1 req args", { + fn <- function(x, y) x + y + expect_silent(.check_func_req_args(func = fn, n_req_args = 2)) + expect_null(.check_func_req_args(func = fn, n_req_args = 2)) +}) + +test_that(".check_func_req_args works with arg names", { + fn <- function(x) x + expect_silent(.check_func_req_args(func = fn, req_arg_names = "x")) + expect_null(.check_func_req_args(func = fn, req_arg_names = "x")) +}) + +test_that(".check_func_req_args fails as expected", { + expect_error( + .check_func_req_args( + func = function(x) x + 1, func_name = "anonymous func", n_req_args = 2 + ), + regexp = "(anonymous func supplied must have)*(2)*(argument)" + ) + expect_error( + .check_func_req_args( + func = function(x, y) x + y, func_name = "anonymous func", n_req_args = 1 + ), + regexp = "(anonymous func supplied must have)*(1)*(argument)" + ) +}) + +test_that(".check_func_req_args fails with arg names", { + fn <- function(x) x + expect_error( + .check_func_req_args( + func = fn, func_name = "anonymous func", req_arg_names = c("x", "y") + ), + regexp = "(anonymous func supplied must have)*(y)*(arguments)" + ) +}) diff --git a/tests/testthat/test-create_config.R b/tests/testthat/test-create_config.R index 6d82b971..2dc1e616 100644 --- a/tests/testthat/test-create_config.R +++ b/tests/testthat/test-create_config.R @@ -1,13 +1,14 @@ test_that("create_config works as expected with defaults", { config <- create_config() expect_type(config, type = "list") - expect_length(config, 7) + expect_length(config, 8) expect_named( config, c( "last_contact_distribution", "last_contact_distribution_params", "first_contact_distribution", "first_contact_distribution_params", - "ct_distribution", "ct_distribution_params", "network" + "ct_distribution", "ct_distribution_params", "network", + "time_varying_death_risk" ) ) }) @@ -15,13 +16,14 @@ test_that("create_config works as expected with defaults", { test_that("create_config works as expected modifying element", { config <- create_config(last_contact_distribution = "geom") expect_type(config, type = "list") - expect_length(config, 7) + expect_length(config, 8) expect_named( config, c( "last_contact_distribution", "last_contact_distribution_params", "first_contact_distribution", "first_contact_distribution_params", - "ct_distribution", "ct_distribution_params", "network" + "ct_distribution", "ct_distribution_params", "network", + "time_varying_death_risk" ) ) expect_identical(config$last_contact_distribution, "geom") @@ -35,13 +37,14 @@ test_that("create_config works as expected with spliced list", { ) ) expect_type(config, type = "list") - expect_length(config, 7) + expect_length(config, 8) expect_named( config, c( "last_contact_distribution", "last_contact_distribution_params", "first_contact_distribution", "first_contact_distribution_params", - "ct_distribution", "ct_distribution_params", "network" + "ct_distribution", "ct_distribution_params", "network", + "time_varying_death_risk" ) ) expect_identical(config$ct_distribution, "lnorm") @@ -55,13 +58,14 @@ test_that("create_config works as expected with spliced list", { ) ) expect_type(config, type = "list") - expect_length(config, 7) + expect_length(config, 8) expect_named( config, c( "last_contact_distribution", "last_contact_distribution_params", "first_contact_distribution", "first_contact_distribution_params", - "ct_distribution", "ct_distribution_params", "network" + "ct_distribution", "ct_distribution_params", "network", + "time_varying_death_risk" ) ) expect_identical(config$last_contact_distribution, "geom") diff --git a/tests/testthat/test-sim_linelist.R b/tests/testthat/test-sim_linelist.R index 7da1396f..717d94ed 100644 --- a/tests/testthat/test-sim_linelist.R +++ b/tests/testthat/test-sim_linelist.R @@ -363,6 +363,7 @@ test_that("sim_linelist fails when onset-to-event are given by risk is NA", { }) test_that("sim_linest date_admission column is NA when onset_to_hosp is NA", { + set.seed(1) ll <- suppressWarnings( sim_linelist( contact_distribution = contact_distribution, @@ -388,6 +389,7 @@ test_that("sim_linest date_admission column is NA when onset_to_hosp is NA", { }) test_that("sim_linest date_death column is NA when onset_to_death is NA", { + set.seed(1) ll <- suppressWarnings( sim_linelist( contact_distribution = contact_distribution, @@ -410,3 +412,69 @@ test_that("sim_linest date_death column is NA when onset_to_death is NA", { ) expect_true(all(is.na(ll$date_death))) }) + +test_that("sim_linelist works as expected with time-varying cfr", { + set.seed(1) + expect_snapshot( + sim_linelist( + contact_distribution = contact_distribution, + infect_period = infect_period, + prob_infect = 0.5, + onset_to_hosp = onset_to_hosp, + onset_to_death = onset_to_death, + config = create_config( + time_varying_death_risk = function(risk, time) risk * exp(-time) + ) + ) + ) +}) + +test_that("sim_linelist works as expected with time-varying cfr & age-strat", { + set.seed(1) + age_dep_hosp_death_risk <- data.frame( + age_limit = c(1, 5, 80), + risk = c(0.1, 0.05, 0.2) + ) + expect_snapshot( + sim_linelist( + contact_distribution = contact_distribution, + infect_period = infect_period, + prob_infect = 0.5, + onset_to_hosp = onset_to_hosp, + onset_to_death = onset_to_death, + hosp_death_risk = age_dep_hosp_death_risk, + config = create_config( + time_varying_death_risk = function(risk, time) risk * exp(-time) + ) + ) + ) +}) + +test_that("sim_linelist fails as expected with time-varying cfr", { + expect_error( + sim_linelist( + contact_distribution = contact_distribution, + infect_period = infect_period, + prob_infect = 0.5, + onset_to_hosp = onset_to_hosp, + onset_to_death = onset_to_death, + config = create_config( + time_varying_death_risk = function(x, y, z) x + y + x + ) + ), + regexp = "(Anonymous functions supplied must have)*(2)*(argument)" + ) + expect_error( + sim_linelist( + contact_distribution = contact_distribution, + infect_period = infect_period, + prob_infect = 0.5, + onset_to_hosp = onset_to_hosp, + onset_to_death = onset_to_death, + config = create_config( + time_varying_death_risk = function(risk, time) risk * exp(time) + ) + ), + regexp = "(Time-varying)*(risk outside)*(0)*(1)*(Check time-varying func)", + ) +}) diff --git a/vignettes/design-principles.Rmd b/vignettes/design-principles.Rmd index a8eeef22..f20fb54c 100644 --- a/vignettes/design-principles.Rmd +++ b/vignettes/design-principles.Rmd @@ -42,6 +42,8 @@ The simulation functions either return a `` or a `list` of ` + %\VignetteIndexEntry{Time-varying case fatality risk} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +::: {.alert .alert-info} +If you are unfamiliar with the {simulist} package or the `sim_linelist()` function [Get Started vignette](simulist.html) is a great place to start. +::: + +This vignette demonstrates how to simulate line list data using the time-varying case fatality risk and gives an overview of the methodological details. + +::: {.alert .alert-secondary} + +The {simulist} R package uses an individual-based branching process simulation to generate contacts and cases for line list and contact tracing data. The time-varying case fatality risk feature provides a way to incorporate aspects of epidemics where the risk of death may decrease through time, potentially due to improved medical treatment, vaccination or viral evolution. It is also possible to model increasing case fatality risk through time, or a stepwise risk function where the risk of death shifts between states. + +The time-varying case fatality risk implemented in this package is not meant to explicitly model these factors, but rather to give the user an option to more closely resemble fatality risk through the course of an epidemic, possibly because there is data on this, or just to simulate data that has these characteristics. + +See the [{epidemics} R package](https://epiverse-trace.github.io/epidemics/index.html) for a population-level epidemic simulation package with explicit interventions and vaccinations. + +::: + +Given that setting a time-varying case fatality risk is not needed for most use cases of the {simulist} R package, this feature uses the `config` argument in the `sim_*()` functions. Therefore, the time-varying case fatality risk can be set when calling `create_config()` (see below for details). + +```{r setup} +library(simulist) +library(epiparameter) +library(tidyr) +library(dplyr) +library(incidence2) +library(ggplot2) +``` + +First we will demonstrate the default setting of a constant case fatality risk throughout an epidemic. + +We load the required delay distributions using the {epiparameter} package, by either manually creating them (contact distribution and infectious period), or load them from the {epiparameter} library of epidemiological parameters (onset-to-hospitalisation and onset-to-death). + +```{r, read-delay-dists} +contact_distribution <- epidist( + disease = "COVID-19", + epi_dist = "contact distribution", + prob_distribution = "pois", + prob_distribution_params = c(mean = 2) +) + +infect_period <- epidist( + disease = "COVID-19", + epi_dist = "infectious period", + prob_distribution = "gamma", + prob_distribution_params = c(shape = 3, scale = 3) +) + +# get onset to hospital admission from {epiparameter} database +onset_to_hosp <- epidist_db( + disease = "COVID-19", + epi_dist = "onset to hospitalisation", + single_epidist = TRUE +) + +# get onset to death from {epiparameter} database +onset_to_death <- epidist_db( + disease = "COVID-19", + epi_dist = "onset to death", + single_epidist = TRUE +) +``` + +We set the seed to ensure we have the same output each time the vignette is rendered. When using {simulist}, setting the seed is not required unless you need to simulate the same line list multiple times. + +```{r, set-seed} +set.seed(1) +``` + +## Constant case fatality risk + +When calling the `create_config()` function the default output contains a list element named `time_varying_death_risk` set to `NULL`. This corresponds to a constant case fatality risk over time, which is controlled by the `hosp_death_risk` and `non_hosp_death_risk` arguments. The defaults for these two arguments are: + +* death risk when hospitalised (`hosp_death_risk`): `0.5` (50%) +* death risk outside of hospitals (`non_hosp_death_risk`): `0.05` (5%) + +In this example we set them explicitly to be clear which risks we're using, but otherwise the `hosp_death_risk`, `non_hosp_death_risk` and `config` do not need to be specified and can use their default values. + +For all examples in this vignette we will set the epidemic size to be between 500 and 1,000 cases, to ensure that we can clearly see the case fatality patterns in the data. + +::: {.alert .alert-info} +See the [Get Started vignette section on Controlling Outbreak Size](simulist.html#Controlling-outbreak-size) for more information on this. +::: + +```{r, sim-linelist} +linelist <- sim_linelist( + contact_distribution = contact_distribution, + infect_period = infect_period, + prob_infect = 0.5, + onset_to_hosp = onset_to_hosp, + onset_to_death = onset_to_death, + hosp_death_risk = 0.5, + non_hosp_death_risk = 0.05, + outbreak_size = c(500, 1000), + config = create_config() +) + +# first 6 rows of linelist +head(linelist) +``` + +To visualise the incidence of cases and deaths over time we will use the [{incidence2} R package](https://www.reconverse.org/incidence2/). + +::: {.alert .alert-info} +For more information on using {incidence2} to plot line list data see the [Visualising simulated data](vis-linelist.html) vignette. +::: + +Before converting the line list `` to an `` object we need to ungroup the outcome columns into their own columns using the [{tidyr}](https://tidyr.tidyverse.org/) and [{dplyr}](https://dplyr.tidyverse.org/) R packages from the [Tidyverse](https://www.tidyverse.org/). + +```{r, reshape-linelist} +linelist <- linelist %>% + pivot_wider( + names_from = outcome, + values_from = date_outcome + ) %>% + rename( + date_death = died, + date_recovery = recovered + ) +``` + +```{r, plot-onset-hospitalisation, fig.cap="Daily incidence of cases from symptom onset and incidence of deaths. Case fatality risk for hospitalised individuals is 0.5 and the risk for non-hospitalised individuals is 0.05, and these risks are constant through time.", fig.width = 8, fig.height = 5} +daily <- incidence( + linelist, + date_index = c( + onset = "date_onset", + death = "date_death" + ), + interval = "daily" +) +daily <- complete_dates(daily) +plot(daily) +``` + +## Higher risk of case fatality + +We repeat the above simulation but increase the risk of case fatality for both hospitalised (`hosp_death_risk`) and non-hospitalised (`non_hosp_death_risk`) individuals infected. + +```{r, sim-linelist-higher-death-risk} +linelist <- sim_linelist( + contact_distribution = contact_distribution, + infect_period = infect_period, + prob_infect = 0.5, + onset_to_hosp = onset_to_hosp, + onset_to_death = onset_to_death, + hosp_death_risk = 0.9, + non_hosp_death_risk = 0.75, + outbreak_size = c(500, 1000), + config = create_config() +) + +head(linelist) +``` + +```{r, reshape-linelist-higher-death-risk} +linelist <- linelist %>% + pivot_wider( + names_from = outcome, + values_from = date_outcome + ) %>% + rename( + date_death = died, + date_recovery = recovered + ) +``` + +```{r, plot-onset-death-higher-risk, fig.cap="Daily incidence of cases from symptom onset and incidence of deaths. Case fatality risk for hospitalised individuals is 0.9 and the risk for non-hospitalised individuals is 0.75, and these risks are constant through time.", fig.width = 8, fig.height = 5} +daily <- incidence( + linelist, + date_index = c( + onset = "date_onset", + death = "date_death" + ), + interval = "daily" +) +daily <- complete_dates(daily) +plot(daily) +``` + +## Continuous time-varying case fatality risk + +Now we've seen what the constant case fatality risk simulations look like, we can simulate with a time-varying function for the risk. + +This is setup by calling the `create_config()` function, and providing an anonymous function with two arguments, `risk` and `time`, to `time_varying_death_risk`. This function will then use the relevant risk (e.g. `hosp_death_risk`) and the time an individual is infected and calculates the probability (or risk) of death. + +The `create_config()` function has no named arguments, and the argument you are modifying needs to be matched by name exactly (case sensitive). See `?create_config()` for documentation. + +```{r, setup-time-varying-cfr} +config <- create_config( + time_varying_death_risk = function(risk, time) risk * exp(-0.05 * time) +) +``` + +Here we set the case fatality risk to exponentially decrease through time. This will provide a shallow (monotonic) decline of case fatality through the simulated epidemic. + +```{r, plot-exponential-dist, class.source = 'fold-hide', fig.cap="The time-varying hospitalised case fatality risk function (`config$time_varying_death_risk`) throughout the epidemic. In this case the hospitalised risks (`hosp_death_risk`) are at their maximum value at day 0 and decline through time, with risk approaching zero at around day 100.", fig.width = 8, fig.height = 5} +exp_df <- data.frame( + time = 1:150, + value = config$time_varying_death_risk(risk = 0.9, time = 1:150) +) +ggplot(exp_df) + + geom_point(mapping = aes(x = time, y = value)) + + scale_y_continuous(name = "Value") + + scale_x_continuous(name = "Time (Days)") + + theme_bw() +``` + +::: {.alert .alert-info} + +_Advanced_ + +The time-varying case fatality risk function modifies the the death risk specified by `hosp_death_risk` and `non_hosp_death_risk`. In this example, the user-supplied `hosp_death_risk` and `non_hosp_death_risk` are the maximum values, because the user-supplied time-varying function is declining over time, however, a user-supplied function may also increase over time, or fluctuate. The requirements are that the time-varying case fatality risk for both hospitalised and non-hospitalised infections must be between 0 and 1, otherwise the function will error. + +In the example below `hosp_death_risk` is `0.9` and `non_hosp_death_risk` is `0.75`, and the time-varying case fatality risk function is an exponential decline. This means that on day 0 of the epidemic (i.e. first infection seeds the outbreak) the risks will be `0.9` and `0.75`. But any time after the start of the epidemic ($t_0 + \Delta t$) the risks will be lower, and when the exponential function approaches zero the risk of a case dying will also go to zero. + +::: + +Simulating with the time-varying case fatality risk: + +```{r, sim-linelist-time-varying-cfr} +linelist <- sim_linelist( + contact_distribution = contact_distribution, + infect_period = infect_period, + prob_infect = 0.5, + onset_to_hosp = onset_to_hosp, + onset_to_death = onset_to_death, + hosp_death_risk = 0.9, + non_hosp_death_risk = 0.75, + outbreak_size = c(500, 1000), + config = config +) + +head(linelist) +``` + +```{r, reshape-linelist-time-varying-cfr} +linelist <- linelist %>% + pivot_wider( + names_from = outcome, + values_from = date_outcome + ) %>% + rename( + date_death = died, + date_recovery = recovered + ) +``` + +```{r, plot-onset-death-time-varying-cfr, fig.cap="Daily incidence of cases from symptom onset and incidence of deaths. The baseline case fatality risk for hospitalised individuals is 0.9 and for non-hospitalised individuals is 0.75, and these decline exponentially through time.", fig.width = 8, fig.height = 5} +daily <- incidence( + linelist, + date_index = c( + onset = "date_onset", + death = "date_death" + ), + interval = "daily" +) +daily <- complete_dates(daily) +plot(daily) +``` + +## Stepwise time-varying case fatality risk + +In addition to a continuously varying case fatality risk function, the simulation can also work with stepwise (or piecewise) functions. This is where the risk will instantaneously change at a given point in time to another risk level. + +To achieve this, we again specify an anonymous function in `create_config()`, but have the risk of a case dying set as the baseline `hosp_death_risk` and `non_hosp_death_risk` for the first 60 days of the outbreak and then become zero (i.e. if an individual is infected after day 60 they will definitely recover). + +```{r, setup-time-varying-cfr-stepwise, echo=2} +# nolint start redundant_ifelse_linter ifelse used for consistency with other examples +config <- create_config( + time_varying_death_risk = function(risk, time) ifelse(test = time < 60, yes = risk, no = 0) +) +# nolint end +``` + +```{r, plot-stepwise-dist, class.source = 'fold-hide', fig.cap="The time-varying case fatality risk function (`config$time_varying_death_risk`) for the hospitalised death risk (`hosp_death_risk`) and non-hospitalised death risk (`non_hosp_death_risk`) throughout the epidemic. In this case the risks are at their user-supplied values from day 0 to day 60, and then become 0 onwards.", fig.width = 8, fig.height = 5} +stepwise_df <- data.frame( + time = 1:150, + value = config$time_varying_death_risk(risk = 0.9, time = 1:150) +) +ggplot(stepwise_df) + + geom_point(mapping = aes(x = time, y = value)) + + scale_y_continuous(name = "Value") + + scale_x_continuous(name = "Time (Days)") + + theme_bw() +``` + +Simulating with the stepwise time-varying case fatality risk: + +```{r, sim-linelist-time-varying-cfr-stepwise} +linelist <- sim_linelist( + contact_distribution = contact_distribution, + infect_period = infect_period, + prob_infect = 0.5, + onset_to_hosp = onset_to_hosp, + onset_to_death = onset_to_death, + hosp_death_risk = 0.9, + non_hosp_death_risk = 0.75, + outbreak_size = c(500, 1000), + config = config +) + +head(linelist) +``` + +```{r, reshape-linelist-time-varying-cfr-stepwise} +linelist <- linelist %>% + pivot_wider( + names_from = outcome, + values_from = date_outcome + ) %>% + rename( + date_death = died, + date_recovery = recovered + ) +``` + +```{r, plot-onset-death-time-varying-cfr-stepwise, fig.cap="Daily incidence of cases from symptom onset and incidence of deaths. The maximum case fatality risk for hospitalised individuals is 0.9 and for non-hospitalised individuals is 0.75, and these rates remain constant from days 0 to 60, and then go to 0 from day 60 onwards.", fig.width = 8, fig.height = 5} +daily <- incidence( + linelist, + date_index = c( + onset = "date_onset", + death = "date_death" + ), + interval = "daily" +) +daily <- complete_dates(daily) +plot(daily) +``` + +The same stepwise function can also be used to specify time windows were the risk of death is reduced. Here we specify the `hosp_death_risk` and `non_hosp_death_risk` in the first 50 days of the epidemic, then between day 50 and day 100 the risk is reduced by half, and then from day 100 onwards the risk goes back to the rates specified by `hosp_death_risk` and `non_hosp_death_risk`. + +```{r, setup-time-varying-cfr-stepwise-window} +config <- create_config( + time_varying_death_risk = function(risk, time) { + ifelse(test = time > 50 & time < 100, yes = risk * 0.5, no = risk) + } +) +``` + +```{r, plot-stepwise-dist-window, class.source = 'fold-hide', fig.cap="The time-varying case fatality risk function (`config$time_varying_death_risk`) which scales the hospitalised death risk (`hosp_death_risk`) and non-hospitalised death risk (`non_hosp_death_risk`) throughout the epidemic. In this case the risks are at their maximum, user-supplied, values from day 0 to day 50, and then half the risks from day 50 to day 100, and then return to their maximum value from day 100 onwards.", fig.width = 8, fig.height = 5} +stepwise_df <- data.frame( + time = 1:150, + value = config$time_varying_death_risk(risk = 0.9, time = 1:150) +) +ggplot(stepwise_df) + + geom_point(mapping = aes(x = time, y = value)) + + scale_y_continuous(name = "Value", limits = c(0, 1)) + + scale_x_continuous(name = "Time (Days)") + + theme_bw() +``` + +Simulating with the stepwise time-varying case fatality risk: + +```{r, sim-linelist-time-varying-cfr-stepwise-window} +linelist <- sim_linelist( + contact_distribution = contact_distribution, + infect_period = infect_period, + prob_infect = 0.5, + onset_to_hosp = onset_to_hosp, + onset_to_death = onset_to_death, + hosp_death_risk = 0.9, + non_hosp_death_risk = 0.75, + outbreak_size = c(500, 1000), + config = config +) + +head(linelist) +``` + +```{r, reshape-linelist-time-varying-cfr-stepwise-window} +linelist <- linelist %>% + pivot_wider( + names_from = outcome, + values_from = date_outcome + ) %>% + rename( + date_death = died, + date_recovery = recovered + ) +``` + +```{r, plot-onset-death-time-varying-cfr-stepwise-window, fig.cap="Daily incidence of cases from symptom onset and incidence of deaths. The maximum case fatality risk for hospitalised individuals is 0.9 and for non-hospitalised individuals is 0.75, and these rates remain constant from days 0 to 50, and then from days 50 to 100 the case fatality risk is halved (i.e `hosp_death_risk` = 0.45 and `non_hosp_death_risk` = 0.375), before going back to their original risks from day 100 onwards.", fig.width = 8, fig.height = 5} +daily <- incidence( + linelist, + date_index = c( + onset = "date_onset", + death = "date_death" + ), + interval = "daily" +) +daily <- complete_dates(daily) +plot(daily) +``` + +This vignette does not explore applying a time-varying case fatality risk to age-stratified fatality risks, but this is possible with the `sim_linelist()` and `sim_outbreak()` functions. See the [Age-stratified hospitalisation and death risks vignette](age-strat-risks.html) and combine with instructions from this vignette on setting in a time-varying function using `create_config()`. + +The implementation of the time-varying case fatality rate in the simulation functions (`sim_linelist()` and `sim_outbreak()`) is flexible to many functional forms. If there are other ways to have a time-varying case fatality risk that are not currently possible please make an [issue](https://github.com/epiverse-trace/simulist/issues) or [pull request](https://github.com/epiverse-trace/simulist/pulls). Currently the hospitalisation risk is assumed constant over time can cannot be adjusted to be time-varying like the death risk, if this is a feature you would like included in the {simulist} R package please make the request in an [issue](https://github.com/epiverse-trace/simulist/issues).