mod_instant_risk_overview.R

#' instant_risk_overview UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @importFrom rvgest lakes rulesets
mod_instant_risk_overview_ui <- function(id){
  ns <- NS(id)
  choices <- seq(length(rulesets$rules))
  names(choices) <- paste0(choices, ". ", rulesets$rules)
  tagList(
    selectInput(
      "ruleset",
      "Rule set",
      choices,
      selected = NULL,
      multiple = FALSE,
      selectize = TRUE,
      width = NULL,
      size = NULL
    ),
    dateInput("date", "Date:", value = Sys.Date()),
    lapply(seq.int(nrow(lakes)), function(i) {
      numericInput(paste0("V", i),
                   lakes$name[i],
                   round(getObjectiveStorage()[lakes$name[i]]),
                   min = lakes$min[i],
                   max = lakes$max[i])
    }),
    # tableOutput(ns("table"))
    plotOutput(ns("plot"))
  )
  
}
    
#' instant_risk_overview Server Function
#'
#' @noRd 
#' @import ggplot2
mod_instant_risk_overview_server <- function(input, output, session, con){
  ns <- session$ns
  
  df <- reactive({
    df <- calcInstantRisk(con, 1, Sys.Date(), getObjectiveStorage())
    storages <- c(input$v1, input$v2, input$v3, input$v4)
    if(!is.null(unlist(storages))) {
      names(storages) <- lakes$name
      print(storage)
      df <- calcInstantRisk(con, input$ruleset, input$date, storages)
    }
    df <- head(df[order(df$prob, decreasing = TRUE),], 10)
    df
  })
  # output$table <- renderTable(df())
  output$plot <- renderPlot(
    ggplot(df(), aes(x = objective, y = prob)) +
      geom_col(aes(fill = level)) +
      coord_flip())
}
    
## To be copied in the UI
# mod_instant_risk_overview_ui("instant_risk_overview_ui_1")
    
## To be copied in the server
# callModule(mod_instant_risk_overview_server, "instant_risk_overview_ui_1")