#| purl = FALSE, #| include = FALSE # read vignette source chunks from corresponding testthat script knitr::read_chunk( file.path("..", "tests", "testthat", "test-model-Tegaderm.R") ) # read vignette build utility functions knitr::read_chunk(file.path("vutils.R"))
#| include = FALSE, #| purl = FALSE knitr::opts_chunk$set( collapse = TRUE, echo = FALSE, comment = "#>" )
#| gbp, #| purl = FALSE
library("rdecision") # nolint
This vignette is an example of modelling a decision tree using the rdecision
package, with probabilistic sensitivity analysis (PSA). It is based on the model
reported by Jenks et al [-@jenks2016] in which a transparent dressing used
to secure vascular catheters (Tegaderm CHG) was compared with a
standard dressing.
Eleven source variables were used in the model. The choice of variables, their distributions and their parameters are taken from Table 4 of Jenks et al [-@jenks2016], with the following additional information:
LogNormModVar
.The model variables were constructed as follows:
#| variables, #| echo = TRUE
Variables in the model may be included in the decision tree via mathematical expressions, which involve model variables and are themselves model variables. Forms of expression involving R functions and multiple model variables are supported, provided they conform to R syntax. The following code creates the model variable expressions to be used as values in the decision tree edges.
#| expressions, #| echo = TRUE
The following code constructs the decision tree based on Figure 2
of Jenks et al [-@jenks2016]. In the formulation used by rdecision
,
the decision tree is constructed from sets of decision, chance and
leaf nodes and from edges (actions and reactions).
Leaf nodes are synonymous with
pathways in Briggs' terminology [-@briggs2006]. The time horizon is
not stated explicitly in the model, and is assumed to be 7 days. It was implied
that the time horizon was ICU stay plus some follow-up, and the costs reflect
those incurred in that period, so the assumption of 7 days does not affect
the rdecision
implementation of the model.
The tree is somewhat more complex than Figure 2 of Jenks et al because it allows for patients to have more than one adverse event (AE) during their stay (whereas their Figure 2 implies that only one event per patient is possible). The rates of AE were estimated independently, and allow for multiple events, (figure 1).
In rdecision
, if the
probability associated with one of the reactions from any chance node is set
to missing (NA
), it will be computed before each evaluation of the tree to
ensure that the probabilities sum to unity.
#| tree, #| echo = TRUE
The draw
method of a DecisionTree
object creates a graphical representation
of the tree, as follows.
#| results = "hide", #| purl = FALSE, #| fig.keep = "all", #| fig.align = "center", #| fig.cap = "Figure 1. Decision tree for the Tegaderm model", #| echo = TRUE DT$draw(border = TRUE)
The model variables which will be associated with actions, reactions and leaf
nodes
can be tabulated using the method modvar_table
. This returns a data
frame describing each variable, its description, units and uncertainty
distribution. Variables inheriting from type ModVar
will be included in the
tabulation unless explicitly excluded, regular numeric values will not be
listed. In the Tegaderm model, the input model variables are in the following
table, with expression model variables excluded.
#| purl = FALSE local({ DF <- DT$modvar_table(expressions = FALSE) keep <- c("Description", "Distribution") pander::pander(DF[, keep], row.names = FALSE, digits = 3L, justify = "left") })
The point estimates, units and distributional properties are obtained from the same call, in the remaining columns.
#| purl = FALSE local({ DF <- DT$modvar_table(expressions = FALSE) DF$Variable <- paste(DF$Description, DF$Units, sep = ", ") keep <- c("Variable", "Mean", "Q2.5", "Q97.5") pander::pander(DF[, keep], row.names = FALSE, digits = 3L, justify = "lrrr") })
The following code runs a single model scenario, using the evaluate
method of a decision node to evaluate each pathway from the decision node,
shown in the table. This model did not consider utility, and the columns
associated with utility are removed.
#| basecase, #| echo = TRUE
#| purl = FALSE local({ keep <- c("Run", "d1", "Cost") pander::pander(RES[, keep], round = 2L, justify = "llr") })
The sensitivity of the decision tree results to each source model variable,
varied independently of the others, is demonstrated by a tornado diagram. The
method tornado
can be used to generate such a plot (and also provides a
tabulated version of the values used in the plot). Source variables are
varied over their 95% confidence limits (figure 2).
#| results = "hide", #| purl = FALSE, #| fig.keep = "all", #| fig.align = "center", #| fig.cap = "Figure 2. Tornado diagram for the Tegaderm model", #| echo = TRUE to <- DT$tornado( index = list(e10), ref = list(e9), draw = TRUE )
The object returned from method tornado
(to
) is a data frame which includes
the values of the cost difference when each model variable is univariately at
the limits of its 95% confidence interval, as follows:
#| purl = FALSE local({ to$Variable <- paste(to$Description, to$Units, sep = ", ") keep <- c("Variable", "LL", "UL", "outcome.min", "outcome.max") pander::pander(to[, keep], round = 2L, justify = "lrrrr", row.names = FALSE) })
Multivariate probabilistic sensitivity analysis is supported through the use of sampling model variables. The same call, with extra parameters, is used to run the PSA and save the results in a data frame. Additionally, the cost difference is computed for each run of the model, as follows:
#| PSA, #| echo = TRUE
The first few runs of PSA are as follows; the by = "run"
option reshapes the
table to give one row per simulation, rather than one row per run, per strategy.
#| purl = FALSE keep <- c("Run", "Cost.Tegaderm", "Cost.Standard", "Difference") pander::pander( head(psa[, keep], n = 10L), round = 2L, row.names = FALSE, justify = "lrrr" )
From PSA (r N
runs), the mean cost of treatment with Tegaderm
was r gbp(mean(psa$Cost.Tegaderm), p = TRUE)
GBP,
the mean cost of treatment with standard dressings was
r gbp(mean(psa$Cost.Standard), p = TRUE)
GBP
and the mean cost saving was r gbp(mean(psa$Difference), p = TRUE)
GBP. The
95% confidence interval for cost saving was
r gbp(quantile(psa$Difference, probs=c(0.025)), p = TRUE)
GBP to
r gbp(quantile(psa$Difference, probs=c(0.975)), p = TRUE)
GBP; the standard
deviation of the cost saving was r gbp(sd(psa$Difference), p = TRUE)
GBP.
Overall, r round(100 * sum(psa$Difference > 0.0) / nrow(psa), 2L)
% of runs
found that Tegaderm was cost saving. These results replicate those reported by
Jenks et al (saving of 72.90 GBP, 97.8% cases cost saving; mean cost of
standard dressing 151.29 GBP, mean cost of Tegaderm 77.75 GBP).
rm(psa)
Jenks et al modelled an additional scenario, in which the baseline rate
of CRBSI was 0.3 per 1000 catheter days (modelled as a Gamma distribution fitted
to a sample mean of 0.3 and a sample 95% confidence interval of 0.2 to 0.6). A
way to achieve this in rdecision
is to replace the model variable for the
baseline rate of CRBSI, and any other model variables that depend on it via
expressions, and then reconstruct the model, as follows.
#| scenario, #| echo = TRUE
The model for this scenario was run under PSA, as for the base case:
#| scenario-PSA, #| echo = TRUE
From PSA (r N
runs), the mean cost of treatment with Tegaderm
was r gbp(mean(psa$Cost.Tegaderm), p = TRUE)
GBP,
the mean cost of treatment with standard dressings was
r gbp(mean(psa$Cost.Standard), p = TRUE)
GBP
and the mean cost saving was r gbp(mean(psa$Difference), p = TRUE)
GBP. The
95% confidence interval for cost saving was
r gbp(quantile(psa$Difference, probs=c(0.025)), p = TRUE)
GBP to
r gbp(quantile(psa$Difference, probs=c(0.975)), p = TRUE)
GBP; the standard
deviation
of the cost saving was r gbp(sd(psa$Difference), p = TRUE)
GBP.
Overall, r round(100 * sum(psa$Difference > 0.0) / nrow(psa), 2L)
% of runs
found that Tegaderm was cost saving. These results replicate those reported by
Jenks et al (saving of 3.56 GBP, 57.9% cases cost saving; mean cost of
standard dressing 34.47 GBP, mean cost of Tegaderm 30.79 GBP).
Two threshold analyses were reported for this scenario. This can be achieved
in rdecision
by using the threshold
method of the decision tree. Firstly,
the threshold hazard ratio of a CRBSI with Tegaderm versus a CRBSI with a
standard dressing was varied in the range 0.1 to 0.9, as follows:
#| threshold-hr, #| echo = TRUE
This gave a threshold value of r round(hr_threshold, 2L)
, above which
Tegaderm became cost incurring (the reported threshold was 0.53).
Secondly, the cost of each CRBSI was varied between 0 GBP and 9900 GBP to find
the threshold of cost saving, as follows:
#| threshold-ccrbsi, #| echo = TRUE
This gave a threshold value of r gbp(c_crbsi_threshold, p = TRUE)
GBP, below
which Tegaderm became cost incurring (the reported threshold was 8000 GBP).
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.