In n8thangreen/LTBIdiagTST: Latent TB infection cost-effectiveness analysis

knitr::opts_chunk$set(echo = TRUE)

We will replicate the Excel TB TST-T-SPOT.TB cost-effectiveness model. (File name latesttree.xls.)

Set-up

library(readr)
library(dplyr)
library(tibble)
library(reshape2)
library(assertthat)
library(CEdecisiontree)
library(purrr)

Load in the data.

load(here::here("data", "params.RData"))
load(here::here("data", "trees.RData"))

This included the tree structure variables, the cost and probability arrays, the mapping arrays that inform which nodes have which label with have what cost.

To demonstrate, let us look at the TST and T-SPOT scenario. The decision tree is defined in terms of parents and children in a list.

head(TST_TSPOT_tree, 5)

In order to assign values to the tree we first transform this to a (sparse) matrix format.

# probs <- child_list_to_transmat(TST_tree)
# probs <- child_list_to_transmat(QFT_tree)
# probs <- child_list_to_transmat(TSPOT_tree)
# probs <- child_list_to_transmat(TST_QFT_tree)
probs <- child_list_to_transmat(TST_TSPOT_tree)
head(probs)

empty_transmat <-
  as_tibble(matrix(NA_real_,
                   nrow = nrow(probs), ncol = ncol(probs)),
            .name_repair = "minimal")

Next, we specify the labels for each of the edge (or correspondingly to node). We need to do this separately for the probabilities and costs.

# pname_from_to <- TST_pname_from_to
# pname_from_to <- QFT_pname_from_to
# pname_from_to <- TSPOT_pname_from_to
# pname_from_to <- TST_QFT_pname_from_to
pname_from_to <- TST_TSPOT_pname_from_to
pname_from_to

# cname_from_to <- TST_cname_from_to
# cname_from_to <- QFT_cname_from_to
# cname_from_to <- TSPOT_cname_from_to
# cname_from_to <- TST_QFT_cname_from_to
cname_from_to <- TST_TSPOT_cname_from_to
cname_from_to

Insert probabilities into decision tree

Now that we've set-up the framework for the decision tree, we can assign the input data to it. The probability data are in the form of a list (this is useful for when we want to sample from a distribution later). Lets transform to an array.

label_probs_long <-
  as_tibble(label_probs) %>%
  melt(value.name = "prob",
       variable.name = "name")

Insert the appropriate probabilities by converting the transition matrix to long format, matching branches to labels, matching labels to probabilities and then filling in missing probabilities so that pairs of branches sum to one.

probs_new <-
  probs %>%
  transmat_to_long() %>%
  match_branch_to_label(pname_from_to) %>%
  match_branchlabel_to_prob(label_probs_long) %>%
  fill_complementary_probs()

probs_new

Finally, we insert these new probabilities in to the decision tree.

probs <- insert_to_probmat(dat = probs_new,
                           mat = empty_transmat)
head(probs)

Insert costs into decision tree

We essentially do the same thing now for costs. Convert from list to dataframe.

label_cost_long <-
  as_tibble(label_costs) %>%
  melt(value.name = "cost",
       variable.name = "name")

head(label_cost_long)

Join the cost names and their associated branches in to a single array.

costs_names <-
  merge(cname_from_to, label_cost_long,
        by = "name", all.x = TRUE) %>%
  mutate(from = as.numeric(as.character(from)),
         to = as.numeric(as.character(to)))
costs_names

Finally, we insert these costs in to the decision tree.

costs <- insert_to_costmat(dat = costs_names,
                           mat = empty_transmat)
head(costs)

Run model

See the CEdecisiontree package for how to use the dectree_expected_value() function. Here we provide the matrix format arguments.

TST_model <-
  define_model(transmat = list(prob = probs,
                               vals = costs))

res <-
  dectree_expected_values(TST_model)

res[1] + label_costs$`TB special nurse visit`

# 214.054 in xls

Deterministic sensitivity analysis

Simply repeating the same set of values, we can demonstrate running multiple tree calculations. We show how to use the long format to specify the tree as the input argument to dectree_expected_value().

# list of deterministic scenarios

# create combined tree long format dataframe
all_long <-
  merge(costs_names, probs_new,
        all = TRUE, by = c("from", "to"),
        suffixes = c(".cost", ".prob")) %>%
  rename(vals = cost)

head(all_long)

dat <- 
  all_long %>%
  select(-contains("name"))

dat <-
  list(dat,
       dat)

map(dat,
    function(x) dectree_expected_values(define_model(dat_long = x)))

Probabilistic sensitivity analysis

We first define the decision tree. The difference to previous trees is that we now use the list-column feature to define distributions rather than point values.

Combine the distributions with the original tree specification.

input_SA <- 
  all_long %>% 
  select(-prob, -vals) %>% 
  dplyr::left_join(label_costs_distns, by = "name.prob") %>%
  dplyr::left_join(label_probs_distns, by = "name.cost") %>%
  as_tibble()

input_SA

We can now loop over this tree and generate samples of values for the given distributions. We could do this within the model but having a record of the inputs may be useful for reproducibility and testing. Use the sample_distributions() function for this.

tree_dat_sa <- list()

for (i in 1:400) {

  tree_dat_sa[[i]] <-
    data.frame(from = input_SA$from,
               to   = input_SA$to,
               prob = lapply(input_SA$prob, sample_distributions) %>% unlist(),
               vals = lapply(input_SA$vals, sample_distributions) %>% unlist()) %>% 
    fill_complementary_probs() %>% 
    define_model(dat_long =  .)
}

This results in a list of trees. Now it is straightforward to map over each of these trees to obtain the total expected values.

res <- map(tree_dat_sa, .f = dectree_expected_values)
head(res)

hist(map_dbl(res, 1), breaks = 25, freq = FALSE, xlab = "cost")
lines(density(map_dbl(res, 1)), col = "red")