inst/doc/density_plots.R

In DUToolkit: Visualizing and Quantifying Decision Uncertainty

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 7, fig.height = 5
)

## ----setup, echo = FALSE------------------------------------------------------
library(DUToolkit)

## ----calc_peak----------------------------------------------------------------
# define inputs
tmin <- min(psa_data$Intervention_1[, 1]) # minimum simulation time
tmax <- max(psa_data$Intervention_1[, 1]) # maximum simulation time
Dt <- c(rep(750, length(tmin:tmax))) # decision threshold vector 
Dt_max <- TRUE # indicates the threshold values are maximums

## find peak values
peak_values_list <- get_max_min_values(psa_data, tmin, tmax, Dt_max)

head(peak_values_list$Baseline)

## ----gen_den, out.width='100%'------------------------------------------------
# define single threshold value for the peak
D <- 750

# calculate risk measure
risk_measures_list <- calculate_risk(psa_data, tmin, tmax, Dt, Dt_max)

# generate density plots
density_plots <- plot_density(
  peak_values_list, D,
  Dt_max, risk_measures_list
)

## example plot
density_plots$Intervention_1

## ----cust_den, out.width='100%'-----------------------------------------------
# customize plots
## add fixed x/y-axis limits and change the label of the x-axis
density_plots <- lapply(density_plots, function(x) {
  x + ggplot2::ylim(0, 0.002) + ggplot2::xlim(0, 4500) +
    ggplot2::labs(x = "Hospital demand at peak")
})

## remove subtitle and caption
density_plots <- lapply(density_plots, function(x) {
  x + ggplot2::labs(subtitle = NULL, caption = NULL)
})

## example plot
density_plots$Intervention_1

## ----calc_peak_risk-----------------------------------------------------------
# calculate risk measures at peak values
peak_risk <- calculate_max_min_risk(peak_values_list, D, Dt_max)

# generate risk table dataframe
peak_risk_table <- tabulate_risk(peak_risk, n_s = length(peak_risk))
peak_risk_table

## ----calc_peak_probs----------------------------------------------------------
# define vector of threshold values
Dp <- c(750, 1000, 2000)

# calculate probability that peak value is > specified threshold values
peak_probs <- calculate_threshold_probs(peak_values_list, Dp, Dt_max)

peak_probs$Baseline