Merge branch 'hotfix/0.7.1'

DESCRIPTION

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

NEWS.md

@@ -1,3 +1,9 @@
+# heemod 0.7.1
+
+## Bugfixes
+
+  * Fixed an error resulting in incorrect covariance analysis results when relations between values and parameters were negative.
+
 # heemod 0.7.0
 
 ## Breaking changes

R/covariance.R

@@ -30,14 +30,16 @@ compute_cov <- function(psa) {
     ))
     res <- stats::lm(form, data = data_trans)
 
-    tot <- sum(stats::coef(res)[-1])
+    val <- abs(stats::coef(res)[-1])
+    tot <- sum(val)
     r2 <- summary(res)$r.squared
     if (r2 < .99) {
       warning(sprintf(
-        "Only %.0f%% of variance explained, results may be inaccurate."
+        "Only %.0f%% of variance explained, results may be inaccurate.",
+        r2 * 100
       ))
     }
-    as.data.frame(as.list(stats::coef(res)[-1] / tot * r2))
+    as.data.frame(as.list(val / tot * r2))
   }
 
   psa$psa %>% 

R/strategy_print.R

@@ -126,8 +126,7 @@ plot.run_model <- function(x, type = c("counts", "ce", "values"),
                         y = ".cost",
                         label = ".strategy_names")) +
         ggplot2::geom_line(data = tab_ce[tab_ce$.strategy_names %in% ef, ]) +
-        ggplot2::geom_point() +
-        ggplot2::geom_text(hjust = 1) +
+        ggplot2::geom_label() +
         ggplot2::xlab("Effect") +
         ggplot2::ylab("Cost")
     },

inst/examples/example_update.R

@@ -44,7 +44,7 @@ res <- run_model(
 
 # generating table with new parameter sets
 new_tab <- data.frame(
-  age_init = 40:80
+  age_init = 40:45
 )
 
 # with run_model result
@@ -55,8 +55,8 @@ summary(ndt)
 # using weights
 
 new_tab2 <- data.frame(
-  age_init = 40:80,
-  .weights = runif(41)
+  age_init = 40:45,
+  .weights = runif(6)
 )
 ndt2 <- update(res, newdata = new_tab2)
 

inst/tmp/j-multiple.Rmd

@@ -0,0 +1,159 @@
+---
+title: "Results with more than 2 Strategies"
+date: "`r Sys.Date()`"
+output:
+  rmarkdown::html_vignette:
+    toc: true
+vignette: >
+  %\VignetteIndexEntry{Results with more than 2 Strategies}
+  %\VignetteEngine{knitr::rmarkdown}
+  \usepackage[utf8]{inputenc}
+---
+
+```{r, echo=FALSE, include=FALSE}
+library(heemod)
+library(ggplot2)
+```
+
+We define some strategies.
+
+```{r}
+sA <- define_state(
+  cost = 1,
+  ut = 1
+)
+sA2 <- define_state(
+  cost = c1,
+  ut = 1
+)
+sAmax <- define_state(
+  cost = c1+.5,
+  ut = 1.01
+)
+sAmaxx <- define_state(
+  cost = c1 + 1,
+  ut = 1.01
+)
+sAmaxx2 <- define_state(
+  cost = c1 + .6,
+  ut = 1.05
+)
+sB <- define_state(
+  cost = 0,
+  ut = 0
+)
+sX <- define_state(
+  cost = .9,
+  ut = 1.1
+)
+
+param <- define_parameters(
+  rrII = .8,
+  rrIII = .7,
+  c1 = 1
+)
+
+mI <- define_transition(
+  C, .5,
+  0, 1
+)
+mII <- define_transition(
+  C, .5 * rrII,
+  0, 1
+)
+mIII <- define_transition(
+  C, .5 * rrIII,
+  0, 1
+)
+sI <- define_strategy(
+  sA, sB,
+  transition = mI
+)
+sII <- define_strategy(
+  sA2, sB,
+  transition = mII
+)
+sIII <- define_strategy(
+  sAmaxx, sB,
+  transition = mII
+)
+sIV <- define_strategy(
+  sAmax, sB,
+  transition = mIII
+)
+sV <- define_strategy(
+  sX, sB,
+  transition = mI
+)
+sVI <- define_strategy(
+  sAmaxx2, sB,
+  transition = mII
+)
+
+res <- run_model(
+  A=sI, C=sII, D=sIII, F=sIV, B=sV, E=sVI,
+  parameters = param,
+  cycles = 10,
+  cost = cost, effect = ut
+)
+```
+
+We can look at the CE plot to understand what is going on:
+
+```{r}
+plot(res, type = "ce") +
+  geom_hline(yintercept = 0, linetype = "dashed") +
+  geom_vline(xintercept = 0, linetype = "dashed")
+```
+
+The efficiency frontier is B, C, F. A is dominated by B, D by F, and E is under extended domination by C and F. By default the plot is centered on B, the strategy at the root at the efficiency frontier. This can be changed with the `central_strategy` argument (this is just an aesthetic change).
+
+```{r}
+plot(run_model(
+  A=sI, C=sII, D=sIII, F=sIV, B=sV, E=sVI,
+  parameters = param,
+  cycles = 10,
+  cost = cost, effect = ut,
+  central_strategy = "A"
+), type = "ce") +
+  geom_hline(yintercept = 0, linetype = "dashed") +
+  geom_vline(xintercept = 0, linetype = "dashed")
+```
+
+We can look at the summary statistics:
+
+```{r}
+res
+```
+
+The *Values* section reports total absolute values. The *Differences* section reports incremental differences. We can see that D, E and F all take C as a reference. We can alos see there is no incremental differences represented for A.
+
+Let us try a PSA:
+
+```{r}
+dpsa <- define_psa(
+  rrII ~ lognormal(.8, .1),
+  rrIII ~ lognormal(.7, .1),
+  c1 ~ normal(1, .1)
+)
+
+use_cluster(4)
+psa <- run_psa(res, dpsa, 1e3)
+close_cluster()
+```
+
+Classic CE plot (the central model depends on the `central_strategy` defined in `run_model()`):
+
+```{r}
+plot(psa) +
+  geom_hline(yintercept = 0, linetype = "dashed") +
+  geom_vline(xintercept = 0, linetype = "dashed")
+```
+
+And PSA:
+
+```{r}
+plot(psa, type = "ac", max_wtp = 200)
+```
+
+