From bbb0370c7b178a83478e882af181b72e1df35d7a Mon Sep 17 00:00:00 2001
From: pqiao29 <pqiao@student.unimelb.edu.au>
Date: Wed, 1 Apr 2020 12:18:04 +1100
Subject: [PATCH] departure.FUN
---
R/departure.FUN.R | 69 +++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 69 insertions(+)
create mode 100644 R/departure.FUN.R
diff --git a/R/departure.FUN.R b/R/departure.FUN.R
new file mode 100644
index 0000000..dfd1cdb
--- /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)
+}
--
GitLab