In The-Strategy-Unit/723_mh_covid_surge_modelling: Mental Health Covid-19 Surge Modelling

knitr::opts_chunk$set(warning = FALSE, message = FALSE)
library(tibble)
library(patchwork)
library(gridExtra)
library(grid)
library(ggplot2)

# params must be set in the environment before running this report: load it if not
if (!(exists("params") && setequal(names(params), c("groups", "treatments", "curves", "demand")))) {
  devtools::load_all()
}

# model_output/services should exist in the environment, but recreate them if not

if (!exists("model_output")) {
  start_month <- min(params$demand[[1]]$month)
  model_output <- params %>%
    run_model(0.2) %>%
    get_model_output(start_month)
}

if (!exists("services")) {
  services <- names(params$treatments)
}

appointments <- get_appointments(params)

referrals_plot_ggplot <- function(model_output, treatment) {
  df <- referrals_plot_data(model_output, treatment)

  if (nrow(df) < 1) return(NULL)

  df %>%
    ggplot(aes(.data$date, .data$Treatments)) +
    theme_bw() +
    geom_line(colour = "red") +
    scale_x_date(name = "Month",
                 date_breaks = "3 months",
                 date_labels =  "%b %Y") +
    labs(y = "New Referrals",
         title = "Additional Patients Receiving Service")
}

demand_plot_ggplot <- function(model_output, appointments, treatment) {
  df <- demand_plot_data(model_output, appointments, treatment)

  if (nrow(df) < 1) return(NULL)

  df %>%
    ggplot(aes(.data$date, .data$no_appointments)) +
    theme_bw() +
    geom_line(colour = "green") +
    scale_x_date(name = "Month",
                 date_breaks = "3 months",
                 date_labels =  "%b %Y") +
    labs(y = "Demand",
         title = "Typical Additional Contact Volumes per Appointment Type")
}

combined_plot_ggplot <- function(model_output, treatment, params) {
  df <- combined_plot_data(model_output, treatment, params)

  if (nrow(df) < 1) return(NULL)

  df %>%
    ggplot(aes(.data$date, .data$value, group = .data$type, colour = .data$type)) +
    theme_bw() +
    geom_line() +
    scale_x_date(name = "Month",
                 date_breaks = "3 months",
                 date_labels =  "%b %Y") +
    labs(title = "Referrals") +
    scale_colour_discrete(name = "Type") +
    theme(legend.position = "bottom")
}

generate_plot <- function(service) {
  cat("# ", service, "\n\n", sep = "")

  a <- referrals_plot_ggplot(model_output, service)

  b <- demand_plot_ggplot(model_output, appointments, service)

  c <- tableGrob(
    tribble(
      ~ Metric, ~ Number,
      "Total 'surge' Referrals", model_totals(model_output, "new-referral", service),
      "Total new patients in service", model_totals(model_output, "treatment", service),
      # "Total additional demand per contact type", model_totals(model_output, "new-treatment", service),
    ),
    rows = NULL,
    cols = NULL,
    theme = ttheme_default(
      core = list(
        fg_params = list(
          hjust = 0, x = 0
        )
      )
    )
  )

  d <- model_output %>%
    popgroups_plot_data(service) %>%
    rename(Group = group) %>%
    tableGrob(rows = NULL)

  e <- combined_plot_ggplot(model_output, service, params)

  p <- (a | b) / (wrap_elements(c) | wrap_elements(d) | e) ## c and d needs to be made patchwork compliant

  plot(p)
  cat("\n\n")
}

purrr::walk(services, generate_plot)

The-Strategy-Unit/723_mh_covid_surge_modelling documentation built on April 13, 2022, 8:52 a.m.