R/mod_chainladder.R

In MehdiChelh/triangle.tlbx: An Amazing Shiny App

# Module UI
  
#' @title   mod_chainladder_ui and mod_chainladder_server
#' @description Chain Ladder module. Please note that some UI elements are defined in the server using the insertUI function (this part will be removed by making custom UI element).
#'
#' @param id shiny id
#' @param input internal
#' @param output internal
#' @param session internal
#'
#' @rdname mod_chainladder
#'
#' @keywords internal
#' @include mod_chainladder_side.R 
#' @include mod_chainladder_body.R
#' @export 
#' @importFrom shiny NS tagList fluidPage fluidRow column wellPanel selectInput radioButtons uiOutput tabPanel h5 plotOutput
#' @importFrom DT dataTableOutput
mod_chainladder_ui <- function(id){
  ns <- NS(id)
  
  DEV_or_TEST <- isTruthy(get_golem_options("dev_mode")) || isTruthy(get_golem_options("test_mode")) || getOption("shiny.testmode", FALSE)
  
  tabPanel("Chain Ladder", value = "chainladder", icon=icon("menu-hamburger", lib="glyphicon"),
           fluidPage(
             fluidRow(
               # --- Side panel
               column(3, mod_chainladder_side_ui(ns(NULL))),
               # --- Main panel
               if (!DEV_or_TEST) # DEV/PROD MODE
                 shinyjs::hidden(column(9, id = ns("content"), mod_chainladder_body_ui(ns(NULL))))
               else
                 column(9, id = ns("content"), mod_chainladder_body_ui(ns(NULL)))
               ,
               column(9, id=ns("content-load_data_message"), wellPanel(style="text-align:center", h4("Importer/Sélectionner un jeu de données ", icon("file-download"))))
            )
          )
  )
}
    
# Module Server
    
#' @rdname mod_chainladder
#' @export
#' @keywords internal
#' @importFrom ChainLadder ata chainladder
#' @importFrom shinyjs hide show hidden
mod_chainladder_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()
  # List of input to bookmark/restore
  # ------------------
  # AllInputs <- reactive({
  #   x <- reactiveValuesToList(input)
  #   df <- data.frame(
  #     names = names(x),
  #     values = unlist(x, use.names = FALSE)
  #   )
  #   print(x)
  #   df
  # })
  # 
  # observe({
  #   AllInputs()
  # })
  
  # ////////////////////////////////////////////////
  #-------------------------------------------------
  #                 Sous-modules
  #-------------------------------------------------
  # ////////////////////////////////////////////////
  callModule(mod_chainladder_body_server, NULL)
  callModule(mod_chainladder_side_server, NULL)
  
  
  # ////////////////////////////////////////////////
  #-------------------------------------------------
  #                     Observers
  #-------------------------------------------------
  # ////////////////////////////////////////////////
  # Observe if data has been loaded or not
  # Display a message to indicate that the user should load data
  observe({
    elements <- 
    if(is.null(getInput("chainladder", "data-raw_triangle"))){
      shinyjs::hide("content")
      shinyjs::show("content-load_data_message")
    } else{
      shinyjs::show(id = "content")
      shinyjs::hide("content-load_data_message")
    }
  })
  
  # ////////////////////////////////////////////////
  #-------------------------------------------------
  #               Compléments de UI
  #-------------------------------------------------
  # ////////////////////////////////////////////////
  # TODO: Ces éléments devront être intégrés directement à l'UI en modifiant les fonctions de création de l'UI
  # insertUI(selector = "#app-chainladder-content .nav.nav-tabs", 
  #          ui = shinyjs::disabled(tags$li(actionLink(ns("save-config"), "Save config", icon("save")), style="float:right")),
  #          where = "beforeEnd")
  # insertUI(selector = "#app-chainladder-content .nav.nav-tabs", 
  #          ui = tags$li(exportExcelBtn(ns("export-excel"), "Exporter vers Excel"), style="float:right"),
  #          where = "beforeEnd")
  
  
  # ////////////////////////////////////////////////
  #-------------------------------------------------
  #                     Outputs
  #-------------------------------------------------
  # ////////////////////////////////////////////////
  # export-excel ----
  # ---- [Buttons]
  output[["export-excel"]] <- downloadHandler(
    filename = function() {
      paste("export.xlsx", sep = "")
    },
    content = function(file) {
      create_excel_file(system.file("app/www/excel/template_chainladder.xlsx", package = "triangle.tlbx"), file,
                        values = list("data_pos" = list("value" = getInput("chainladder", "data-raw_triangle"),
                                                        "colNames" = FALSE,
                                                        "rowNames" = TRUE),
                                      "calculation_linkratio_triangle" = list("value" = get("chainladder", "link_ratio-triangle"),
                                                                              "colNames" = FALSE, 
                                                                              "rowNames" = TRUE,
                                                                              "format" = list(rows = getInput("chainladder", "link_ratio-excluded_ratios")[, 1] - 1,
                                                                                              cols = getInput("chainladder", "link_ratio-excluded_ratios")[, 2],
                                                                                              style = list(fgFill = "#c00000", fontColour = "white", textDecoration = "bold"))),
                                      "calculation_linkratio_table" = list("value" = get("chainladder", "link_ratio-table"),
                                                                           "colNames" = FALSE, 
                                                                           "rowNames" = TRUE,
                                                                           "format" = list(rows = getInput("chainladder", "link_ratio-final_selection")[, 1] - 1,
                                                                                           cols = getInput("chainladder", "link_ratio-final_selection")[, 2],
                                                                                           style = list(fgFill = "#c00000", fontColour = "white", textDecoration = "bold"))),
                                      "calculation_linkratio_table_tf" = list("value" = get("chainladder", "tail_factor-final_value"),
                                                                              "colNames" = FALSE, 
                                                                              "rowNames" = FALSE),
                                      "calculation_linkratio_final" = list("value" = t(get("chainladder", "link_ratio-final_value")),
                                                                           "colNames" = FALSE, 
                                                                           "rowNames" = FALSE),
                                      "calculation_linkratio_final_tf" = list("value" = get("chainladder", "tail_factor-final_value"),
                                                                              "colNames" = FALSE, 
                                                                              "rowNames" = FALSE),
                                      "results_reserves" = list("value" = get("chainladder", "results-final_table"),
                                                                "colNames" = FALSE, 
                                                                "rowNames" = TRUE),
                                      "results_linkratio" = list("value" = t(get("chainladder", "link_ratio-final_value")),
                                                                 "colNames" = FALSE, 
                                                                 "rowNames" = FALSE),
                                      "results_linkratio_tf" = list("value" = get("chainladder", "tail_factor-final_value"),
                                                                    "colNames" = FALSE, 
                                                                    "rowNames" = FALSE),
                                      "results_fulltriangle" = list("value" = get("chainladder", "results-projected_triangle"),
                                                                    "colNames" = FALSE, 
                                                                    "rowNames" = TRUE)))
    }
  )
}