Nothing
test_that(
"State definition", {
s1 <- define_state(
x = 234,
y = 123
)
s2 <- define_state(
x = 987,
y = 1726
)
expect_equal(names(s1), c(".dots", "starting_values"))
expect_equal(names(s1), names(s2))
expect_output(
str(s1$.dots),
'List of 2
$ x: language ~234',
fixed = TRUE
)
expect_output(
print(s1),
'A state with 2 values.
x = 234
y = 123',
fixed = TRUE
)
expect_error(
define_state(234, 54)
)
expect_output(
str(
modify(
s1,
x = 111
)
),
"List of 2
$ x: language ~111",
fixed = TRUE
)
expect_error(
modify(
s1,
z = 111
)
)
expect_error(
define_state(
model_time = 876
)
)
expect_error(
modify(
s1,
model_time = 678
)
)
expect_equal(
get_state_value_names(s1),
c("x", "y")
)
expect_output(print(s2 |>
modify(starting_values = define_starting_values(x = 100))),
"A state with 2 values and 1 starting value.
x = 987
y = 1726
Start
x = 100", fixed = TRUE)
expect_error(s2 |>
modify(starting_values = list(x = 100)), "Incorrect length", fixed = TRUE)
}
)
test_that(
"State list definition", {
s1 <- define_state(
x = 234,
y = 123
)
s2 <- define_state(
x = 987,
y = 1726
)
sl1 <- heemod:::define_state_list(
X1 = s1,
X2 = s2
)
sl2 <- heemod:::define_state_list(
s1,
s2
)
expect_output(
str(sl1),
"List of 2
$ X1:List of 2
..$ .dots :List of 2
.. ..$ x: language ~234",
fixed = TRUE
)
expect_output(
print(sl1),
"A list of 2 states with 2 values each.
State names:
X1
X2
State values:
x
y"
)
expect_output(
str(sl2),
"List of 2
$ A:List of 2
..$ .dots :List of 2
.. ..$ x: language ~234",
fixed = TRUE
)
expect_output(
str(
modify(
sl1,
X1 = s2
)
),
"List of 2
$ X1:List of 2
..$ .dots :List of 2
.. ..$ x: language ~987",
fixed = TRUE
)
expect_output(
str(
modify(
sl1,
X3 = s2
)
),
"List of 3
$ X1:List of 2
..$ .dots :List of 2
.. ..$ x: language ~234",
fixed = TRUE
)
expect_error(
heemod:::define_state_list(
X1 = s1,
X1 = s2
)
)
expect_error(
heemod:::define_state_list(
X1 = define_state(x = 1, y = 2),
X2 = define_state(x = 1)
)
)
expect_error(
heemod:::define_state_list(
X1 = define_state(x = 1, y = 2),
X2 = define_state(x = 1, z = 2)
)
)
expect_warning(
heemod:::define_state_list(
X1 = s1,
s2
)
)
expect_error(
heemod:::define_state_list(
1:2,
s1
)
)
expect_equal(
get_state_number(sl1), 2
)
expect_equal(
get_state_names(sl1),
c("X1", "X2")
)
expect_equal(
get_state_value_names(sl1),
c("x", "y")
)
}
)
test_that(
"State evaluation", {
par1 <- define_parameters(
a = 12,
b = a + 4 * model_time
)
sl <- define_state_list(
X1 = define_state(A = a),
X2 = define_state(A = b)
)
e_par1 <- eval_parameters(
par1, 10
)
e_st <- eval_state_list(sl, e_par1)
expect_output(
print(e_st),
"2 evaluated states, 10 Markov cycles.",
fixed = TRUE
)
expect_equal(names(e_st), c(".dots", "starting_values"))
expect_output(
str(e_st$.dots),
"..$ model_time: int [1:10] 1 2 3 4 5 6 7 8 9 10
..$ A :",
fixed = TRUE
)
expect_equal(
get_state_number(e_st), 2
)
expect_equal(
get_state_names(e_st),
c("X1", "X2")
)
expect_equal(
get_state_value_names(e_st),
c("A")
)
}
)
test_that(
"Discounting works", {
par1 <- define_parameters(
a = .1,
b = 1 / (model_time + 1),
cte1 = 234,
cte2 = 123,
cte3 = 987,
cte4 = 1726
)
mat1 <- define_transition(
state_names = c("X1", "X2"),
1-a, a,
1-b, b
)
s1 <- define_state(
x = discount(234, .05),
y = discount(123, .1) * 1
)
f <- function(x) x
s2 <- define_state(
x = f(discount(987, .2)),
y = discount(r = .1, 1726)
)
mod1 <- define_strategy(
transition = mat1,
X1 = s1,
X2 = s2
)
s3 <- define_state(
x = discount(cte1, .05),
y = discount(cte2, .1)
)
s4 <- define_state(
x = discount(cte3, .2),
y = discount(cte4, .1)
)
mod2 <- define_strategy(
transition = mat1,
X1 = s3,
X2 = s4
)
res <- run_model(
mod1, mod2,
parameters = par1, cost = x, effect = y
)
expect_equal(
summary(res)$res_comp$.icer, c(NA, NaN)
)
discount <- function(x, r) x
expect_warning(
run_model(
mod1, mod2,
parameters = par1, cost = x, effect = y
),
"version"
) |>
suppressWarnings()
}
)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.