Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use NULL for onset-to-event and risk function arguments #148

Merged
merged 1 commit into from
Jun 25, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 4 additions & 4 deletions R/add_cols.R
Original file line number Diff line number Diff line change
Expand Up @@ -97,8 +97,8 @@ NULL
.data$hospitalisation[infected_lgl_idx] <- .data$time[infected_lgl_idx] +
onset_to_hosp(num_infected)

# hosp_risk is either numeric or <data.frame> or NA
if (!rlang::is_lgl_na(hosp_risk)) {
# hosp_risk is either numeric or <data.frame> or NULL
if (!is.null(hosp_risk)) {
if (is.numeric(hosp_risk)) {
# size is converted to an integer internally in sample()
pop_sample <- sample(
Expand Down Expand Up @@ -146,9 +146,9 @@ NULL

# 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
# if risk is NULL then no deaths are assigned
apply_death_risk <- function(.data, risk, idx, config) {
if (!rlang::is_lgl_na(risk)) {
if (!is.null(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)) {
Expand Down
54 changes: 27 additions & 27 deletions R/checkers.R
Original file line number Diff line number Diff line change
Expand Up @@ -159,13 +159,13 @@
sum(case_type_probs) == 1,
"hosp_risk must be a single numeric or a data.frame" =
is.numeric(hosp_risk) || is.data.frame(hosp_risk) ||
rlang::is_lgl_na(hosp_risk),
is.null(hosp_risk),
"hosp_death_risk must be a single numeric or a data.frame" =
is.numeric(hosp_death_risk) || is.data.frame(hosp_death_risk) ||
rlang::is_lgl_na(hosp_death_risk),
is.null(hosp_death_risk),
"non_hosp_death_risk must be a single numeric or a data.frame" =
is.numeric(non_hosp_death_risk) || is.data.frame(non_hosp_death_risk) ||
rlang::is_lgl_na(non_hosp_death_risk)
is.null(non_hosp_death_risk)
)
if (is.numeric(hosp_risk)) {
checkmate::assert_number(hosp_risk, lower = 0, upper = 1)
Expand Down Expand Up @@ -244,18 +244,18 @@
#' @description
#' There are two types of cross-checking:
#' 1. If the onset-to-event distribution is specified but the corresponding risk
#' is not specified (i.e. `NA`) the function will error ([stop()]).
#' 2. If the onset-to-event distribution is not specified (i.e. `NA`) but the
#' is not specified (i.e. `NULL`) the function will error ([stop()]).
#' 2. If the onset-to-event distribution is not specified (i.e. `NULL`) but the
#' corresponding risk is specified the function will throw a warning
#' ([warning()]).
#'
#' The difference in condition handling is because in the case that the
#' onset-to-event is `NA` the simulation can safely ignore the corresponding
#' onset-to-event is `NULL` the simulation can safely ignore the corresponding
#' risk, while throwing a warning, as there are no events. In other words, if
#' the onset-to-hospitalisation is not specified, no infected individuals will
#' go to hospital and the `date_admission` column in the line list will all be
#' `NA`s. However, if the onset-to-event is specified and the corresponding
#' risk is `NA` then the proportion of individuals infected that are
#' risk is `NULL` then the proportion of individuals infected that are
#' hospitalised or die cannot be calculated and therefore the simulation
#' cannot run. It is in this latter case that the cross-checking throws an
#' error.
Expand All @@ -272,7 +272,7 @@
hosp_death_risk,
non_hosp_death_risk) {
# hosp_risk, hosp_death_risk and non_hosp_death_risk can assumed to be a
# number or a <data.frame> or NA as they will have been checked by
# number or a <data.frame> or NULL as they will have been checked by
# .check_sim_input() before calling .cross_check_sim_input
# onset_to_hosp and onset_to_death will be closures

Expand All @@ -281,23 +281,23 @@
onset_to_death_eval <- onset_to_death(1)

msg <- character(0)
# risks can only be NA when the onset to event is also NA
if (!rlang::is_lgl_na(onset_to_hosp_eval) && rlang::is_lgl_na(hosp_risk)) {
# risks can only be NULL when the onset to event is NA
if (!rlang::is_lgl_na(onset_to_hosp_eval) && is.null(hosp_risk)) {
msg <- c(msg, paste(
"hosp_risk is set to NA but onset_to_hosp is specified \n",
"hosp_risk is set to NULL but onset_to_hosp is specified \n",
"set hosp_risk to numeric value"
))
}
if (!rlang::is_lgl_na(onset_to_death_eval)) {
if (rlang::is_lgl_na(hosp_death_risk) && !rlang::is_lgl_na(hosp_risk)) {
if (is.null(hosp_death_risk) && !is.null(hosp_risk)) {
msg <- c(msg, paste(
"hosp_death_risk is set to NA but hosp_risk and onset_to_death is",
"hosp_death_risk is set to NULL but hosp_risk and onset_to_death is",
"specified \n set hosp_death_risk to numeric value"
))
}
if (rlang::is_lgl_na(non_hosp_death_risk)) {
if (is.null(non_hosp_death_risk)) {
msg <- c(msg, paste(
"non_hosp_death_risk is set to NA but onset_to_death is specified \n",
"non_hosp_death_risk is set to NULL but onset_to_death is specified \n",
"set non_hosp_death_risk to numeric value"
))
}
Expand All @@ -314,37 +314,37 @@
checkmate::test_number(hosp_risk) ||
rlang::is_lgl_na(onset_to_hosp_eval) && is.data.frame(hosp_risk)) {
msg <- c(msg, paste(
"onset_to_hosp is set to NA but hosp_risk is specified \n",
"hosp_risk is being ignored, set hosp_risk to NA when",
"onset_to_hosp is NA"
"onset_to_hosp is set to NULL but hosp_risk is specified \n",
"hosp_risk is being ignored, set hosp_risk to NULL when",
"onset_to_hosp is NULL"
))
}
if (rlang::is_lgl_na(onset_to_hosp_eval) &&
checkmate::test_number(hosp_death_risk) ||
rlang::is_lgl_na(onset_to_hosp_eval) && is.data.frame(hosp_death_risk)) {
msg <- c(msg, paste(
"onset_to_hosp is set to NA but hosp_death_risk is specified \n",
"hosp_death_risk is being ignored, set hosp_death_risk to NA when",
"onset_to_hosp is NA"
"onset_to_hosp is set to NULL but hosp_death_risk is specified \n",
"hosp_death_risk is being ignored, set hosp_death_risk to NULL when",
"onset_to_hosp is NULL"
))
}
if (rlang::is_lgl_na(onset_to_death_eval) &&
checkmate::test_number(hosp_death_risk) ||
rlang::is_lgl_na(onset_to_death_eval) && is.data.frame(hosp_death_risk)) {
msg <- c(msg, paste(
"onset_to_death is set to NA but hosp_death_risk is specified \n",
"hosp_death_risk is being ignored, set hosp_death_risk to NA when",
"onset_to_death is NA"
"onset_to_death is set to NULL but hosp_death_risk is specified \n",
"hosp_death_risk is being ignored, set hosp_death_risk to NULL when",
"onset_to_death is NULL"
))
}
if (rlang::is_lgl_na(onset_to_death_eval) &&
checkmate::test_number(non_hosp_death_risk) ||
rlang::is_lgl_na(onset_to_death_eval) &&
is.data.frame(non_hosp_death_risk)) {
msg <- c(msg, paste(
"onset_to_death is set to NA but non_hosp_death_risk is specified \n",
"non_hosp_death_risk is being ignored, set non_hosp_death_risk to NA",
"when onset_to_death is NA"
"onset_to_death is set to NULL but non_hosp_death_risk is specified \n",
"non_hosp_death_risk is being ignored, set non_hosp_death_risk to NULL",
"when onset_to_death is NULL"
))
}
if (length(msg) > 0) {
Expand Down
22 changes: 11 additions & 11 deletions R/sim_linelist.R
Original file line number Diff line number Diff line change
Expand Up @@ -34,33 +34,33 @@
#' @param prob_infection A single `numeric` for the probability of a secondary
#' contact being infected by an infected primary contact.
#' @param onset_to_hosp An `<epidist>` object, an anonymous function for
#' the onset to hospitalisation delay distribution, or `NA` to not simulate
#' the onset to hospitalisation delay distribution, or `NULL` to not simulate
#' hospitalisation (admission) dates.
#' @param onset_to_death An `<epidist>` object, an anonymous function for
#' the onset to death delay distribution, or `NA` to not simulate dates for
#' the onset to death delay distribution, or `NULL` to not simulate dates for
#' individuals that died.
#' @param onset_to_recovery An `<epidist>` object, an anonymous function for
#' the onset to death delay distribution, or `NA` to not simulate dates for
#' individuals that recovered. Default is `NA` so by default cases that
#' the onset to death delay distribution, or `NULL` to not simulate dates for
#' individuals that recovered. Default is `NULL` so by default cases that
#' recover get an `NA` in the `$date_outcome` line list column.
#' @param hosp_risk Either a single `numeric` for the hospitalisation risk of
#' everyone in the population, or a `<data.frame>` with age specific
#' hospitalisation risks Default is 20% hospitalisation (`0.2`) for the entire
#' population. If the `onset_to_hosp` argument is set to `NA` this argument
#' should also be set to `NA`. See details and examples for more information.
#' population. If the `onset_to_hosp` argument is set to `NULL` this argument
#' should also be set to `NULL`. See details and examples for more information.
#' @param hosp_death_risk Either a single `numeric` for the death risk for
#' hospitalised individuals across the population, or a `<data.frame>` with age
#' 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. If a time-varying death risk is specified in the
#' `config` the `hosp_death_risk` is interpreted as the maximum risk across
#' to `NULL` this argument should also be set to `NULL`. See details and
#' examples 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 `<data.frame>` 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
#' argument is set to `NULL` this argument should also be set to `NULL`. See
#' 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.
Expand Down Expand Up @@ -157,7 +157,7 @@ sim_linelist <- function(contact_distribution,
prob_infection,
onset_to_hosp,
onset_to_death,
onset_to_recovery = NA,
onset_to_recovery = NULL,
hosp_risk = 0.2,
hosp_death_risk = 0.5,
non_hosp_death_risk = 0.05,
Expand Down
2 changes: 1 addition & 1 deletion R/sim_outbreak.R
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,7 @@ sim_outbreak <- function(contact_distribution,
prob_infection,
onset_to_hosp,
onset_to_death,
onset_to_recovery = NA,
onset_to_recovery = NULL,
hosp_risk = 0.2,
hosp_death_risk = 0.5,
non_hosp_death_risk = 0.05,
Expand Down
24 changes: 12 additions & 12 deletions R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -120,11 +120,11 @@
out
}

#' Convert `<epidist>` or `NA` to function
#' Convert `<epidist>` or `NULL` to function
#'
#' @description
#' An extension to [as.function()], particularly the \pkg{epiparameter}
#' `as.function` S3 method, with the added feature that [`NA`]s are converted
#' `as.function` S3 method, with the added feature that [`NULL`]s are converted
#' into functions that generate a vector of `NA`s to behave equivalently to
#' the generator functions output from
#' `as.function(..., func_type = "generate")`.
Expand All @@ -133,9 +133,9 @@
#' unchanged.
#'
#' There is also input checking to error if input is not an `<epidist>`,
#' `function` ([closure]), or for onset-to-event distributions `NA`.
#' `function` ([closure]), or for onset-to-event distributions `NULL`.
#'
#' @param x A named list containing either `<epidist>`, `function` or `NA`.
#' @param x A named list containing either `<epidist>`, `function` or `NULL`.
#' Named list elements are: `"contact_distribution"`, `"infectious_period"`,
#' `"onset_to_hosp"`, `"onset_to_death"`, `"onset_to_recovery".`
#'
Expand All @@ -147,29 +147,29 @@ as_function <- function(x) {
inherits(x$contact_distribution, c("function", "epidist")) &&
inherits(x$infectious_period, c("function", "epidist")),
"onset_to_hosp, onset_to_death and onset_to_recovery need to be a function,
<epidist> or NA" =
inherits(x$onset_to_hosp, c("function", "epidist")) ||
rlang::is_lgl_na(x$onset_to_hosp) &&
inherits(x$onset_to_death, c("function", "epidist")) ||
rlang::is_lgl_na(x$onset_to_death)
<epidist> or NULL" =
(inherits(x$onset_to_hosp, c("function", "epidist")) ||
is.null(x$onset_to_hosp)) &&
(inherits(x$onset_to_death, c("function", "epidist")) ||
is.null(x$onset_to_death))
)
contact_distribution <- as.function(
x$contact_distribution, func_type = "density"
)
infectious_period <- as.function(x$infectious_period, func_type = "generate")
if (rlang::is_lgl_na(x$onset_to_hosp)) {
if (is.null(x$onset_to_hosp)) {
# function to generate NA instead of hospitalisation times
onset_to_hosp <- function(x) rep(NA, times = x)
} else {
onset_to_hosp <- as.function(x$onset_to_hosp, func_type = "generate")
}
if (rlang::is_lgl_na(x$onset_to_death)) {
if (is.null(x$onset_to_death)) {
# function to generate NA instead of death times
onset_to_death <- function(x) rep(NA, times = x)
} else {
onset_to_death <- as.function(x$onset_to_death, func_type = "generate")
}
if (rlang::is_lgl_na(x$onset_to_recovery)) {
if (is.null(x$onset_to_recovery)) {
# function to generate NA instead of recovery times
onset_to_recovery <- function(x) rep(NA, times = x)
} else {
Expand Down
8 changes: 4 additions & 4 deletions man/as_function.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

20 changes: 10 additions & 10 deletions man/dot-add_cols.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading
Loading