R/plot_surge.R

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

#' Surge Plot
#'
#' Generates a plot that shows the amount of people who were referred and treated, and referred but not treated, as
#' generated by the model.
#'
#' @param model_output output from \code{run_model()} and \code{get_model_output()}
#' @param column the column in `model_output` to calculate the summary for, either "group", "condition" or "treatment"
#'
#' @return \code{surge_plot()}: a plotly chart
#'
#' @importFrom dplyr %>%
#' @importFrom plotly layout config add_trace
surge_plot <- function(model_output, column) {
  column <- enquo(column)
  df <- surge_plot_data(model_output, {{column}})

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

  plot_ly(df,
          x = ~`Received treatment`,
          y = ~group,
          text = paste0("<b>Received treatment</b><br>",
                        comma(df[["Received treatment"]])),
          hoverinfo = "text",
          marker = list(color = "#F8BF07",
                        line = list(color = "#2c2825", width = 1.5)),
          type = "bar",
          name = "Received treatment") %>%
    add_trace(x = ~df[["Referred, but not treated"]],
              name = "Referred, but not treated",
              marker = list(color = "#586FC1",
                            line = list(color = "#2c2825", width = 1.5)),
              text = paste0("<b>Referred, but not treated</b><br>",
                            comma(df[["Referred, but not treated"]]))) %>%
    layout(xaxis = list(title = "Total Referrals / Treatments"),
           yaxis = list(title = ""),
           barmode = "stack",
           legend = list(xanchor = "right",
                         yanchor = "bottom",
                         x = 0.99,
                         y = 0.01)) %>%
    config(displayModeBar = FALSE)
}

#' @rdname surge_plot
#'
#' @return \code{surge_plot_data()}: a summarised version of \code{model_output}
#'
#' @importFrom dplyr %>% filter mutate across rename
surge_plot_data <- function(model_output, column) {
  model_output %>%
    filter(.data$type != "new-at-risk") %>%
    surge_summary({{column}}) %>%
    mutate(across(.data$`new-referral`, ~.x - .data$`new-treatment`)) %>%
    rename("Received treatment" = .data$`new-treatment`,
           "Referred, but not treated" = .data$`new-referral`)
}