mod_instant_risk_overview.R 2.05 KB
Newer Older
1
2
3
4
5
6
#' instant_risk_overview UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
7
#' @noRd
8
#'
9
#' @importFrom shiny NS tagList
10
11
mod_instant_risk_overview_ui <- function(id){
  ns <- NS(id)
12
13
  choices <- seq(length(rvgest::rulesets$rules))
  names(choices) <- paste0(choices, ". ", rvgest::rulesets$rules)
14
  tagList(
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
    fluidRow(
      column(width = 6,
        selectInput(
          ns("ruleset"),
          "Rule set",
          choices,
          selected = NULL,
          multiple = FALSE,
          selectize = TRUE,
          width = NULL,
          size = NULL
        )),
      column(width = 6,
        dateInput(ns("date"), "Date:", value = Sys.Date()))),
    fluidRow(
30
      lapply(seq.int(nrow(rvgest::lakes)), function(i) {
31
        column(width = 3,
32
          sliderInput(ns(paste0("V", i)),
33
                      label = paste(rvgest::lakes$name[i], "lake (hm3)"),
34
35
36
                      value = round(getObjectiveStorage()[rvgest::lakes$name[i]]),
                      min = rvgest::lakes$min[i],
                      max = rvgest::lakes$max[i]))
37
      })
38
    ),
39
40
    # tableOutput(ns("table"))
    plotOutput(ns("plot"))
41
  )
42

43
}
44

45
46
#' instant_risk_overview Server Function
#'
47
#' @noRd
48
#' @import ggplot2
49
50
51
mod_instant_risk_overview_server <- function(id, con) {
  moduleServer(id, function(input, output, session){
    ns <- session$ns
52

53
54
    df <- reactive({
      storages <- c(input$V1, input$V2, input$V3, input$V4)
55
      names(storages) <- lakes$name
56
57
58
59
60
61
62
63
64
      golem::print_dev(storages)
      calcInstantRisk(con, input$ruleset, input$date, storages)
    })
    # output$table <- renderTable(df())
    output$plot <- renderPlot(
      ggplot(df(), aes(x = reorder(objective, prob), y = prob)) +
        geom_col(aes(fill = level)) +
        scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
        coord_flip())
65
  })
66
}
67

68
69
## To be copied in the UI
# mod_instant_risk_overview_ui("instant_risk_overview_ui_1")
70

71
## To be copied in the server
72
# mod_instant_risk_overview_server("instant_risk_overview_ui_1")
73