R/mod_burden.R

In QuartzSoftwareLLC/shiny.fluToolKit: What the Package Does (One Line, Title Case)

#'
#' @importFrom shiny NS conditionalPanel
#' @importFrom shiny.quartz QCard QListItem Container Item IconSwitch.shinyInput
#' @importFrom plotly plotlyOutput
#' @importFrom shiny.mui List TextField.shinyInput reactOutput Tooltip BarChartIcon CalculateIcon
#' @return the preprocessed burded data
mod_burden_ui <- function(id) {
  ns <- NS(id)

  plot_burden <- function(plot, title = "") {
    Item(
      xs = 12, lg = 6, xl = 6,
      Typography(title, color = "secondary", variant = "h6"),
      plotlyOutput(ns(plot))
    )
  }

  CustomAgeCard(
    title = "Influenza Burden",
    ns = ns,
    data = shiny.fluToolkit::burden,
    Toolbar =  span(
      Tooltip(title = "Show Mean", span(IconSwitch.shinyInput("mean_switch", CalculateIcon()))),
      GraphsSwitch(ns, value = T)
      ),
    Container(
      BurdenStats(ns)
    ),
    conditionalPanel(condition = "input.graphs_switch", ns = ns, 
      Container(spacing = 1,
      plot_burden("illness_plot", "Illnesses"),
      plot_burden("hospitalizations_plot", "Hospitalizations"),
      plot_burden("medical_visits_plot", "Medical Visits"),
      plot_burden("mortality_plot", "Mortality")
    ))
  )
}

#' benefits Server Functions
#'
#' @noRd
#' @importFrom dplyr filter summarise_at group_by ungroup
#' @importFrom shiny.mui TableViewIcon BarChartIcon
#' @importFrom plotly renderPlotly
mod_burden_server <- function(id, globalInput, burden_reactive) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    filtered <- reactive({
      shiny.fluToolkit::burden %>%
        base_filter(input, globalInput) %>%
        subset(!rate) %>%
        group_by(measure)
     }) 
    columns <- c("lower_ci", "upper_ci", "value")
    burden_preprocessed <- reactive({
        sum_func <- sum
        req(!is.na(globalInput$mean_switch))
        if (globalInput$mean_switch == T) {
          sum_func <- mean
        }

        filtered() %>%
          group_by(measure, season) %>%
            summarise_at(columns, sum, na.rm = T) %>%
            group_by(measure) %>%
            summarise_at(columns, sum_func, na.rm = T) -> tmp
          burden_reactive(tmp)
          tmp
    })

    renderBurdenStats(output, burden_preprocessed)

    render_rate_plot <- function(measurez) {
      renderPlotly({
        req(input$graphs_switch)
        data <- shiny.fluToolkit::burden %>%
          base_filter(input, globalInput)
        get_rate_plot(data, measurez)
      })
    }

    output$illness_plot <- render_rate_plot("Illness rate")
    output$medical_visits_plot <- render_rate_plot("Medical visit rate")
    output$hospitalizations_plot <- render_rate_plot("Hospitalization rate")
    output$mortality_plot <- render_rate_plot("Mortality rate")

  })
}


#' generates plot from benefit table for rate
#' @param measurez name of measure of interest
#' @importFrom dplyr filter summarise_at group_by
#' @import ggplot2
get_rate_plot <- function(data, measurez) {
  cols <- RColorBrewer::brewer.pal(n = 5, "Set1")
  (data %>%
    subset(rate & measure == measurez) %>%
    dplyr::arrange(season, age_group) %>%
    ggplot(data = ., aes(x = season, y = value, ymin = lower_ci, ymax = upper_ci, colour = age_group)) +
    geom_point(position = position_dodge(.5)) +
    geom_linerange(position = position_dodge(.5)) +
    theme(
      axis.text.x = element_text(angle=90),
    ) +
    labs(
      colour = "Age Group",
      x = "\n Influenza Season",
      y = paste(measurez, "Per 100,000 Population")
    )) %>% ggplotly()
}