diff --git a/R/departure.FUN.R b/R/departure.FUN.R new file mode 100644 index 0000000000000000000000000000000000000000..dfd1cdbe61ea462f241495f2d318e6e81199b7b7 --- /dev/null +++ b/R/departure.FUN.R @@ -0,0 +1,69 @@ +#' Departures function +#' +#' Function to handel background demographics for the SEIQHRF model. +#' Specifically departures (deaths not due to the virus, and emigration). +#' +#' @param dat Merged input parameters. +#' @param at Step number +#' @param seed random seed for checking consistency +#' +#' @return Updated dat +#' @export +departures.FUN <- function(dat, at, seed = NULL) { + + if(!is.null(seed)) set.seed(seed) + + # Conditions -------------------------------------------------------------- + if (!dat$param$vital) return(dat) + + # Variables ----------------------------------------------------------------- + rate <- dat$param$ds.rate + rand <- dat$control$d.rand + status <- dat$attr$status + active <- dat$attr$active + + # Susceptible departures ------------------------------------------------------ + res <- update_active(rate, rand, active, status, label = "s") + nDepartures <- res[[1]] + if(!is.null(res[[2]])) active <- dat$attr$active[res[[2]]] <- 0 + + if (at == 2) dat$epi$ds.flow <- c(0, nDepartures) else dat$epi$ds.flow[at] <- nDepartures + + # Exposed Departures --------------------------------------------------------- + res <- update_active(rate, rand, active, status, label = "e") + nDepartures <- res[[1]] + if(!is.null(res[[2]])) active <- dat$attr$active[res[[2]]] <- 0 + + if (at == 2) dat$epi$de.flow <- c(0, nDepartures) else dat$epi$de.flow[at] <- nDepartures + + # Infected Departures --------------------------------------------------------- + res <- update_active(rate, rand, active, status, label = "i") + nDepartures <- res[[1]] + if(!is.null(res[[2]])) active <- dat$attr$active[res[[2]]] <- 0 + + if (at == 2) dat$epi$di.flow <- c(0, nDepartures) else dat$epi$di.flow[at] <- nDepartures + + # Quarantined Departures --------------------------------------------------------- + res <- update_active(rate, rand, active, status, label = "q") + nDepartures <- res[[1]] + if(!is.null(res[[2]])) active <- dat$attr$active[res[[2]]] <- 0 + + if (at == 2) dat$epi$dq.flow <- c(0, nDepartures) else dat$epi$dq.flow[at] <- nDepartures + + # Hospitalised Departures --------------------------------------------------------- + res <- update_active(rate, rand, active, status, label = "h") + nDepartures <- res[[1]] + if(!is.null(res[[2]])) active <- dat$attr$active[res[[2]]] <- 0 + + if (at == 2) dat$epi$dh.flow <- c(0, nDepartures) else dat$epi$dh.flow[at] <- nDepartures + + # Recovered Departures -------------------------------------------------------- + res <- update_active(rate, rand, active, status, label = "r") + nDepartures <- res[[1]] + if(!is.null(res[[2]])) active <- dat$attr$active[res[[2]]] <- 0 + + if (at == 2) dat$epi$dr.flow <- c(0, nDepartures) else dat$epi$dr.flow[at] <- nDepartures + + # return -------------------------------------------------------- + return(dat) +}