R/app_server.R

Defines functions app_server

#' The application server-side
#' 
#' @param input,output,session Internal parameters for {shiny}. 
#'     DO NOT REMOVE.
#' @import shiny
#' @import dplyr
#' @noRd
app_server <- function( input, output, session ) {
  # List the first level callModules here
  
  survey_design_results <- reactiveVal(NULL)
  
  output$survey_design_results_ui <- renderUI({
    req(survey_design_results())
    tagList(
      fluidRow(style = "display: inline-flex; width: 100%",
               tags$section(class="parent",
                            div(class="child", icon("arrow-alt-circle-down", "fa-3x")))
      ),
      fluidRow(style = "display: inline-flex; width: 100%",
        column(2),
        column(7,
               gt::gt_output("survey_design_gt")),
        column(1, 
               tags$section(class="parent",
                            div(class="child", icon("arrow-alt-circle-right", "fa-3x")))),
        column(2,
               tags$section(class="parent",
                            div(class="child", downloadButton("download_gt", label = "Download als PNG")))
               )
      )
    )
  })
  
  observeEvent(input$calc_design, {
    
    if(is.null(input$wea_nums)){
       return(showNotification(
         type = "error",
         "Bitte geben Sie zuerst die Windenergieanlagen ein, für die das Beprobungsdesign berechnet werden soll."
       ))}
    
    if(is.na(input$wea_nums)){
      return(showNotification(
        type = "error",
        "Bitte geben Sie zuerst die Windenergieanlagen ein, für die das Beprobungsdesign berechnet werden soll."
      ))}
    
    if(is.null(input$survey_units)){
        return(showNotification(
          type = "error",
          "Bitte geben Sie zuerst an wieviele WEA-Beprobungsjahre zur Verfügung stehen."
        ))}
    
    if(is.na(input$survey_units)){
      return(showNotification(
        type = "error",
        "Bitte geben Sie zuerst an wieviele WEA-Beprobungsjahre zur Verfügung stehen."
      ))}
    
    if(is.null(input$max_survey_years)){
      return(showNotification(
        type = "error",
        "Bitte geben Sie zuerst an wieviele Jahre die Untersuchung maximal dauern darf."
      ))}
    
    if(is.na(input$max_survey_years)){
      return(showNotification(
        type = "error",
        "Bitte geben Sie zuerst an wieviele Jahre die Untersuchung maximal dauern darf."
      ))}
    
    golem::cat_dev("calculating design")
      
    
      calc_design(max_survey_duration = input$max_survey_years,
                survey_units = input$survey_units,
                turbines_chr = input$wea_nums) %>% 
      survey_design_results()
  })
  
  output$survey_design_gt <- gt::render_gt(
    {req(survey_design_results())
    design_table_as_gt(survey_design_results())}
  )
  
  output$download_gt <- downloadHandler(
    filename = "probat_design.png",
    content = function(file){
      shinybusy::show_modal_spinner(
        spin = "orbit",
        text = "Die Tabelle wird als PNG gespeichert und zum Download bereitgestellt.")
      on.exit(shinybusy::remove_modal_spinner())
      if(is.null(webshot:::find_phantom())){
        webshot::install_phantomjs()}
      
      req(survey_design_results())
      survey_design_results() %>% 
        design_table_as_gt() %>% 
        gt::gtsave(filename = file)
    }
  )

}
SoerenGreule/probatdesigner documentation built on Dec. 18, 2021, 2:06 p.m.