Nothing
#' @title Epidemic Parameters for Stochastic Individual Contact Models
#'
#' @description Sets the epidemic parameters for stochastic individual contact
#' models simulated with \code{icm}.
#'
#' @inheritParams param.dcm
#'
#' @details
#' \code{param.icm} sets the epidemic parameters for the stochastic individual
#' contact models simulated with the \code{\link{icm}} function. Models
#' may use the base types, for which these parameters are used, or new process
#' modules which may use these parameters (but not necessarily). A detailed
#' description of ICM parameterization for base models is found in the
#' \href{http://www.epimodel.org/tut.html}{Basic ICMs} tutorial.
#'
#' For base models, the model specification will be chosen as a result of
#' the model parameters entered here and the control settings in
#' \code{\link{control.icm}}. One-group and two-group models are available,
#' where the former assumes a homogeneous mixing in the population and the
#' latter assumes some form of heterogeneous mixing between two distinct
#' partitions in the population (e.g., men and women). Specifying any group two
#' parameters (those with a \code{.g2}) implies the simulation of a two-group
#' model. All the parameters for a desired model type must be specified, even if
#' they are zero.
#'
#' @section Act Balancing:
#' In two-group models, a balance between the number of acts for group 1 members
#' and those for group 2 members must be maintained. With purely heterogeneous
#' mixing, the product of one group size and act rate must equal the product of
#' the other group size and act rate: \eqn{N_1 \alpha_1 = N_2 \alpha_2}, where
#' \eqn{N_i} is the group size and \eqn{\alpha_i} the group-specific act rate
#' at time \eqn{t}. The \code{balance} parameter here specifies which group's
#' act rate should control the others with respect to balancing. See the
#' \href{http://www.epimodel.org/tut.html}{Basic ICMs} tutorial.
#'
#' @section New Modules:
#' To build original models outside of the base models, new process modules
#' may be constructed to replace the existing modules or to supplement the
#' existing set. These are passed into the control settings in
#' \code{\link{control.icm}}. New modules may use either the existing model
#' parameters named here, an original set of parameters, or a combination of
#' both. The \code{...} allows the user to pass an arbitrary set of original
#' model parameters into \code{param.icm}. Whereas there are strict checks with
#' default modules for parameter validity, these checks are the user's
#' responsibility with new modules.
#'
#' @return An \code{EpiModel} object of class \code{param.icm}.
#'
#' @seealso Use \code{\link{init.icm}} to specify the initial conditions and
#' \code{\link{control.icm}} to specify the control settings. Run the
#' parameterized model with \code{\link{icm}}.
#'
#' @keywords parameterization
#'
#' @export
#'
param.icm <- function(inf.prob, inter.eff, inter.start, act.rate, rec.rate,
a.rate, ds.rate, di.rate, dr.rate, inf.prob.g2,
act.rate.g2, rec.rate.g2, a.rate.g2, ds.rate.g2,
di.rate.g2, dr.rate.g2, balance, ...) {
# Get arguments
p <- list()
formal.args <- formals(sys.function())
formal.args[["..."]] <- NULL
for (arg in names(formal.args)) {
if (as.logical(mget(arg) != "")) {
p[arg] <- list(get(arg))
}
}
dot.args <- list(...)
names.dot.args <- names(dot.args)
if (length(dot.args) > 0) {
for (i in seq_along(dot.args)) {
p[[names.dot.args[i]]] <- dot.args[[i]]
}
}
if ("b.rate" %in% names.dot.args) {
p$a.rate <- dot.args$b.rate
message("EpiModel 1.7.0 onward renamed the birth rate parameter b.rate to
a.rate. ", "See documentation for details.")
}
if ("b.rate.g2" %in% names.dot.args) {
p$a.rate.g2 <- dot.args$b.rate.g2
message("EpiModel 1.7.0 onward renamed the birth rate parameter b.rate.g2 to
a.rate.g2. ", "See documentation for details.")
}
## Defaults and checks
if (is.null(p$act.rate)) {
p$act.rate <- 1
}
p$vital <- ifelse(!is.null(p$a.rate) | !is.null(p$ds.rate) |
!is.null(p$di.rate) | !is.null(p$dr.rate), TRUE, FALSE)
p$groups <- ifelse(any(grepl(".g2", names(p))) == TRUE, 2, 1)
if (p$groups == 2 && (is.null(p$balance) ||
!(p$balance %in% c("g1", "g2")))) {
stop("Specify balance=\"g1\" or balance=\"g2\" with 2-group models")
}
if (!is.null(p$inter.eff) && is.null(p$inter.start)) {
p$inter.start <- 1
}
## Output
class(p) <- c("param.icm", "list")
return(p)
}
#' @title Initial Conditions for Stochastic Individual Contact Models
#'
#' @description Sets the initial conditions for stochastic individual contact
#' models simulated with \code{icm}.
#'
#' @param s.num Number of initial susceptible persons. For two-group models,
#' this is the number of initial group 1 susceptible persons.
#' @param i.num Number of initial infected persons. For two-group models, this
#' is the number of initial group 1 infected persons.
#' @param r.num Number of initial recovered persons. For two-group models, this
#' is the number of initial group 1 recovered persons. This parameter is
#' only used for the \code{SIR} model type.
#' @param s.num.g2 Number of initial susceptible persons in group 2. This
#' parameter is only used for two-group models.
#' @param i.num.g2 Number of initial infected persons in group 2. This parameter
#' is only used for two-group models.
#' @param r.num.g2 Number of initial recovered persons in group 2. This
#' parameter is only used for two-group \code{SIR} models.
#' @param ... Additional initial conditions passed to model.
#'
#' @details
#' The initial conditions for a model solved with \code{\link{icm}} should be
#' input into the \code{init.icm} function. This function handles initial
#' conditions for both base models and original models using new modules. For
#' an overview of initial conditions for base ICM class models, consult the
#' \href{http://www.epimodel.org/tut.html}{Basic ICMs} tutorial.
#'
#' @return An \code{EpiModel} object of class \code{init.icm}.
#'
#' @seealso Use \code{\link{param.icm}} to specify model parameters and
#' \code{\link{control.icm}} to specify the control settings. Run the
#' parameterized model with \code{\link{icm}}.
#'
#' @keywords parameterization
#'
#' @export
#'
init.icm <- function(s.num, i.num, r.num,
s.num.g2, i.num.g2, r.num.g2, ...) {
# Get arguments
p <- list()
formal.args <- formals(sys.function())
formal.args[["..."]] <- NULL
for (arg in names(formal.args)) {
if (as.logical(mget(arg) != "")) {
p[arg] <- list(get(arg))
}
}
dot.args <- list(...)
names.dot.args <- names(dot.args)
if (length(dot.args) > 0) {
for (i in seq_along(dot.args)) {
p[[names.dot.args[i]]] <- dot.args[[i]]
}
}
## Output
class(p) <- c("init.icm", "list")
return(p)
}
#' @title Control Settings for Stochastic Individual Contact Models
#'
#' @description Sets the controls for stochastic individual contact models
#' simulated with \code{\link{icm}}.
#'
#' @param type Disease type to be modeled, with the choice of \code{"SI"} for
#' Susceptible-Infected diseases, \code{"SIR"} for
#' Susceptible-Infected-Recovered diseases, and \code{"SIS"} for
#' Susceptible-Infected-Susceptible diseases.
#' @param nsteps Number of time steps to solve the model over. This must be a
#' positive integer.
#' @param nsims Number of simulations to run.
#' @param initialize.FUN Module to initialize the model at the outset, with the
#' default function of \code{\link{initialize.icm}}.
#' @param infection.FUN Module to simulate disease infection, with the default
#' function of \code{\link{infection.icm}}.
#' @param recovery.FUN Module to simulate disease recovery, with the default
#' function of \code{\link{recovery.icm}}.
#' @param departures.FUN Module to simulate departures or exits, with the
#' default function of \code{\link{departures.icm}}.
#' @param arrivals.FUN Module to simulate arrivals or entries, with the default
#' function of \code{\link{arrivals.icm}}.
#' @param prevalence.FUN Module to calculate disease prevalence at each time
#' step, with the default function of \code{\link{prevalence.icm}}.
#' @param verbose If \code{TRUE}, print model progress to the console.
#' @param verbose.int Time step interval for printing progress to console, where
#' 0 (the default) prints completion status of entire simulation and
#' positive integer \code{x} prints progress after every \code{x} time
#' steps.
#' @param skip.check If \code{TRUE}, skips the default error checking for the
#' structure and consistency of the parameter values, initial conditions,
#' and control settings before running base epidemic models. Setting
#' this to \code{FALSE} is recommended when running models with new
#' modules specified.
#' @param ... Additional control settings passed to model.
#'
#' @details
#' \code{control.icm} sets the required control settings for any stochastic
#' individual contact model solved with the \code{\link{icm}} function. Controls
#' are required for both base model types and when passing original process
#' modules. For an overview of control settings for base ICM class models,
#' consult the \href{http://www.epimodel.org/tut.html}{Basic ICMs} tutorial. For
#' all base models, the \code{type} argument is a necessary parameter and it has
#' no default.
#'
#' @section New Modules:
#' Base ICM models use a set of module functions that specify
#' how the individual agents in the population are subjected to infection,
#' recovery, demographics, and other processes. Core modules are those listed in
#' the \code{.FUN} arguments. For each module, there is a default function used
#' in the simulation. The default infection module, for example, is contained in
#' the \code{\link{infection.icm}} function.
#'
#' For original models, one may substitute replacement module functions for any
#' of the default functions. New modules may be added to the workflow at each
#' time step by passing a module function via the \code{...} argument.
#'
#' @return An \code{EpiModel} object of class \code{control.icm}.
#'
#' @seealso Use \code{\link{param.icm}} to specify model parameters and
#' \code{\link{init.icm}} to specify the initial conditions. Run the
#' parameterized model with \code{\link{icm}}.
#'
#' @keywords parameterization
#'
#' @export
#'
control.icm <- function(type, nsteps, nsims = 1,
initialize.FUN = initialize.icm,
infection.FUN = NULL, recovery.FUN = NULL,
departures.FUN = NULL, arrivals.FUN = NULL,
prevalence.FUN = NULL, verbose = FALSE,
verbose.int = 0, skip.check = FALSE, ...) {
# Get arguments
p <- list()
formal.args <- formals(sys.function())
formal.args[["..."]] <- NULL
for (arg in names(formal.args)) {
if (as.logical(mget(arg) != "")) {
p[arg] <- list(get(arg))
}
}
dot.args <- list(...)
names.dot.args <- names(dot.args)
if (length(dot.args) > 0) {
for (i in seq_along(dot.args)) {
p[[names.dot.args[i]]] <- dot.args[[i]]
}
}
if ("births.FUN" %in% names(dot.args)) {
p$arrivals.FUN <- dot.args$births.FUN
p$births.FUN <- dot.args$births.FUN <- NULL
message("EpiModel 1.7.0 onward renamed the birth function births.FUN to
arrivals.FUN. See documentation for details.")
}
if ("deaths.FUN" %in% names(dot.args)) {
p$departures.FUN <- dot.args$deaths.FUN
p$deaths.FUN <- dot.args$deaths.FUN <- NULL
message("EpiModel 1.7.0 onward renamed the death function deaths.FUN to
departures.FUN. See documentation for details.")
}
## Module classification
p$bi.mods <- grep(".FUN", names(formal.args), value = TRUE)
p$user.mods <- grep(".FUN", names(dot.args), value = TRUE)
## Defaults and checks
if (is.null(p$type) || !(p$type %in% c("SI", "SIS", "SIR"))) {
stop("Specify type as \"SI\", \"SIS\", or \"SIR\" ", call. = FALSE)
}
if (is.null(p$nsteps)) {
stop("Specify nsteps", call. = FALSE)
}
## Output
p <- set.control.class("control.icm", p)
return(p)
}
#' @title Cross Checking of Inputs for Stochastic Individual Contact Models
#'
#' @description This function checks that the three parameter lists from
#' \code{\link{param.icm}}, \code{\link{init.icm}}, and
#' \code{\link{control.icm}} are consistent.
#'
#' @param param An \code{EpiModel} object of class \code{\link{param.icm}}.
#' @param init An \code{EpiModel} object of class \code{\link{init.icm}}.
#' @param control An \code{EpiModel} object of class \code{\link{control.icm}}.
#'
#' @return
#' This function returns no objects.
#'
#' @export
#' @keywords internal
#'
crosscheck.icm <- function(param, init, control) {
check.control.class("icm", "EpiModel crosscheck.icm")
## Main class check
if (!inherits(param, "param.icm")) {
stop("param must an object of class param.icm", call. = FALSE)
}
if (!inherits(init, "init.icm")) {
stop("init must an object of class init.icm", call. = FALSE)
}
if (!inherits(control, "control.icm")) {
stop("control must an object of class control.icm", call. = FALSE)
}
if (control$skip.check == FALSE) {
## Check that rec.rate is supplied for SIR models
if (control$type %in% c("SIR", "SIS")) {
if (is.null(param$rec.rate)) {
stop("Specify rec.rate in param.icm", call. = FALSE)
}
if (param$groups == 2 && is.null(param$rec.rate.g2)) {
stop("Specify rec.rate.g2 in param.icm", call. = FALSE)
}
}
## Check that paramets and init are supplied for SIR models
if (control$type == "SIR") {
if (is.null(init$r.num)) {
stop("Specify r.num in init.icm", call. = FALSE)
}
if (param$groups == 2 && is.null(init$r.num.g2)) {
stop("Specify r.num.g2 in init.icm", call. = FALSE)
}
}
## Check that groups implied by init and params are consistent
if (any(grepl(".g2", names(init))) == TRUE) {
init.groups <- 2
} else {
init.groups <- 1
}
if (param$groups == 2 && init.groups == 1) {
stop("Group 2 parameters specified in param.dcm, but missing group 2, ",
"initial states in init.icm", call. = FALSE)
}
if (param$groups == 1 && init.groups == 2) {
stop("Group 2 initial stats specified in init.dcm, but missing group 2 ",
"parameters in param.icm", call. = FALSE)
}
## Deprecated parameters
bim <- grep(".FUN", names(formals(control.icm)), value = TRUE)
um <- which(grepl(".FUN", names(control)) & !(names(control) %in% bim))
if (length(um) == 0 && !is.null(control$type)) {
if (!is.null(param$trans.rate)) {
stop("The trans.rate parameter is deprecated. Use the inf.prob ",
"parameter instead.", call. = FALSE)
}
if (!is.null(param$trans.rate.g2)) {
stop("The trans.rate.g2 parameter is deprecated. Use the inf.prob.g2 ",
"parameter instead.", call. = FALSE)
}
}
}
## Assign modules based on group parameter
if (!is.null(control$type)) {
def <- grep(".FUN", names(control))
args <- names(control)[def]
if (param$groups == 1) {
for (i in seq_along(args)) {
if (is.null(control[[args[i]]])) {
temp <- get(gsub(".FUN", ".icm", args[i]))
control[[args[i]]] <- temp
}
}
} else {
for (i in seq_along(args)) {
if (is.null(control[[args[i]]])) {
temp <- get(gsub(".FUN", ".icm.bip", args[i]))
control[[args[i]]] <- temp
}
}
}
}
## In-place assignment to update param and control
on.exit(assign("param", param, pos = parent.frame()))
on.exit(assign("control", control, pos = parent.frame()), add = TRUE)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.