include starting_values into compute_values

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: heemod
 Title: Markov Models for Health Economic Evaluations
-Version: 0.9.4
+Version: 0.9.4.9000
 Authors@R: c(
     person("Kevin", "Zarca", email = "[email protected]", role = c("aut", "cre")),
     person("Antoine", "Filipovic-Pierucci", role = "aut"),

NEWS.md

@@ -1,3 +1,5 @@
+## heemod 0.9.4.9000
+
 ## heemod 0.9.4
 
   * Compatibility with dplyr v0.8

R/states_define.R

@@ -23,14 +23,14 @@
 #' 
 #' @example inst/examples/example_define_state.R
 #'   
-define_state <- function(...) {
+define_state <- function(..., starting_values = define_starting_values()) {
   .dots <- lazyeval::lazy_dots(...)
-  define_state_(.dots)
+  define_state_(.dots, starting_values = starting_values)
 }
 
 #' @export
 #' @rdname define_state
-define_state_ <- function(.dots) {
+define_state_ <- function(.dots, starting_values) {
   check_names(names(.dots))
   structure(.dots, 
             class = c("state", class(.dots)))

R/strategy_eval.R

@@ -72,9 +72,7 @@ eval_strategy <- function(strategy, parameters, cycles,
   ) %>% 
     correct_counts(method = method)
 
-  values <- compute_values(states, count_table)
-  values[1, names(starting_values)] <- values[1, names(starting_values)] +
-    starting_values * n_indiv
+  values <- compute_values(states, count_table, starting_values)
 
   if (actually_expanded_something) {
     for (st in expanded$expanded_states) {
@@ -212,7 +210,7 @@ compute_counts.eval_matrix <- function(x, init, inflow, ...) {
 #' @keywords internal
 ## slightly harder to read than the original version, but much faster
 ## identical results to within a little bit of numerical noise
-compute_values <- function(states, counts) {
+compute_values <- function(states, counts, starting_values) {
   states_names <- get_state_names(states)
   state_values_names <- get_state_value_names(states)
   num_cycles <- nrow(counts)
@@ -240,9 +238,15 @@ compute_values <- function(states, counts) {
   vals_x_counts <- state_val_array * counts_mat
   wtd_sums <- rowSums(vals_x_counts, dims = 2)
   res <- data.frame(markov_cycle = states[[1]]$markov_cycle, wtd_sums)
+
   names(res)[-1] <- state_values_names
+
+  n_indiv <- sum(counts)
 
+  res[1, names(starting_values)] <- res[1, names(starting_values)] +
+    starting_values * n_indiv
   res
+
 }
 
 #' Expand States and Transition

tests/testthat/test_starting_values.R

@@ -0,0 +1,61 @@
+context("Starting values")
+
+par1 <- define_parameters(
+  a = .1,
+  b = 1 / (markov_cycle + 1)
+)
+
+mat1 <- define_transition(
+  state_names = c("X1", "X2"),
+  1-a, a,
+  1-b, b
+)
+s1 <- define_state(
+  x = 234,
+  y = 123
+)
+s2 <- define_state(
+  x = 987,
+  y = 1726
+)
+
+mod1 <- define_strategy(
+  transition = mat1,
+  X1 = s1,
+  X2 = s2
+)
+
+mod2 <- define_strategy(
+  transition = mat1,
+  X1 = s1,
+  X2 = s2,
+  starting_values = define_starting_values(
+    x = 10,
+    y = 20
+  )
+)
+
+test_that("define_strategy works as expected without starting_values", {
+  expect_equal(class(mod1), "uneval_model")
+  expect_equal(names(mod1), c("transition", "states", "starting_values"))
+  sv <- mod1$starting_values
+  expect_equal(class(sv), c("starting_values", "uneval_starting_values", "lazy_dots"))
+  expect_equal(sv$x$expr, 0)
+  expect_equal(sv$y$expr, 0)
+})
+
+test_that("define_strategy works as expected with starting_values", {
+  sv <- mod2$starting_values
+  expect_equal(class(sv), c("starting_values", "uneval_starting_values", "lazy_dots"))
+  expect_equal(sv$x$expr, 10)
+  expect_equal(sv$y$expr, 20)
+})
+
+test_that("starting_values is consistant", {
+  ru <- run_model(mod1, mod2, parameters = par1, cost = x, effect = y)
+  val1 <- ru$eval_strategy_list[[1]]$values
+  val2 <- ru$eval_strategy_list[[2]]$values
+  expect_equal(val2$x - val1$x, 10 * 1000)
+  expect_equal(val2$y - val1$y, 20 * 1000)
+
+})