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*^{1} 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*^{1},
with the following additional information:

- The baseline catheter-related blood stream infection (CRBSI) rate was modelled as a Gamma distribution fitted by the method of moments to a mean of 1.48 (per 1000 catheter days) and a standard deviation of 0.12 (per 1000 catheter days).
- The baseline local site infection (LSI) rate was modelled as a Gamma distribution fitted by the method of moments to a mean of 0.14 (per 1000 catheter days) and an assumed standard deviation of 0.5 (/1000 catheter days).
- The baseline rate of dermatitis was modelled as a Beta distribution, based on one observed case in a trial of 476 catheter uses.
- The effect size of Tegaderm, expressed as the hazard ratio of
Tegaderm compared with standard dressings for CRBSI and LSI, and the
relative risk of Tegaderm compared with standard dressings for
dermatitis, was modelled in each case using a log normal distribution.
This was fitted to a sample mean and sample standard deviation on the
natural scale, by using the “LN7” parametrization of
`LogNormModVar`

. - The probabilities of CRBSI and LSI for standard dressings (\(p\)) were modified by the hazard ratio \(r\) for Tegaderm using the form \(p * r\). This is an approximation which holds only for very small rates.
- Relative risks were also applied as multipliers. This is an approximation which holds only for very small rates.

The model variables were constructed as follows:

```
# baseline risk
<- GammaModVar$new(
r.CRBSI "Baseline CRBSI rate", "/1000 catheter days",
shape = (1.48 ^ 2L) / (0.12 ^ 2L),
scale = (0.12 ^ 2L) / 1.48
)<- GammaModVar$new(
r.LSI "Baseline LSI rate", "/1000 catheter days",
shape = (0.14 ^ 2L) / (0.5 ^ 2L),
scale = (0.5 ^ 2L) / 0.14
)<- BetaModVar$new(
r.Dermatitis "Baseline dermatitis risk", "/catheter", alpha = 1L, beta = 475L
)# relative effectiveness
<- LogNormModVar$new(
hr.CRBSI "Tegaderm CRBSI HR", "HR",
p1 = 0.402, p2 = (0.868 - 0.186) / (2L * 1.96), param = "LN7"
)<- LogNormModVar$new(
hr.LSI "Tegaderm LSI HR", "HR",
p1 = 0.402, p2 = (0.868 - 0.186) / (2L * 1.96), param = "LN7"
)<- LogNormModVar$new(
rr.Dermatitis "Tegaderm Dermatitis RR", "RR", p1 = 1.0, p2 = 0.5, param = "LN7"
)# cost variables
<- GammaModVar$new(
c.CRBSI "CRBSI cost", "GBP",
shape = (9900.0 ^ 2L) / (3000.0 ^ 2L),
scale = (3000.0 ^ 2L) / 9900.0
)<- GammaModVar$new(
c.LSI "LSI cost", "GBP",
shape = (100.0 ^ 2L) / (30.0 ^ 2L),
scale = (30.0 ^ 2L) / 100.0
)<- GammaModVar$new(
c.Dermatitis "Dermatitis cost", "GBP",
shape = (6.0 ^ 2L) / (3.0 ^ 2L),
scale = (3.0 ^ 2L) / 6.0
)# number of dressings and days with catheter
<- GammaModVar$new(
n.dressings "No. dressings", "dressings",
shape = (3.0 ^ 2L) / (2.0 ^ 2L),
scale = (2.0 ^ 2L) / 3.0
)<- GammaModVar$new(
n.cathdays "No. days with catheter", "days",
shape = (10.0 ^ 2L) / (5.0 ^ 2L),
scale = (5.0 ^ 2L) / 10.0
)
```

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.

```
<- ExprModVar$new(
p.CRBSI.S "P(CRBSI | standard dressing)", "P",
::quo(r.CRBSI * n.cathdays / 1000.0)
rlang
)<- ExprModVar$new(
p.CRBSI.T "P(CRBSI|Tegaderm)", "P",
::quo(p.CRBSI.S * hr.CRBSI)
rlang
)<- ExprModVar$new(
p.LSI.S "P(LSI | Standard)", "/patient",
::quo(r.LSI * n.cathdays / 1000.0)
rlang
)<- ExprModVar$new(
p.LSI.T "P(LSI | Tegaderm)", "P", rlang::quo(p.LSI.S * hr.LSI)
)<- ExprModVar$new(
p.Dermatitis.S "P(dermatitis | standard dressing)", "P",
::quo(r.Dermatitis)
rlang
)<- ExprModVar$new(
p.Dermatitis.T "P(dermatitis | Tegaderm)", "P",
::quo(p.Dermatitis.S * rr.Dermatitis)
rlang
)<- ExprModVar$new(
c.Tegaderm "Tegaderm CHG cost", "GBP", rlang::quo(6.26 * n.dressings)
)<- ExprModVar$new(
c.Standard "Standard dressing cost", "GBP", rlang::quo(1.54 * n.dressings)
)
```

The following code constructs the decision tree based on Figure 2 of
Jenks *et al*^{1}. 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^{2}. 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.

```
# create decision tree
<- as.difftime(7L, units = "days")
th # standard dressing
<- LeafNode$new("t01", interval = th)
t01 <- LeafNode$new("t02", interval = th)
t02 <- ChanceNode$new()
c01 <- Reaction$new(
e01 p = p.Dermatitis.S, cost = c.Dermatitis, label = "Dermatitis"
c01, t01,
)<- Reaction$new(
e02 p = NA_real_, cost = 0.0, label = "No dermatitis"
c01, t02,
)<- LeafNode$new("t03", interval = th)
t03 <- LeafNode$new("t04", interval = th)
t04 <- ChanceNode$new()
c02 <- Reaction$new(
e03 p = p.Dermatitis.S, cost = c.Dermatitis, label = "Dermatitis"
c02, t03,
)<- Reaction$new(
e04 p = NA_real_, cost = 0.0, label = "No dermatitis"
c02, t04,
)<- ChanceNode$new()
c03 <- Reaction$new(c03, c01, p = p.LSI.S, cost = c.LSI, label = "LSI")
e05 <- Reaction$new(c03, c02, p = NA_real_, cost = 0.0, label = "No LSI")
e06 <- LeafNode$new("t11", interval = th)
t11 <- LeafNode$new("t12", interval = th)
t12 <- ChanceNode$new()
c11 <- Reaction$new(
e11 p = p.Dermatitis.S, cost = c.Dermatitis, label = "Dermatitis"
c11, t11,
)<- Reaction$new(
e12 p = NA_real_, cost = 0.0, label = "No Dermatitis"
c11, t12,
)<- LeafNode$new("t13", interval = th)
t13 <- LeafNode$new("t14", interval = th)
t14 <- ChanceNode$new()
c12 <- Reaction$new(
e13 p = p.Dermatitis.S, cost = c.Dermatitis, label = "Dermatitis"
c12, t13,
)<- Reaction$new(
e14 p = NA_real_, cost = 0.0, label = "No dermatitis"
c12, t14,
)<- ChanceNode$new()
c13 <- Reaction$new(c13, c11, p = p.LSI.S, cost = c.LSI, label = "LSI")
e15 <- Reaction$new(c13, c12, p = NA_real_, cost = 0.0, label = "No LSI")
e16 <- ChanceNode$new()
c23 <- Reaction$new(c23, c03, p = p.CRBSI.S, cost = c.CRBSI, label = "CRBSI")
e21 <- Reaction$new(c23, c13, p = NA_real_, cost = 0.0, label = "No CRBSI")
e22
# Tegaderm branch
<- LeafNode$new("t31", interval = th)
t31 <- LeafNode$new("t32", interval = th)
t32 <- ChanceNode$new()
c31 <- Reaction$new(
e31 p = p.Dermatitis.T, cost = c.Dermatitis, label = "Dermatitis"
c31, t31,
)<- Reaction$new(
e32 p = NA_real_, cost = 0.0, label = "no dermatitis"
c31, t32,
)<- LeafNode$new("t33", interval = th)
t33 <- LeafNode$new("t34", interval = th)
t34 <- ChanceNode$new()
c32 <- Reaction$new(
e33 p = p.Dermatitis.T, cost = c.Dermatitis, label = "Dermatitis"
c32, t33,
)<- Reaction$new(
e34 p = NA_real_, cost = 0.0, label = "No dermatitis"
c32, t34,
)<- ChanceNode$new()
c33 <- Reaction$new(c33, c31, p = p.LSI.T, cost = c.LSI, label = "LSI")
e35 <- Reaction$new(c33, c32, p = NA_real_, cost = 0.0, label = "No LSI")
e36 <- LeafNode$new("t41", interval = th)
t41 <- LeafNode$new("t42", interval = th)
t42 <- ChanceNode$new()
c41 <- Reaction$new(
e41 p = p.Dermatitis.T, cost = c.Dermatitis, label = "Dermatitis"
c41, t41,
)<- Reaction$new(
e42 p = NA_real_, cost = 0.0, label = "No dermatitis"
c41, t42,
)<- LeafNode$new("t43", interval = th)
t43 <- LeafNode$new("t44", interval = th)
t44 <- ChanceNode$new()
c42 <- Reaction$new(
e43 p = p.Dermatitis.T, cost = c.Dermatitis, label = "Dermatitis"
c42, t43,
)<- Reaction$new(
e44 p = NA_real_, cost = 0.0, label = "No dermatitis"
c42, t44,
)<- ChanceNode$new()
c43 <- Reaction$new(c43, c41, p = p.LSI.T, cost = c.LSI, label = "LSI")
e45 <- Reaction$new(c43, c42, p = NA_real_, cost = 0.0, label = "No LSI")
e46 <- ChanceNode$new()
c53 <- Reaction$new(c53, c43, p = p.CRBSI.T, cost = c.CRBSI, label = "CRBSI")
e51 <- Reaction$new(c53, c33, p = NA_real_, cost = 0.0, label = "no CRBSI")
e52
# decision node
<- DecisionNode$new("d1")
d1 <- Action$new(d1, c23, label = "Standard", cost = c.Standard)
e9 <- Action$new(d1, c53, label = "Tegaderm", cost = c.Tegaderm)
e10
# create decision tree
<- list(
V
d1,
c01, c02, c03, c11, c12, c13, c23, c31, c32, c33, c41, c42, c43, c53,
t01, t02, t03, t04, t11, t12, t13, t14, t31, t32, t33, t34,
t41, t42, t43, t44
)<- list(
E
e01, e02, e03, e04, e05, e06, e11, e12, e13, e14, e15, e16, e21, e22,
e31, e32, e33, e34, e35, e36, e41, e42, e43, e44, e45, e46, e51, e52,
e9, e10
)<- DecisionTree$new(V, E) DT
```

The `draw`

method of a `DecisionTree`

object
creates a graphical representation of the tree, as follows.

`$draw(border = TRUE) DT`

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.

Description | Distribution |
---|---|

Dermatitis cost | Ga(4,1.5) |

Baseline dermatitis risk | Be(1,475) |

CRBSI cost | Ga(10.89,909.091) |

Baseline CRBSI rate | Ga(152.111,0.01) |

No. days with catheter | Ga(4,2.5) |

Tegaderm Dermatitis RR | LN(-0.112,0.472) |

LSI cost | Ga(11.111,9) |

Baseline LSI rate | Ga(0.078,1.786) |

Tegaderm LSI HR | LN(-0.997,0.414) |

No. dressings | Ga(2.25,1.333) |

Tegaderm CRBSI HR | LN(-0.997,0.414) |

The point estimates, units and distributional properties are obtained from the same call, in the remaining columns.

Variable | Mean | Q2.5 | Q97.5 |
---|---|---|---|

Dermatitis cost, GBP | 6 | 1.63 | 13.2 |

Baseline dermatitis risk, /catheter | 0.0021 | 5.33e-05 | 0.00774 |

CRBSI cost, GBP | 9900 | 4922 | 16589 |

Baseline CRBSI rate, /1000 catheter days | 1.48 | 1.25 | 1.72 |

No. days with catheter, days | 10 | 2.72 | 21.9 |

Tegaderm Dermatitis RR, RR | 1 | 0.354 | 2.26 |

LSI cost, GBP | 100 | 50.1 | 167 |

Baseline LSI rate, /1000 catheter days | 0.14 | 3.92e-21 | 1.47 |

Tegaderm LSI HR, HR | 0.402 | 0.164 | 0.831 |

No. dressings, dressings | 3 | 0.433 | 8 |

Tegaderm CRBSI HR, HR | 0.402 | 0.164 | 0.831 |

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.

`<- DT$evaluate() RES `

Run | d1 | Cost |
---|---|---|

1 | Standard | 151.3 |

1 | Tegaderm | 77.75 |

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).

```
<- DT$tornado(
to 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:

Variable | LL | UL | outcome.min | outcome.max |
---|---|---|---|---|

No. days with catheter, days | 2.72 | 21.92 | 9.74 | 178.1 |

CRBSI cost, GBP | 4922 | 16589 | 29.48 | 132.7 |

Tegaderm CRBSI HR, HR | 0.16 | 0.83 | 108.5 | 10.67 |

No. dressings, dressings | 0.43 | 8 | 85.66 | 49.95 |

Baseline CRBSI rate, /1000 catheter days | 1.25 | 1.72 | 60.17 | 88 |

Baseline LSI rate, /1000 catheter days | 0 | 1.47 | 73.46 | 74.34 |

LSI cost, GBP | 50.12 | 166.8 | 73.5 | 73.6 |

Tegaderm LSI HR, HR | 0.16 | 0.83 | 73.58 | 73.48 |

Tegaderm Dermatitis RR, RR | 0.35 | 2.26 | 73.55 | 73.53 |

Dermatitis cost, GBP | 1.63 | 13.15 | 73.54 | 73.54 |

Baseline dermatitis risk, /catheter | 0 | 0.01 | 73.54 | 73.54 |

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:

```
<- 1000L
N <- DT$evaluate(setvars = "random", by = "run", N = N)
psa $Difference <- psa$Cost.Standard - psa$Cost.Tegaderm psa
```

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.

Run | Cost.Tegaderm | Cost.Standard | Difference |
---|---|---|---|

1 | 59.39 | 104.6 | 45.24 |

2 | 103.3 | 352.1 | 248.8 |

3 | 69.59 | 46.41 | -23.19 |

4 | 49.67 | 103.6 | 53.94 |

5 | 96.39 | 226.7 | 130.3 |

6 | 140.1 | 307.8 | 167.7 |

7 | 71.44 | 132.4 | 60.99 |

8 | 45.5 | 119.4 | 73.94 |

9 | 54.74 | 119.1 | 64.38 |

10 | 18.27 | 58.35 | 40.08 |

From PSA (1000 runs), the mean cost of treatment with Tegaderm was
77.91 GBP, the mean cost of treatment with standard dressings was 150.37
GBP and the mean cost saving was 72.47 GBP. The 95% confidence interval
for cost saving was -5.17 GBP to 227.35 GBP; the standard deviation of
the cost saving was 64.63 GBP. Overall, 96.8% 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).

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.

```
<- GammaModVar$new(
r.CRBSI "Baseline CRBSI rate", "/1000 catheter days",
shape = (0.30 ^ 2L) / (0.102 ^ 2L),
scale = (0.102 ^ 2L) / 0.30
)<- ExprModVar$new(
p.CRBSI.S "P(CRBSI | standard dressing)", "P",
::quo(r.CRBSI * n.cathdays / 1000.0)
rlang
)<- ExprModVar$new(
p.CRBSI.T "P(CRBSI|Tegaderm)", "P",
::quo(p.CRBSI.S * hr.CRBSI)
rlang
)<- Reaction$new(c23, c03, p = p.CRBSI.S, cost = c.CRBSI, label = "CRBSI")
e21 <- Reaction$new(c23, c13, p = NA_real_, cost = 0.0, label = "No CRBSI")
e22 <- Reaction$new(c53, c43, p = p.CRBSI.T, cost = c.CRBSI, label = "CRBSI")
e51 <- Reaction$new(c53, c33, p = NA_real_, cost = 0.0, label = "no CRBSI")
e52 <- list(
E
e01, e02, e03, e04, e05, e06, e11, e12, e13, e14, e15, e16, e21, e22,
e31, e32, e33, e34, e35, e36, e41, e42, e43, e44, e45, e46, e51, e52,
e9, e10
)<- DecisionTree$new(V, E) DT
```

The model for this scenario was run under PSA, as for the base case:

```
<- 1000L
N <- DT$evaluate(setvars = "random", by = "run", N = N)
psa $Difference <- psa$Cost.Standard - psa$Cost.Tegaderm psa
```

From PSA (1000 runs), the mean cost of treatment with Tegaderm was
30.51 GBP, the mean cost of treatment with standard dressings was 33.95
GBP and the mean cost saving was 3.45 GBP. The 95% confidence interval
for cost saving was -27.50 GBP to 38.89 GBP; the standard deviation of
the cost saving was 16.98 GBP. Overall, 57.2% 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:

```
<- DT$threshold(
hr_threshold index = list(e10),
ref = list(e9),
outcome = "saving",
mvd = "Tegaderm CRBSI HR",
a = 0.1,
b = 0.9,
tol = 0.01
)
```

This gave a threshold value of 0.53, 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:

```
<- DT$threshold(
c_crbsi_threshold index = list(e10),
ref = list(e9),
outcome = "saving",
mvd = "CRBSI cost",
a = 0.0,
b = 9900.0,
tol = 10.0
)
```

This gave a threshold value of 7,840.72 GBP, below which Tegaderm became cost incurring (the reported threshold was 8000 GBP).

1.

Jenks, M., Craig, J., Green, W., Hewitt, N.,
Arber, M. & Sims, A. J. Tegaderm
CHG IV securement dressing for central venous
and arterial catheter insertion sites: A NICE medical
technology guidance. *Applied Health Economics and Health
Policy* **14,** 135–149 (2016).

2.

Briggs, A., Claxton, K. & Sculpher, M.
*Decision modelling for health economic evaluation*. (Oxford
University Press, 2006).