R/plot_demand.R

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

#' Demand Plot
#'
#' Generates a plot that shows the demand generated by the model.
#'
#' @param model_output output from \code{run_model()} and \code{get_model_output()}
#' @param appointments output from \code{get_appointments()}
#' @param treatment a name of a treatment to filter by
#'
#' @return \code{demand_plot()}: a plotly chart
#'
#' @importFrom dplyr %>%
#' @importFrom plotly plot_ly layout config
demand_plot <- function(model_output, appointments, treatment) {
  df <- demand_plot_data(model_output, appointments, treatment)

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

  plot_ly(df,
          type = "scatter",
          mode = "lines",
          x = ~date,
          y = ~no_appointments,
          name = "Demand",
          line = list(color = "#587FC1"),
          text = ~comma(no_appointments),
          hoverinfo = "text",
          hovertemplate = "%{text}") %>%
    layout(showlegend = FALSE,
           hovermode = "x unified",
           xaxis = list(title = "Month"),
           yaxis = list(title = "Demand")) %>%
    config(displayModeBar = FALSE)
}

#' @rdname demand_plot
#'
#' @return \code{demand_plot_data()}: a summarised version of \code{model_output}
#'
#' @importFrom dplyr %>% mutate filter
demand_plot_data <- function(model_output, appointments, treatment) {
  force(treatment)

  ama <- filter(appointments, treatment == {{treatment}})$average_monthly_appointments

  model_output %>%
    summarise_model_output("treatment", treatment) %>%
    mutate(no_appointments = .data$value * ama)
}