test_that("hospitalization event scheduling works, vector probabilities", {
dt <- 1
N_age <- 2
N <- 2e4
ages <- rep(1:N_age, each = N/N_age)
parameters <- list(
dt = dt,
hosp_beds = N*2,
ICU_beds = N*2,
population = N
)
ICU_states <- c('IMVGetDie', 'IMVGetLive')
hosp_states <- c('IOxGetDie', 'IOxGetLive', 'IRec')
variables <- list(
discrete_age = IntegerVariable$new(ages),
states = CategoricalVariable$new(categories = c("S", ICU_states, hosp_states), initial_values = rep("S", N))
)
events <- create_events(parameters = parameters)
parameters$prob_severe <- c(0.5, 0.1)
parameters$prob_severe_death_treatment <- c(0.9, 0.99)
parameters$prob_severe_death_no_treatment <- c(0.9, 0.99)
parameters$prob_non_severe_death_treatment <- c(0.9, 0.99)
parameters$prob_non_severe_death_no_treatment <- c(0.9, 0.99)
hosp_scheduler <- create_hospital_scheduler_listener(parameters = parameters, variables = variables, events = events)
# all empty
expect_true(all(vapply(X = events, FUN = function(e) {
e$get_scheduled()$size() < 1
}, FUN.VALUE = logical(1), USE.NAMES = FALSE)))
# schedule the pop
hosp_scheduler(timestep = 1, hospitalised = Bitset$new(size = N)$insert(1:N))
# check results
sizes <- vapply(X = events, FUN = function(e) {
e$get_scheduled()$size()
}, FUN.VALUE = numeric(1), USE.NAMES = TRUE)
expect_equal(sum(sizes), N)
expect_true(abs(sum(sizes[c("imv_get_live", "imv_get_die")]) - sum(N/N_age * parameters$prob_severe)) / sum(N/N_age * parameters$prob_severe) < 0.05)
expect_true(abs(sum(sizes[c("iox_get_live", "iox_get_die")]) - sum(N/N_age * (1 - parameters$prob_severe))) / sum(N/N_age * parameters$prob_severe) < 0.05)
expect_true(sizes[["imv_get_die"]]/sizes[["imv_get_live"]] > 1)
expect_true(sizes[["iox_get_die"]]/sizes[["iox_get_live"]] > 1)
})
test_that("hospitalization event scheduling works, matrix probabilities", {
dt <- 0.5
N_age <- 2
N <- 2e4
ages <- rep(1:N_age, each = N/N_age)
parameters <- list(
dt = dt,
hosp_beds = N*2,
ICU_beds = N*2,
population = N
)
ICU_states <- c('IMVGetDie', 'IMVGetLive')
hosp_states <- c('IOxGetDie', 'IOxGetLive', 'IRec')
variables <- list(
discrete_age = IntegerVariable$new(ages),
states = CategoricalVariable$new(categories = c("S", ICU_states, hosp_states), initial_values = rep("S", N))
)
events <- create_events(parameters = parameters)
parameters$prob_severe <- matrix(c(0.05, 0.01, 0.5, 0.1), 2, 2)
parameters$prob_severe_death_treatment <- matrix(c(0.09, 0.099, 0.9, 0.99), 2, 2)
parameters$prob_severe_death_no_treatment <- matrix(c(0.09, 0.099, 0.9, 0.99), 2, 2)
parameters$prob_non_severe_death_treatment <- matrix(c(0.09, 0.099, 0.9, 0.99), 2, 2)
parameters$prob_non_severe_death_no_treatment <- matrix(c(0.09, 0.099, 0.9, 0.99), 2, 2)
hosp_scheduler <- create_hospital_scheduler_listener(parameters = parameters, variables = variables, events = events)
# all empty
expect_true(all(vapply(X = events, FUN = function(e) {
e$get_scheduled()$size() < 1
}, FUN.VALUE = logical(1), USE.NAMES = FALSE)))
# schedule the pop
set.seed(87753919L)
hosp_scheduler(timestep = 4, hospitalised = Bitset$new(size = N)$insert(1:N))
# check results
sizes <- vapply(X = events, FUN = function(e) {
e$get_scheduled()$size()
}, FUN.VALUE = numeric(1), USE.NAMES = TRUE)
expect_equal(sum(sizes), N)
expect_true(abs(sum(sizes[c("imv_get_live", "imv_get_die")]) - sum(N/N_age * parameters$prob_severe[, 2])) / sum(N/N_age * parameters$prob_severe[, 2]) < 0.05)
expect_true(abs(sum(sizes[c("iox_get_live", "iox_get_die")]) - sum(N/N_age * (1 - parameters$prob_severe[, 2]))) / sum(N/N_age * parameters$prob_severe[ ,2]) < 0.05)
expect_true(sizes[["imv_get_die"]]/sizes[["imv_get_live"]] > 1)
expect_true(sizes[["iox_get_die"]]/sizes[["iox_get_live"]] > 1)
# check C++ is identical
events <- create_events(parameters = parameters)
hosp_scheduler_cpp <- create_hospital_scheduler_listener_cpp(parameters, variables, events)
# all empty
expect_true(all(vapply(X = events, FUN = function(e) {
e$get_scheduled()$size() < 1
}, FUN.VALUE = logical(1), USE.NAMES = FALSE)))
# schedule the pop
set.seed(87753919L)
bset <- Bitset$new(size = N)$insert(1:N)
evaluate_listener_cpp(listener = hosp_scheduler_cpp, target = bset$.bitset, t = 4)
sizes_cpp <- vapply(X = events, FUN = function(e) {
e$get_scheduled()$size()
}, FUN.VALUE = numeric(1), USE.NAMES = TRUE)
# equal
expect_equal(sizes, sizes_cpp)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.