R/mod_chainladder_side.R

In MehdiChelh/triangle.tlbx: An Amazing Shiny App

# ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
# Module UI
# ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  
#' @title   mod_chainladder_side_ui and mod_chainladder_side_server
#' @description  Side bar of the Chain Ladder Panel.
#'
#' @param id shiny id
#' @param input internal
#' @param output internal
#' @param session internal
#'
#' @rdname mod_chainladder_side
#'
#' @keywords internal
#' @export 
#' @importFrom shiny NS tagList selectInput wellPanel h2 fluidRow column 
#' @importFrom shinyWidgets materialSwitch
#' @importFrom  shinydashboard valueBoxOutput
#' @import shiny
mod_chainladder_side_ui <- function(id){
  ns <- NS(id)
  
  tagList(
    # ///////////////////////////////////////
    #  Side Panel
    # ///////////////////////////////////////
    wellPanel(id="CL_inputpanel",
              # Choix config
              selectInput(ns("method"), label="Select Configuration",
                          choices=c("Config 1")),
              wellPanel(
                # Choix jeu de données
                selectInput(ns("data"), label="Select Data",
                            choices=c("")),
                errorOutput(ns("data-error")),
                # Choix unité (pour l'affichage des chiffres)
                selectInput(ns("unit"), "Unit for display purposes:",
                            c("Units" = 1, "Hundreds" = 100, "Thousands" = 10^3, "Millions" = 10^6, "Billions" = 10^9),
                            selected = 1)
              )
              
    ),
    # Box d'affichage du montant total d'IBNR
    fluidRow(column(12, uiOutput(ns("total_ibnr"), class = "col-sm-12", 
                                 style = "padding-right:15px; padding-left:0px")))
  )
}


# ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
# Module Server
# ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

#' @rdname mod_chainladder_side
#' @export
#' @keywords internal
mod_chainladder_side_server <- function(input, output, session){
  # ////////////////////////////////////////////////
  #-------------------------------------------------
  #             Initialisation du module      
  #-------------------------------------------------
  # ////////////////////////////////////////////////
  ns <- session$ns
  # MVC - Getter et Setter :
  # -----------------
  mvc <- mvc_init_mod(session)
  get <- mvc$get
  setInput <- mvc$setInput
  getInput <- mvc$getInput
  # Local variables :
  # -----------------
  local <- reactiveValues()
  set <- function(key, value){ local[[key]] <- value }
  
  
  # ////////////////////////////////////////////////
  #-------------------------------------------------
  #                     Observers
  #-------------------------------------------------
  # ////////////////////////////////////////////////
  # Data Selection
  # --------------
  # > Update data selection input when the user import data
  # --------------
  observeEvent( session$userData$state$imported_data[["ids"]] , {
    choices <- session$userData$state$imported_data[["ids"]]
    updateSelectInput(session = session, inputId = "data", choices = choices)
    
    # Par défault: assigne au premier jeu de donnée importé
    # session$userData$state$data$raw <- session$userData$state$imported_data[[ "1" ]]$data
    
    setInput("chainladder", "data-raw_triangle", {
      session$userData$state$imported_data[[ "1" ]]$data/as.numeric(input$unit)
    })
  })
  
  observe(
  setInput("chainladder","unit_used",{
    req(input$unit)
    as.numeric(input$unit)
  }))
  
  
  # > Update selected data
  # --------------
  observe({
    # 1. Test data validity
    set("data-raw_triangle-error", {
      req(input[["data"]])
      
      # Validate data exist
      validate( need({ input[["data"]] %in% session$userData$state$imported_data[["ids"]] }, label = input[["data"]] ))
      data <- session$userData$state$imported_data[[ input[["data"]] ]]$data
      
      # Validate data format
      validateDontStop(need({ nrow(data) == ncol(data) }, 
                            "Le jeu de données choisi n'a pas le même nombre de lignes que de colonnes. Attention à vérifier les paramètres choisis lors de l'import des données."),
                       need({ is.numeric(data) },
                            "Le jeu de données choisi semble contenir des cellules qui ne peuvent être interprétée comme numériques. Attention à vérifier les paramètres choisis lors de l'import des données."))
    })
    # 2. If data valid / not valid, show / hide content
    if (isTruthy(local[["data-raw_triangle-error"]])) {
      shinyjs::hide("content")
      shinyjs::hide("total_ibnr")
      shinyjs::show("content-load_data_message")
      shinyjs::show("data-error")
    } else{
      shinyjs::show("content")
      shinyjs::show("total_ibnr")
      shinyjs::hide("content-load_data_message")
      shinyjs::hide("data-error")
    }
    # 3. Process data (load data in this case)
    setInput("chainladder", "data-raw_triangle", {
      req(input[["data"]])
      
      req(is.null(local[["data-raw_triangle-error"]]))
      session$userData$state$imported_data[[ input[["data"]] ]]$data/as.numeric(input$unit)
    })
  })
  
  
  
  
  # ////////////////////////////////////////////////
  #-------------------------------------------------
  #                     Outputs
  #-------------------------------------------------
  # ////////////////////////////////////////////////
  # total_ibnr
  #   > IBNR total
  output[["total_ibnr"]] <- renderUI({
    req(get("chainladder", "results-final_table"))
    
    total_ibnr <- paste(format(round(get("chainladder", "results-final_table")["Total", "ibnr"]), big.mark = " "), "€")
    
    tags$div(class="small-box", style="background-color:#f5f5f5; color:#777",
             tags$div(class="inner", style="padding-left:15px; padding-right:15px; padding-top:15px",
                      tags$h3(total_ibnr),
                      tags$p("IBNR Total")),
             tags$div(class="icon-large", style="right:15px",
                      tags$i(class="fa fa-chart-pie")))
  })
  
  output[["data-error"]] <- renderText({
    
    local[["data-raw_triangle-error"]]
    
  })
}