56 lines
2.7 KiB
R
56 lines
2.7 KiB
R
test_that("every world and scenario loads", {
|
|
raw <- yaml::read_yaml(default_params_path())
|
|
for (w in names(raw$worlds)) for (s in names(raw$scenarios)) {
|
|
par <- load_params(w, s)
|
|
expect_equal(par$world, w)
|
|
expect_true(is.numeric(par$effect$relief))
|
|
}
|
|
expect_equal(load_params("W2")$treatment$window$style, 1.6)
|
|
expect_equal(load_params("W2")$treatment$window$z, 0.9) # untouched by the override
|
|
})
|
|
|
|
small_world <- function(world = "WR", scenario = "null", n = 4000) {
|
|
par <- load_params(world, scenario, overrides = list(size = list(n_physicians = 150)))
|
|
list(par = par, pop = make_population(par, n = n, seed = 11L))
|
|
}
|
|
|
|
test_that("under the sharp null, disease, death and negative controls are identical under every policy", {
|
|
sw <- small_world("WR", "null")
|
|
runs <- lapply(list(policy("natural"), policy("A"), policy("B1"), policy("B2"),
|
|
policy("seq_force", 3L)),
|
|
function(p) simulate_course(sw$pop, sw$par, p, seed = 5L, record = FALSE)$events)
|
|
for (r in runs[-1]) {
|
|
for (col in c("t_limb", "t_disease", "t_clti_code", "t_amp", "t_bypass", "t_death", "t_nco1", "t_nco2", "t_nce")) {
|
|
expect_identical(r[[col]], runs[[1]][[col]], info = col)
|
|
}
|
|
}
|
|
# MALE is not null: repeat revascularization needs an index PVI (D34)
|
|
expect_gt(cum_inc(runs[[2]]$t_male), cum_inc(runs[[3]]$t_male))
|
|
})
|
|
|
|
test_that("policies are followed", {
|
|
sw <- small_world("W0", "harm")
|
|
W <- sw$par$size$window
|
|
a <- simulate_course(sw$pop, sw$par, policy("A"), seed = 5L, record = FALSE)$events
|
|
# under A, everyone who survives month W-1 without a MALE event has had a PVI by then
|
|
# (death and MALE in a month come before that month's PVI decision)
|
|
free <- (is.na(a$t_death) | a$t_death > W - 1) & (is.na(a$t_male) | a$t_male > W - 1 | (!is.na(a$t_pvi) & a$t_pvi < a$t_male))
|
|
expect_true(all(!is.na(a$t_pvi[free]) & a$t_pvi[free] <= W - 1))
|
|
b1 <- simulate_course(sw$pop, sw$par, policy("B1"), seed = 5L, record = FALSE)$events
|
|
expect_false(any(b1$pvi_elective %in% TRUE & b1$t_pvi < W))
|
|
b2 <- simulate_course(sw$pop, sw$par, policy("B2"), seed = 5L, record = FALSE)$events
|
|
expect_false(any(b2$pvi_elective %in% TRUE))
|
|
})
|
|
|
|
test_that("records carry no latent columns and person-months end at death", {
|
|
par <- load_params("W5", "harm", overrides = list(size = list(n_physicians = 100)))
|
|
rec <- simulate_records(par, rep = 1L, n = 2000)
|
|
expect_true(assert_no_hidden(rec$patients))
|
|
expect_true(assert_no_hidden(rec$pm))
|
|
last <- rec$pm[, .(tmax = max(t)), by = id]
|
|
dead <- rec$patients[!is.na(t_death), .(id, t_death)]
|
|
chk <- merge(last, dead, by = "id")
|
|
expect_true(all(chk$tmax == chk$t_death))
|
|
expect_true(all(is.finite(rec$pm$sev_obs)))
|
|
})
|