R/mod_ugrhi_disp.R

In openvironment/ods6: ODS6 dashboard

#' ugrhi_disp UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
mod_ugrhi_disp_ui <- function(id){
  ns <- NS(id)
  tagList(
    div(
      class = "card-indicadores ugrhi-disp",
      fluidRow(
        column(
          width = 12,
          div(
            class = "meta-desc",
            includeMarkdown("inst/meta_64.md")
          )
        )
      ),
      hr(class = "hr-50"),
      fluidRow(
        column(
          width = 6,
          includeMarkdown("inst/disp_demanda_total.md")
        ),
        column(
          offset = 2,
          width = 4,
          br(),
          valueDiv(
            label = "Demanda total",
            icon = "water",
            textOutput(ns("demanda_total"))
          )
        )
      ),
      br(),
      fluidRow(
        column(
          width = 12,
          highcharter::highchartOutput(ns("hc_demanda_total"), height = "300px")
        )
      ),
      hr(class = "hr-50"),
      fluidRow(
        column(
          width = 6,
          includeMarkdown("inst/disp_demanda_per_capita.md")
        ),
        column(
          offset = 2,
          width = 4,
          br(),
          valueDiv(
            label = "Demanda per capita",
            icon = "water",
            textOutput(ns("demanda_per_capita")),
            htmlOutput(ns("demanda_per_capita_class"))
          )
        )
      ),
      br(),
      fluidRow(
        column(
          class = "text-center",
          width = 12,
          tabela_class_disp_pc()
        )
      ),
      br(),
      fluidRow(
        column(
          width = 12,
          highcharter::highchartOutput(ns("hc_serie_per_capita"), height = "300px")
        )
      ),
      hr(class = "hr-50"),
      fluidRow(
        column(
          width = 6,
          includeMarkdown("inst/disp_q7.md")
        ),
        column(
          offset = 2,
          width = 4,
          br(),
          valueDiv(
            label = "Balanço entre a vazão de água superficial outorgada e a vazão superficial mínima",
            icon = "water",
            textOutput(ns("q7")),
            br(),
            htmlOutput(ns("q7_class"))
          )
        )
      ),
      br(),
      fluidRow(
        column(
          class = "text-center",
          width = 12,
          tabela_class_disp_balanco()
        )
      ),
      br(),
      fluidRow(
        column(
          width = 12,
          highcharter::highchartOutput(ns("hc_serie_q7"), height = "300px")
        )
      ),
      hr(class = "hr-50"),
      fluidRow(
        column(
          width = 6,
          includeMarkdown("inst/disp_q95.md")
        ),
        column(
          offset = 2,
          width = 4,
          br(),
          valueDiv(
            label = "Balanço entre a vazão total outorgada (superficial  + subterrânea) e a vazão disponível",
            icon = "water",
            textOutput(ns("q95")),
            br(),
            htmlOutput(ns("q95_class"))
          )
        )
      ),
      br(),
      fluidRow(
        column(
          class = "text-center",
          width = 12,
          tabela_class_disp_balanco()
        )
      ),
      br(),
      fluidRow(
        column(
          width = 12,
          highcharter::highchartOutput(ns("hc_serie_q95"), height = "300px")
        )
      )
    )
  )
}
    
#' ugrhi_disp Server Functions
#'
#' @noRd 
mod_ugrhi_disp_server <- function(id, ugrhi) {
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    
    base_filtrada <- reactive({
      base_ugrhi |> 
        dplyr::filter(nome == ugrhi())
    })
    
    base_filtrada_contemp <- reactive({
      base_filtrada() %>% 
        dplyr::filter(ano == max(ano))
    })
    
    output$demanda_total <- renderText(
      base_filtrada_contemp() |> 
        dplyr::pull(demanda_total) |> 
        formatar_numero() |> 
        paste(" m³/s")
    )
    
    output$hc_demanda_total <- highcharter::renderHighchart({
      base_filtrada() |>
        dplyr::select(ano, value = demanda_total) |> 
        dplyr::arrange(ano) |> 
        as.matrix() |> 
        hc_serie(
          nome_formatado = "Demanda total",
          unidade_de_medida = "",
          text_color = "black",
          ylab = "Demanda total (m³/s)",
          xlab = "Ano"
        ) |> 
        highcharter::hc_colors(colors = "orange")
    })
    
    output$demanda_per_capita <- renderText({
      base_filtrada_contemp() |>
        dplyr::pull(demanda_per_capita) |>
        formatar_numero(accuracy = 1) |>
        paste("m³/hab/ano")
    })
    
    output$demanda_per_capita_class <- renderUI({
      valor <- base_filtrada_contemp() |>
        dplyr::pull(demanda_per_capita) |> 
        round(1)
      
      classificacao <- dplyr::case_when(
        valor > 2500 ~ "Boa",
        valor < 1500 ~ "Crítica",
        TRUE ~ "Atenção"
      )
      
      cor <- class_disp_pc(classificacao)
      
      div(
        class = "ind-classificacao",
        span(classificacao, style = cor)
      )
    })

    output$hc_serie_per_capita <- highcharter::renderHighchart({
      base_filtrada() |>
        dplyr::select(ano, value = demanda_per_capita) |>
        dplyr::arrange(ano) |>
        as.matrix() |>
        hc_serie(
          nome_formatado = "Demanda per capita",
          unidade_de_medida = "",
          text_color = "black",
          ylab = "Demanda per capita (m³/hab/ano)",
          xlab = "Ano"
        ) |>
        highcharter::hc_colors(colors = "orange")
    })
 
    output$q7 <- renderText({
      base_filtrada_contemp() |>
        dplyr::pull(demanda_superficial_q7_10) |> 
        formatar_numero() |> 
        paste("%")
    })
    
    output$q7_class <- renderUI({
      valor <- base_filtrada_contemp() |>
        dplyr::pull(demanda_superficial_q7_10)
      
      classificacao <- dplyr::case_when(
        valor < 5 ~ "Excelente",
        valor <= 30 ~ "Confortável",
        valor <= 50 ~ "Preocupante",
        valor <= 100 ~ "Crítica",
        TRUE ~ "Muito crítica"
      )
      
      cor <- class_balanco(classificacao)
      
      div(
        class = "ind-classificacao",
        span(classificacao, style = cor)
      )
    })
    
    output$hc_serie_q7 <- highcharter::renderHighchart({
      base_filtrada() |>
        dplyr::select(ano, value = demanda_superficial_q7_10) |> 
        dplyr::arrange(ano) |> 
        as.matrix() |> 
        hc_serie(
          nome_formatado = "Q7",
          unidade_de_medida = "",
          text_color = "black",
          ylab = "q7 (%)",
          xlab = "Ano"
        ) |> 
        highcharter::hc_colors(colors = "orange")
    })
    
    output$q95 <- renderText({
      base_filtrada_contemp() |> 
        dplyr::pull(demanda_total_q95_percent) |> 
        formatar_numero() |> 
        paste("%")
    })
    
    output$q95_class <- renderUI({
      valor <- base_filtrada_contemp() |>
        dplyr::pull(demanda_total_q95_percent)
      
      classificacao <- dplyr::case_when(
        valor < 5 ~ "Excelente",
        valor <= 30 ~ "Confortável",
        valor <= 50 ~ "Preocupante",
        valor <= 100 ~ "Crítica",
        TRUE ~ "Muito crítica"
      )
      
      cor <- class_balanco(classificacao)
      
      div(
        class = "ind-classificacao",
        span(classificacao, style = cor)
      )
    })
    
    output$hc_serie_q95 <- highcharter::renderHighchart({
      base_filtrada() |>
        dplyr::select(ano, value = demanda_total_q95_percent) |> 
        dplyr::arrange(ano) |> 
        as.matrix() |> 
        hc_serie(
          nome_formatado = "Q 95",
          unidade_de_medida = "",
          text_color = "black",
          ylab = "q95 (%)",
          xlab = "Ano"
        ) |> 
        highcharter::hc_colors(colors = "orange")
    })
    
  })
}