From be1514ca8f7d49a0710e2506e32ba9a31f0c4b4f Mon Sep 17 00:00:00 2001
From: KZARCA <kevin.zarca@gmail.com>
Date: Thu, 20 Jun 2019 11:44:21 +0200
Subject: [PATCH] include starting_values into compute_values

---
 DESCRIPTION                           |  2 +-
 NEWS.md                               |  2 +
 R/states_define.R                     |  6 +--
 R/strategy_eval.R                     | 12 ++++--
 tests/testthat/test_starting_values.R | 61 +++++++++++++++++++++++++++
 5 files changed, 75 insertions(+), 8 deletions(-)
 create mode 100644 tests/testthat/test_starting_values.R

diff --git a/DESCRIPTION b/DESCRIPTION
index 99f3dd66..1cc05f7b 100644
--- a/DESCRIPTION
+++ b/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 = "kevin.zarca@gmail.com", role = c("aut", "cre")),
     person("Antoine", "Filipovic-Pierucci", role = "aut"),
diff --git a/NEWS.md b/NEWS.md
index 9011b288..dbfac3da 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,5 @@
+## heemod 0.9.4.9000
+
 ## heemod 0.9.4
 
   * Compatibility with dplyr v0.8
diff --git a/R/states_define.R b/R/states_define.R
index 4e5bc0a6..83118944 100644
--- a/R/states_define.R
+++ b/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)))
diff --git a/R/strategy_eval.R b/R/strategy_eval.R
index 102f3e1d..6a1b6e74 100644
--- a/R/strategy_eval.R
+++ b/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
diff --git a/tests/testthat/test_starting_values.R b/tests/testthat/test_starting_values.R
new file mode 100644
index 00000000..a08cf90f
--- /dev/null
+++ b/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)
+  
+})