diff --git a/R/FUN_arrivals.R b/R/FUN_arrivals.R index 5488e3e112d724c005149b4cec14ac1eb5a06d91..f2ddf40d011b007f2717da79de7686df6de3e681 100644 --- a/R/FUN_arrivals.R +++ b/R/FUN_arrivals.R @@ -28,11 +28,6 @@ arrivals.FUN <- function(dat, at, seed = NULL) { nOld <- dat$epi$num[at - 1] type <- dat$control$type nsteps <- dat$control$nsteps - a.rate.g2 <- dat$param$a.rate.g2 - a.prop.e.g2 <- dat$param$a.prop.e.g2 - a.prop.i.g2 <- dat$param$a.prop.i.g2 - a.prop.q.g2 <- dat$param$a.prop.q.g2 - # Process: partition arrivals into compartments ----------------------------------------------------------------- nArrivals <- ifelse(a.rand, sum(stats::rbinom(nOld, 1, a.rate)), round(nOld * a.rate)) diff --git a/R/icm_seiqhrf.R b/R/icm_seiqhrf.R index b564c6137afddc851e9832a6a92237f0805f89ab..9c2d7cc6751281f1c4bf65ba55a7be963fca02af 100644 --- a/R/icm_seiqhrf.R +++ b/R/icm_seiqhrf.R @@ -68,7 +68,8 @@ merge.seiqhrf.icm <- function(x, y, ...) { #' @importFrom EpiModel verbose.icm #' @importFrom future availableCores #' @export -icm.seiqhrf <- function(param, init, control) { +icm.seiqhrf <- function(param, init, control, seed = NULL) { + crosscheck.seiqhrf.icm(param, init, control) EpiModel::verbose.icm(control, type = "startup") @@ -83,7 +84,7 @@ icm.seiqhrf <- function(param, init, control) { ## Initialization module if (!is.null(control[["initialize.FUN"]])) { - dat <- do.call(control[["initialize.FUN"]], list(param, init, control)) + dat <- do.call(control[["initialize.FUN"]], list(param, init, control, seed)) } @@ -94,31 +95,31 @@ icm.seiqhrf <- function(param, init, control) { um <- control$user.mods if (length(um) > 0) { for (i in 1:length(um)) { - dat <- do.call(control[[um[i]]], list(dat, at)) + dat <- do.call(control[[um[i]]], list(dat, at, seed)) } } ## Infection if (!is.null(control[["infection.FUN"]])) { - dat <- do.call(control[["infection.FUN"]], list(dat, at)) + dat <- do.call(control[["infection.FUN"]], list(dat, at, seed)) } ## Recovery if (!is.null(control[["recovery.FUN"]])) { - dat <- do.call(control[["recovery.FUN"]], list(dat, at)) + dat <- do.call(control[["recovery.FUN"]], list(dat, at, seed)) } ## Departure Module if (!is.null(control[["departures.FUN"]])) { - dat <- do.call(control[["departures.FUN"]], list(dat, at)) + dat <- do.call(control[["departures.FUN"]], list(dat, at, seed)) } ## Arrival Module if (!is.null(control[["arrivals.FUN"]])) { - dat <- do.call(control[["arrivals.FUN"]], list(dat, at)) + dat <- do.call(control[["arrivals.FUN"]], list(dat, at, seed)) } @@ -155,7 +156,7 @@ icm.seiqhrf <- function(param, init, control) { ## Initialization module if (!is.null(control[["initialize.FUN"]])) { - dat <- do.call(control[["initialize.FUN"]], list(param, init, control)) + dat <- do.call(control[["initialize.FUN"]], list(param, init, control, seed)) } # Timestep loop @@ -165,31 +166,31 @@ icm.seiqhrf <- function(param, init, control) { um <- control$user.mods if (length(um) > 0) { for (i in 1:length(um)) { - dat <- do.call(control[[um[i]]], list(dat, at)) + dat <- do.call(control[[um[i]]], list(dat, at, seed)) } } ## Infection if (!is.null(control[["infection.FUN"]])) { - dat <- do.call(control[["infection.FUN"]], list(dat, at)) + dat <- do.call(control[["infection.FUN"]], list(dat, at, seed)) } ## Recovery if (!is.null(control[["recovery.FUN"]])) { - dat <- do.call(control[["recovery.FUN"]], list(dat, at)) + dat <- do.call(control[["recovery.FUN"]], list(dat, at, seed)) } ## Departure Module if (!is.null(control[["departures.FUN"]])) { - dat <- do.call(control[["departures.FUN"]], list(dat, at)) + dat <- do.call(control[["departures.FUN"]], list(dat, at, seed)) } ## Arrival Module if (!is.null(control[["arrivals.FUN"]])) { - dat <- do.call(control[["arrivals.FUN"]], list(dat, at)) + dat <- do.call(control[["arrivals.FUN"]], list(dat, at, seed)) } diff --git a/R/internal_update_status.R b/R/internal_update.R similarity index 100% rename from R/internal_update_status.R rename to R/internal_update.R diff --git a/tests/testthat/test-icm-seiqhrf.R b/tests/testthat/test-icm-seiqhrf.R new file mode 100644 index 0000000000000000000000000000000000000000..b355d8e36fb375c6f74d1b92b02c3806246a7483 --- /dev/null +++ b/tests/testthat/test-icm-seiqhrf.R @@ -0,0 +1,29 @@ +test_that("Identical output as Churches' original function: icm_seiqhrf", { + + full_params <- set_param(s.num = 1000, nsteps = 10) + param <- full_params$param + init <- full_params$init + + #### default functions: initialize.FUN, infection.FUN, recovery.FUN, departures.FUN, arrivals.FUN + control1 <- full_params$control + ### Churches' original function: + control2 <- control1 + control2$initialize.FUN <- "initialize.icm" + control2$infection.FUN <- "infection.seiqhrf.icm" + control2$recovery.FUN <- "progress.seiqhrf.icm" + control2$departures.FUN <- "departures.seiqhrf.icm" + control2$arrivals.FUN <- "arrivals.seiqhrf.icm" + + No_seeds <- 10 + seed_list <- sample(1:1000, No_seeds) + comp <- rep(NA, No_seeds) + i <- 1 + for(seed in seed_list){ + sim1 <- icm.seiqhrf(param, init, control1, seed) + sim2 <- icm.seiqhrf(param, init, control2, seed) + comp[i] <- identical(sim1, sim2) + i <- i + 1 + } + + expect_equal(sum(comp), No_seeds) +})