R/mod_uptake.R

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

#' @importFrom shiny.quartz QCard
#' @importFrom shiny NS
mod_uptake_ui <- function(id) {
  ns <- NS(id)
  CustomAgeCard(
    title = "Vaccine Uptake",
    data =  shiny.fluToolkit::uptake,
    ns = ns,
    Stat(ns("result"))
  )
}

#' benefits Server Functions
#'
#' @noRd
#' @importFrom dplyr filter mutate across summarize_at
mod_uptake_server <- function(id, globalInput, uptake_reactive) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    output$result <- renderText({
      cols <- c("lower_ci", "upper_ci", "value")

      shiny.fluToolkit::uptake %>%
        base_filter(input, globalInput) %>%
        mutate(across(cols, ~ .x * population_sample_size)) %>%
        summarize_at(c(cols, "population_sample_size"), sum, na.rm = T) %>%
        mutate(across(cols, ~ .x / population_sample_size, 1)) -> tmp

      uptake_reactive(tmp)
      tmp %>%
        get_ci()
    })
  })
}