R/mod_prevention.R

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

#'
#' @importFrom shiny NS
#' @importFrom shiny.quartz QCard QListItem Container Item ReactMarkdown
#' @importFrom shiny.mui List TextField.shinyInput reactOutput InfoIcon Button.shinyInput
mod_prevention_ui <- function(id) {
    ns <- NS(id)
    tagList(
        Box(
            display = "flex",
            IconButton.shinyInput(ns("showDialog"), InfoIcon()),
            Button.shinyInput(ns("simulate"), "Explore the Effects of an Improved VE", variant="contained", fullWidth = T),
        ),
    shiny.mui::reactOutput(ns("info")),
    uiOutput(ns("prevention"))
    )
}

#' benefits Server Functions
#'
#' @noRd
#' @importFrom dplyr filter summarise_at group_by across
#' @importFrom shiny req
#' @importFrom shiny.quartz renderDialog QThemeProvider
#' @importFrom shiny.mui Box IconButton.shinyInput
mod_prevention_server <- function(id, ve_reactive, uptake_reactive, burden_reactive) {
    moduleServer(id, function(input, output, session) {
        ns <- session$ns
        prevention_reactive <- reactive({
            ve <- ve_reactive()$value[[1]]
            uptake <- uptake_reactive()$value[[1]]
            req(uptake)
            req(ve)
            req(input$new_ve)

            ve <- ve / 100
            uptake <- uptake / 100

            get_prevented <- function(x) {
                vax_measure <- ((1 - ve) * uptake * x) / (1 - uptake + (1 - ve) * uptake)
                unvax_measure <- vax_measure / (1 - ve)
                new_vax_measure <- unvax_measure * (1 - as.numeric(input$new_ve) / 100)
                prevented <- vax_measure - new_vax_measure
                print(paste(vax_measure, new_vax_measure))
                prevented
            }
            burden_reactive() %>%
                mutate(across(
                    c("value", "lower_ci", "upper_ci"),
                    ~ get_prevented(.x),
                )) -> prevention

            prevention
        })
        renderBurdenStats(output, prevention_reactive)

        output$info <- renderDialog("showDialog", input, ReactMarkdown(shiny.fluToolkit::formula), ns = ns)
open <- reactiveVal(F)
observeEvent(
    input$simulate,
    open(T)
)
output$prevention <- renderUI({
    req(open())
    QThemeProvider(Box(
        mt = 1,
        TextField.shinyInput(ns("new_ve"), label = "Improved VE", value = 70, type = "number"),
        BurdenStats(ns, suffix = "Prevented"),
    ))
})
    })
}