inst/shiny/guiApp/server.R

#-------------------------------------------------------------------------------
# RMV2.0 (version 1.1.0)
# LBNL MV 2.0 Toolbox
# Samir Touzani, PhD
#-------------------------------------------------------------------------------

# change_box <- function(box, success_condition) {
#   browser()
#     selector <- paste0("$('#",box,"').parent()")
#     if (success_condition) {
#       shinyjs::removeClass(
#         selector = selector, class = "box-warning")
#       shinyjs::addClass(
#         selector = selector, class = "box-success")
#     } else {
#       shinyjs::removeClass(
#         selector = selector, class = "box-success")
#       shinyjs::addClass(
#         selector = selector, class = "box-warning")
#     }
# }

#===============================================================================
#                               SHINY_SERVER                                   #
#===============================================================================
shinyServer(function(input, output, session) {
  #=============================================================================
  #                        Menu SideBar                                        #
  #=============================================================================

  output$save_sc_Ui <- renderUI({
    actionButton("save_sc",
                  label = "Save Project",
                  icon = icon("floppy-o"),
                  width='85%')
  })

  output$save_pred_sc_Ui <- renderUI({
    actionButton("save_pred_sc",
                  label = "Save Predictions",
                  icon = icon("floppy-o"),
                  width='60%')
  })

  output$save_sav_Ui <- renderUI({
      actionButton("save_sav",
                  label = "Save Project",
                  icon = icon("floppy-o"),
                  width='85%')
  })

  output$save_pred_sav_Ui <- renderUI({
      actionButton("save_pred_sav",
                  label = "Save Predictions",
                  icon = icon("floppy-o"),
                  width='60%')
  })

  #=============================================================================
  #                        Screening Server Functions  New Project             #
  #=============================================================================

  # Set the reactive var where the different variables will be stored
  screen_out <- reactiveValues()


  ########################  Create a new Project ###############################

  # set the project name
  p_name_sc <- renderText({input$p_name_sc})
  screen_out$p_name_sc <- p_name_sc

  observe({change_box("save_dir_sc_box", !(is.null(input$save_dir_sc)))})

  # set the directory where the project will be stored
  shinyDirChoose(input,
                 'save_dir_sc',
                 roots = volumes,
                 filetypes = c('', 'csv'))
  save_dir_sc <- reactive(input$save_dir_sc)
  path_save_dir_sc <- reactive({
    home <- normalizePath("~")
    file.path(volumes[save_dir_sc()$root], paste(unlist(save_dir_sc()$path[-1]),
              collapse = .Platform$file.sep))
  })
  output$save_dir_sc_out <- renderText({basename(path_save_dir_sc())})

  ########################  Set Pre-instatllation Data ###########################

  observe({change_box("pre_dir_sc_box", !(is.null(input$pre_dir_sc)))})

  observe({
    if (input$next_init_1!=0 & input$type_init == 1 & input$new_init == 1){
      # set the directory from where the pre data will be read
      shinyDirChoose(input,
                     'pre_dir_sc',
                     roots = volumes,
                     filetypes = c('csv'))
      # define home directory
      home <- normalizePath("~")
      # get the pre data directory paths
      screen_out$pre_dir_sc <- file.path(volumes[input$pre_dir_sc$root],
                                         paste(unlist(input$pre_dir_sc$path[-1]),
                                         collapse = .Platform$file.sep))
      # get the pre data files paths
      screen_out$files_path_sc <- list.files(screen_out$pre_dir_sc,
                                             "*\\.csv",
                                             full.names = T,
                                             include.dirs =F)
      # get the pre data files names
      screen_out$files_names <- list.files(screen_out$pre_dir_sc,
                                              "*\\.csv",
                                              full.names = F,
                                              include.dirs =F)
      #Render the pre path
      output$pre_dir_sc_out <- renderText({basename(screen_out$pre_dir_sc)})
    }
  })

  output$fields_sc_new <- reactive(!(is.null(input$save_dir_sc)) &&
                                    !(is.null(input$pre_dir_sc)))
  outputOptions(output, "fields_sc_new", suspendWhenHidden = FALSE)


  # Extract the summary of the pre data files
  observeEvent(input$next_init_sc,{
    if (length(screen_out$files_names)!=0){
      screen_out <- data_load(screen_out$files_path_sc,
                              screen_out$files_names,
                              screen_out, Post =F, clean = T)
      screen_out$Data_pre_summary <- screen_out$Data_pre_summary_0[,c(1:6,9)]
      output$intEndBox_sc <- renderInfoBox({
        infoBox(h4("The project setup is completed"),
                "Proceed to the screening analysis",
                icon = icon("thumbs-o-up"),
                fill = T,
                color = "navy")
      })
    }
    else{
      output$intEndBox_sc <- renderInfoBox({
        infoBox(h4("No csv files found"),
                "Please select a valid directory",
                icon = icon("times-circle-o"),
                fill = T,
                color = "red")
      })
    }
  })

  #Render the summary table
  output$pre_summary_tab_sc <- renderDataTable({
    summary_tab <- screen_out$Data_pre_summary
    return(summary_tab)
  }, options = list(pageLength = 5))

  #Download the table
  output$pre_summary_tab_sc_dl <- downloadHandler(
    filename = function () {
      paste0(input$p_name_sc, "_pre_summary", ".csv")
    },
    content = function(file) {
      write.csv(screen_out$Data_pre_summary, file, row.names = FALSE)
    }
  )

  # output$pre_summary_tab_sc <- DT::renderDataTable(
  #  Data_pre_summary(), extensions = 'Buttons',
  #                         options = list(dom = 'Bfrtip',buttons = c('copy', 'csv', 'excel', 'pdf'))
  # )

  ###########################  Data Visualization #############################

  #update the pre-data files names for the visualization
  observe({
    updateSelectInput(session,
                      "Data_vis_sc",
                      choices = screen_out$files_names)
  })

  # plot time serie for the selected building
  observeEvent(input$pre_plot_go_sc,{
    Data_list <- screen_out$Data_pre
    pre_name <- input$Data_vis_sc
    Data <- Data_list[[pre_name]]
    variables_i <- c(c("Temp"),
                     names(Data)[names(Data) %nin%
                                     c("time","eload","Temp")])
    output$radio_plot_pre_sc <- renderUI({
      radioButtons(inputId = 'var_pre_sc',
                   label = 'Select the Input Variable to Plot',
                   choices = variables_i,
                   selected = "Temp",
                   inline = T)
    })
    # Render the Time series plot
    output$ts_plot_pre_sc <- dygraphs::renderDygraph({
     p <- act_plot(Data)
     return(p)
    })

    # plot eload vs Temp for the selected building
    output$scatter_plot_pre_sc <- renderPlot({
     p <- eload_vs_input_plot(Data, input$var_pre_sc)
     return(p)
     })

    # heatmap for the selected building
    output$heatmap_pre_sc <- plotly::renderPlotly({
     p <- eload_heatmap(Data)
     return(p)
     })
  })




 ###########################  Train Baseline Models ############################

 # generate UI corresponding to the baseline Models
 output$Model_Desc_sc <- renderText({
    switch(input$Model_sc,
      "TOWT" = paste("TOWT is a piecewise linear model and where the predicted
      energy consumption is a combination of two terms that relate the energy
      consumption to the time of the week and the piecewise-continuous effect
      of the temperature. Each time of the week has a different predicted energy
      consumption, and the temperature effect is estimated separately
      for periods of the day with high and low energy consumption in order to
      capture the pattern for occupied and unoccupied building periods."),
      "GBM" = paste("The GBM baseline model is based on the Gradient Boosting
      Machine (GBM) algorithm that is an ensemble trees based machine learning
      method. The GBM generate a model of the energy consumption using time and
      temperature as independent vaiables. However, he practical advantage of using
      the GBM model, in comparison to TOWT model is that it is capable of handle
      additional independent variables, such as holidays indicator, humidity,
      or solar radiation. GBM model has several hyper-parameters that needs to be
      tuned in order to produce an accurate model. These parameters are tuned
      automaticaly using a search grid and a k-folds cross validation procedure.
      It is possible to change the definition of the search grid using the
      Hyper-parameters Setup tab, however for a user that is not familiar with these
      hyper-paprameters, we advise using the default values.")
    )
   })
 output$Model_Name_sc <- renderText({
    switch(input$Model_sc,
      "TOWT" = paste("Time-of-Week-and-Temperature model"),
      "GBM" = paste("Gradient Boosting Machine model")

    )
 })

 # Train the baseline model and format the results
 observeEvent(input$Train_go_sc,{
   switch(input$Model_sc,
     "TOWT" = pam_list <- list(timescaleDays = input$timescaleDays_sc),
     "GBM" = pam_list <- list(k_folds = input$kfolds_sc,
                              ncores = input$ncores_sc,
                              iter = input$gbm_iter_sc,
                              depth = input$depth_sc,
                              lr = input$lr_sc)
   )
   if (input$Model_sc == "GBM"){
     switch(input$d_off_GBM_sc,
       "no_sc" = days_off_path <- NULL,
       "def_d_off_sc" = days_off_path <- system.file("extdata",
                                                     "USA_Fed_Holidays.csv",
                                                      package = "RMV2.0"),
       "yes_sc" = {path_obj <- input$d_off_path_sc
                   days_off_path <- path_obj$datapath}
     )
   }
   res_base <- suppressWarnings(train_model(screen_out, screen = T,
                                            Model = input$Model_sc,
                                            pam_list = pam_list,
                                            days_off_path = days_off_path))
   if (length(res_base$failures)==0){
     screen_out$files_names_mod <- screen_out$files_names
     models_list <- res_base$res_list
     results_summary <- train_model_summary(models_list,
                                            screen_out$files_names)
     screen_out$model_obj_list <- list(models_list = models_list,
                                       results_summary = results_summary)
     output$trainEndBox_sc <- renderInfoBox({
       infoBox(h4("The Baseline models training is completed"),
               "No failures reported",
               icon = icon("thumbs-o-up"),
               fill = T,
               color = "navy")
     })
   }
   else{
     failures <- screen_out$Data_pre_summary[res_base$failures,1]
     screen_out$files_names_mod <- screen_out$files_names[screen_out$files_names %nin% failures]
     models_list <- res_base$res_list
     results_summary <- train_model_summary(models_list,
                                            screen_out$files_names_mod)
     screen_out$model_obj_list <- list(models_list = models_list,
                                       results_summary = results_summary)
     output$trainEndBox_sc <- renderInfoBox({
       infoBox(h4("Baseline modeling failed for:"),
               paste0(failures, collapse = "; "),
               icon = icon("times-circle-o"),
               fill = T,
               color = "red")
     })
   }
   screen_out$Model <- input$Model_sc
 })


 ###########################  Visualize Baseline Results #######################

 #Extract and analyse the pre-installation data files
 output$model_metrics_tab_sc <- renderDataTable({
   results_obj <- screen_out$model_obj_list
   summary_tab <- results_obj$results_summary
   return(summary_tab)
 }, options = list(pageLength = 5))

 #Download the table
 output$model_metrics_tab_sc_dl <- downloadHandler(
   filename = function () {
     paste0(input$p_name_sc, "_model_metrics", ".csv")
   },
   content = function(file) {
     write.csv(screen_out$model_obj_list$results_summary,
       file, row.names = FALSE)
   }
 )

 #Perform the Screening
 pie_plot_screen_sc <- eventReactive(input$screen_go_sc,{
   results_obj <- screen_out$model_obj_list
   summary_tab <- results_obj$results_summary
   screen_summary_list <- screen_summary(summary_tab,
                                         input$R2_tresh_sc,
                                         input$CVRMSE_tresh_sc,
                                         input$NMBE_tresh_sc)
   p <- screen_pie_plot(screen_summary_list)
   return(p)
 })

 output$pie_plot_screen_sc <- plotly::renderPlotly({
  p <- pie_plot_screen_sc()
  return(p)
 })

 # update the pre-installation files names for the visualization
 observe({
   updateSelectInput(session, "Res_vis_sc",choices = screen_out$files_names_mod)
 })

 observeEvent(input$base_plot_go_sc,{
   name_i <- input$Res_vis_sc

   # Pre data
   pre_Data_list <- screen_out$Data_pre
   pre_Data <- pre_Data_list[[name_i]]

   # Data variables
   if (screen_out$Model == "GBM"){
     variables_i <- c(c("Temp"),
                      names(pre_Data)[names(pre_Data) %nin%
                                      c("time","eload","Temp")])
   }
   if (screen_out$Model == "TOWT"){
     variables_i <- "Temp"
   }
   output$radio_plot_err_sc <- renderUI({
     radioButtons(inputId = 'var_err_sc',
                  label = 'Select the Input Variable to Plot',
                  choices = variables_i,
                  selected = "Temp",
                  inline = T)
   })

   idx_i <-  which(input$Res_vis_sc == screen_out$files_names_mod)
   model_obj_list <- screen_out$model_obj_list
   model_list <- model_obj_list$models_list
   model_obj <- model_list[[idx_i]]

   # plot time serie for the selected building
   output$ts_plot_mod_sc <- dygraphs::renderDygraph({
     p <- pre_plot(model_obj)
     return(p)
   })

   # plot actual vs fit for the selected building
   output$scatter_plot_act_fit_sc <- renderPlot({
     p <- act_vs_fit_plot(model_obj)
     return(p)
   })

   # plot error vs selected input for the selected building
   output$scatter_plot_err_input_sc <- renderPlot({
     p <- errors_vs_input_plot(model_obj, input$var_err_sc)
     return(p)
   })
   # Residual autocorrelation plot for the selected building
   output$acf_plot_sc <- renderPlot({
     p <- acf_plot(model_obj, lag_max = input$lag_max_sc)
     return(p)
   })

 })



 # # plot time serie for the selected building
 # model_obj_to_plot <- eventReactive(input$base_plot_go_sc,{
 #   idx_i <-  which(input$Res_vis_sc == screen_out$files_names_mod)
 #   model_obj_list <- screen_out$model_obj_list
 #   model_list <- model_obj_list$models_list
 #   model_obj <- model_list[[idx_i]]
 #   return(model_obj)
 # })
 #
 # output$ts_plot_mod_sc <- dygraphs::renderDygraph({
 #   p <- pre_plot(model_obj_to_plot())
 #   return(p)
 # })
 #
 # # plot actual vs fit for the selected building
 # output$scatter_plot_act_fit_sc <- renderPlot({
 #   p <- act_vs_fit_plot(model_obj_to_plot())
 #   return(p)
 # })
 #
 # # plot actual vs fit for the selected building
 # output$scatter_plot_err_input_sc <- renderPlot({
 #   p <- errors_vs_input_plot(model_obj_to_plot())
 #   return(p)
 # })

 ##  -----  Deprecated  -----
 ## exclude the uncertainty calculation
 #
 # ###########################  Uncertainty Estimation ###########################
 #
 # # Calculate the uncertainties estimation tab
 # observeEvent(input$fsu_est_go_sc,{
 #   model_obj_list <- screen_out$model_obj_list
 #   model_obj_list <- model_obj_list$models_list
 #   screen_out$fsu_est_tab <- fsu_estimation_sc(screen_out, input$d_post_sc,
 #                                               input$Frac_Sav_sc)
 # })
 #
 # # Render uncertianties estimation tab
 # output$fsu_est_tab_sc <- renderDataTable({
 #   fsu_tab <- screen_out$fsu_est_tab
 #   return(fsu_tab)
 #   }, options = list(pageLength = 5))
 #

 ############################  Results summary ################################

 # update the pre-data files names for the visualization
  observe({
    updateSelectInput(session, "Res_summ_sc",choices = screen_out$files_names_mod)
  })

 observeEvent(input$summary_go_sc,{

     results_obj <- screen_out$model_obj_list
     summary_tab <- results_obj$results_summary
     idx_i <- which(input$Res_summ_sc == summary_tab$Name)
     output$R2BoxSc <- renderValueBox({
       valueBox(
         paste0("R2"),
         h4(strong(paste0(summary_tab$R2[idx_i], "%"))),
         icon = icon("area-chart"),
         color = "aqua"
       )
     })
     output$CVRMSEBoxSc <- renderValueBox({
       valueBox(
         paste0("CV(RMSE)"),
         h4(strong(paste0(summary_tab$CVRMSE[idx_i], "%"))),
         icon = icon("area-chart"),
         color = "aqua"
       )
     })
     output$NMBEBoxSc <- renderValueBox({
       valueBox(
         paste0("NMBE"),
         h4(strong(paste0(summary_tab$NMBE[idx_i], "%"))),
         icon = icon("area-chart"),
         color = "aqua"
       )
     })
     output$pre_ts_plot_mod_sc_2 <- dygraphs::renderDygraph({
       model_obj_list <- screen_out$model_obj_list
       model_list <- model_obj_list$models_list
       model_obj <- model_list[[idx_i]]
       p <- pre_plot(model_obj)
       return(p)
     })
 })

  ########################  Save the new Project ###############################

  observeEvent(input$save_sc,{
   save_session(path_save_dir_sc(),input$p_name_sc,screen_out)

  })

  ########################  Save the predictions ###############################

  observeEvent(input$save_pred_sc,{
   save_predictions(screen_out$model_obj_list,path_save_dir_sc(),post = FALSE)
  })

 #=============================================================================
 #                   Screening Server Functions loaded project                #
 #=============================================================================


 ###########################  Load a Project ##################################

  observe({change_box("load_sc_box", !(is.null(input$load_sc)))})

 # Extract the project file path
 shinyFileChoose(input,
                 'load_sc',
                 roots = volumes,
                 filetypes = c('', 'rds'))

  observeEvent(input$load_sc, {
    load_sc <- parseFilePaths(roots=volumes, input$load_sc)
    screen_out$load_sc <- as.character(load_sc$datapath)
    output$load_sc_out <- renderText({basename(screen_out$load_sc)})
  })

  output$fields_sc_load <- reactive({!(is.null(input$load_sc))})
  outputOptions(output, "fields_sc_load", suspendWhenHidden = FALSE)

  # Finalize the Project loading
  observeEvent(input$next_init_sc_lo,{
    load_res <- load_session(screen_out$load_sc)

    #Populate screen_out variable
    screen_out$p_name_sc <- load_res$p_name_sc
    screen_out$pre_dir_sc <- load_res$pre_dir_sc
    screen_out$files_names <- load_res$files_names
    screen_out$Data_pre <- load_res$Data_pre
    screen_out$Data_pre_summary <- load_res$Data_pre_summary
    screen_out$Data_pre_summary_0 <- load_res$Data_pre_summary_0
    screen_out$Model <- load_res$Model
    screen_out$model_obj_list <- load_res$model_obj_list
    screen_out$files_names_mod <- load_res$files_names_mod
    screen_out$fsu_est_tab <- load_res$fsu_est_tab

    output$intEndBox_sc_lo <- renderInfoBox({
      infoBox(h4("The project is loaded"),
              "Proceed to the screening analysis",
              icon = icon("thumbs-o-up"),
              fill = T, color = "navy")
    })
  })

  #==============================================================================
  #                        Savings Analysis Server Functions                    #
  #==============================================================================

  # Set the reactive var where the different variables will be stored
  sav_out <- reactiveValues()
  sav_out$load <- FALSE
  sav_out$nre_done <- FALSE

  ########################  Create a new Project ###############################

  # set the project name
  p_name_sav <- renderText({input$p_name_sav})
  sav_out$p_name_sav <- p_name_sav

  observe({change_box("save_dir_sav_box", !(is.null(input$save_dir_sav)))})

  # set the directory where the project will be stored
  shinyDirChoose(input,
                 'save_dir_sav',
                 roots = volumes,
                 filetypes = c('', 'csv'))
  save_dir_sav <- reactive(input$save_dir_sav)
  path_save_dir_sav <- reactive({
    home <- normalizePath("~")
    file.path(volumes[save_dir_sav()$root],
              paste(unlist(save_dir_sav()$path[-1]),
              collapse = .Platform$file.sep))
  })
  output$save_dir_sav_out <- renderText({basename(path_save_dir_sav())})

 ####################  Set Pre and Post-instatllation Data #####################
  # Pre
  observe({change_box("pre_dir_sav_box", !(is.null(input$pre_dir_sav)))})

  observe({
    if (input$next_init_1!=0 & input$type_init == 2 & input$new_init == 1){
      # set the directory from where the pre-installation will be read
      shinyDirChoose(input,
                     'pre_dir_sav',
                     roots = volumes,
                     filetypes = c('', 'csv'))
       home <- normalizePath("~")
       # get the pre data directory paths
       sav_out$pre_dir_sav <- file.path(volumes[input$pre_dir_sav$root],
                                        paste(unlist(input$pre_dir_sav$path[-1]),
                                        collapse = .Platform$file.sep))
       # get the pre data files paths
       sav_out$pre_path_sav <- list.files(sav_out$pre_dir_sav,
                                          "*\\.csv",
                                          full.names = T,
                                          include.dirs =F)
       # get the pre data files names
       sav_out$pre_names_sav <- list.files(sav_out$pre_dir_sav,
                                           "*\\.csv",
                                           full.names = F,
                                           include.dirs =F)
       #Render the pre path
       output$pre_dir_sav_out <- renderText({basename(sav_out$pre_dir_sav)})
    }
  })

  observe({change_box("post_dir_sav_box", !(is.null(input$post_dir_sav)))})

  # Post
  observe({
    if (input$next_init_1!=0 & input$type_init == 2 & input$new_init == 1){
      # set the directory from where the post-installation will be read
      shinyDirChoose(input,
                     'post_dir_sav',
                     roots = volumes,
                     filetypes = c('', 'csv'))
       home <- normalizePath("~")
       # get the post data directory paths
       sav_out$post_dir_sav <- file.path(volumes[input$post_dir_sav$root],
                                        paste(unlist(input$post_dir_sav$path[-1]),
                                        collapse = .Platform$file.sep))
       # get the post data files paths
       sav_out$post_path_sav <- list.files(sav_out$post_dir_sav,
                                           "*\\.csv",
                                           full.names = T,
                                           include.dirs =F)
       # get the post data files names
       sav_out$post_names_sav <- list.files(sav_out$post_dir_sav,
                                            "*\\.csv",
                                            full.names = F,
                                            include.dirs =F)
       #Render the post path
       output$post_dir_sav_out <- renderText({basename(sav_out$post_dir_sav)})
    }
  })

  output$fields_sav_new <- reactive(!(is.null(input$save_dir_sav)) &&
                                    !(is.null(input$pre_dir_sav)) &&
                                    !(is.null(input$post_dir_sav)))
  outputOptions(output, "fields_sav_new", suspendWhenHidden = FALSE)


  # Extract the summary of the pre data files
  observeEvent(input$next_init_sav,{
    if (length(sav_out$pre_names_sav)!=0 &
       length(sav_out$post_names_sav)!=0 &
       length(sav_out$pre_names_sav)== length(sav_out$post_names_sav)){
      sav_out$files_names <- sav_out$pre_names_sav
      sav_out <- data_load(sav_out$pre_path_sav,
                           sav_out$files_names,
                           sav_out, Post =F, clean = T)
      sav_out <- data_load(sav_out$post_path_sav,
                           sav_out$files_names,
                           sav_out, Post = T, clean = T)
      sav_out$Data_pre_summary <- sav_out$Data_pre_summary_0[,c(1:6,9)]
      sav_out$Data_post_summary <- sav_out$Data_post_summary_0[,c(1:6,9)]
      # sav_out$zmin <- min(sav_out$Data_pre_summary_0[,8],
      #                     sav_out$Data_pre_summary_0[,8], na.rm = T)
      # sav_out$zmax <- max(sav_out$Data_post_summary_0[,7],
      #                     sav_out$Data_post_summary_0[,7], na.rm = T)
      output$intEndBox_sav <- renderInfoBox({
        infoBox(h4("The project setup is completed"),
                "Proceed to the savings analysis",
                icon = icon("thumbs-o-up"),
                fill = T, color = "navy")
      })
    }
    else if (length(sav_out$pre_names_sav)==0 & length(sav_out$post_names_sav)==0){
      output$intEndBox_sav <- renderInfoBox({
        infoBox(h4("No csv files found"),
                "Please select a valid directory for Pre and Post data",
                icon = icon("times-circle-o"),
                fill = T,
                color = "red")
      })
    }
    else if (length(sav_out$pre_names_sav)!=0 & length(sav_out$post_names_sav)==0){
      output$intEndBox_sav <- renderInfoBox({
        infoBox(h4("No csv files found"),
                "Please select a valid directory for Post data",
                icon = icon("times-circle-o"),
                fill = T,
                color = "red")
      })

    }
    else if (length(sav_out$pre_names_sav)==0 & length(sav_out$post_names_sav)!=0){
      output$intEndBox_sav <- renderInfoBox({
        infoBox(h4("No csv files found"),
                "Please select a valid directory for Pre data",
                icon = icon("times-circle-o"),
                fill = T,
                color = "red")
      })
    }
    else if (length(sav_out$pre_names_sav)!=0 &
            length(sav_out$post_names_sav)!=0 &
            length(sav_out$pre_names_sav)!= length(sav_out$post_names_sav)){
      miss <- union(setdiff(sav_out$pre_names_sav, sav_out$post_names_sav),
                    setdiff(sav_out$post_names_sav, sav_out$pre_names_sav))
      # keep only the pre and post for which we have data for both
      '%nin%' <- Negate('%in%')
      sav_out$pre_names_sav<-sav_out$pre_names_sav[sav_out$pre_names_sav %nin% miss]
      sav_out$post_names_sav<-sav_out$post_names_sav[sav_out$post_names_sav %nin% miss]
      for (m in miss){
        sav_out$pre_path_sav <- sav_out$pre_path_sav[grep(m,
                                                          sav_out$pre_path_sav,
                                                          invert = T)]
        sav_out$post_path_sav <- sav_out$post_path_sav[grep(m,
                                                            sav_out$post_path_sav,
                                                            invert = T)]
      }
      if (length(miss)==1){
       miss
      }
      else(miss <- paste0(miss,collapse = " ; "))
      sav_out$files_names <- sav_out$pre_names_sav
      sav_out <- data_load(sav_out$pre_path_sav,
                           sav_out$files_names,
                           sav_out, Post =F, clean = T)
      sav_out <- data_load(sav_out$post_path_sav,
                           sav_out$files_names,
                           sav_out, Post = T, clean = T)
      sav_out$Data_pre_summary <- sav_out$Data_pre_summary_0[,c(1:6,9)]
      sav_out$Data_post_summary <- sav_out$Data_post_summary_0[,c(1:6,9)]
      # sav_out$zmin <- min(sav_out$Data_pre_summary_0[,8],
      #                     sav_out$Data_pre_summary_0[,8], na.rm = T)
      # sav_out$zmax <- max(sav_out$Data_post_summary_0[,7],
      #                     sav_out$Data_post_summary_0[,7], na.rm = T)
      output$intEndBox_sav <- renderInfoBox({
        infoBox(h4("The initialization of the project is partially completed"),
                paste("Proceed to the savings analysis. However, note that missing
                files have been detected for: ", miss, sep = ""),
                icon = icon("exclamation-triangle"),
                fill = T,
                color = "orange")
      })
    }
  })

  #Render the Pre summary tab
  output$pre_summary_tab_sav <- renderDataTable({
   summary_tab <- sav_out$Data_pre_summary
   return(summary_tab)
  }, options = list(pageLength = 5))

  #Download the table
  output$pre_summary_tab_sav_dl <- downloadHandler(
    filename = function () {
      paste0(input$p_name_sav, "_pre_summary", ".csv")
    },
    content = function(file) {
      write.csv(sav_out$Data_pre_summary, file, row.names = FALSE)
    }
  )

  #Render the post summary tab
  output$post_summary_tab_sav <- renderDataTable({
   summary_tab <- sav_out$Data_post_summary
   return(summary_tab)
  }, options = list(pageLength = 5))

  #Download the table
  output$post_summary_tab_sav_dl <- downloadHandler(
    filename = function () {
      paste0(input$p_name_sav, "_post_summary", ".csv")
    },
    content = function(file) {
      write.csv(sav_out$Data_post_summary, file, row.names = FALSE)
    }
  )

  #######################  Pre and post Data Visualization #####################

  # update the pre-installation files names for the visualization
  observe({
    updateSelectInput(session,
                      "Data_vis_sav",
                      choices = sav_out$files_names)
  })


  observeEvent(input$plot_go_sav,{

    name_i <- input$Data_vis_sav
    Data_pre_summary_0_i <- dplyr::filter(sav_out$Data_pre_summary_0,
                                          Name == name_i)
    Data_post_summary_0_i <- dplyr::filter(sav_out$Data_post_summary_0,
                                           Name == name_i)

    # Pre data
    pre_Data_list <- sav_out$Data_pre
    pre_Data <- pre_Data_list[[name_i]]

    # Post data
    post_Data_list <- sav_out$Data_post
    post_Data <- post_Data_list[[name_i]]

    # Data variables

    variables_i <- c(c("Temp"),
                     names(pre_Data)[names(pre_Data) %nin%
                                     c("time","eload","Temp")])
    output$radio_plot_pre_sav <- renderUI({
      radioButtons(inputId = 'var_pre_sav',
                   label = 'Select the Input Variable to Plot',
                   choices = variables_i,
                   selected = "Temp",
                   inline = T)
    })

    output$radio_plot_post_sav <- renderUI({
      radioButtons(inputId = 'var_post_sav',
                   label = 'Select the Input Variable to Plot',
                   choices = variables_i,
                   selected = "Temp",
                   inline = T)
    })
    # Axis range
    range_i <- axis_range(pre_Data,post_Data)

    # heatmap for the selected building
    output$heatmap_pre_sav <- plotly::renderPlotly({
      p <- eload_heatmap(pre_Data,
                         zauto = F,
                         zmin = min(Data_pre_summary_0_i[,8],
                                    Data_post_summary_0_i[,8], na.rm = T),
                         zmax = max(Data_pre_summary_0_i[,7],
                                    Data_post_summary_0_i[,7], na.rm = T))
      return(p)
    })
    output$heatmap_post_sav <- plotly::renderPlotly({
      p <- eload_heatmap(post_Data,
                         zauto = F,
                         zmin = min(Data_pre_summary_0_i[,8],
                                    Data_post_summary_0_i[,8], na.rm = T),
                         zmax = max(Data_pre_summary_0_i[,7],
                                    Data_post_summary_0_i[,7], na.rm = T))
      return(p)
    })

    # plot time serie for the selected building
    output$ts_plot_pre_sav <- dygraphs::renderDygraph({
      p <- act_plot(pre_Data,
                    low_range_0 = range_i$low_range,
                    high_range_0 = range_i$high_range,
                    low_range_T_0 = range_i$low_range_T,
                    high_range_T_0 = range_i$high_range_T)
      return(p)
    })
    output$ts_plot_post_sav <- dygraphs::renderDygraph({
      p <- act_plot(post_Data,
                    low_range_0 = range_i$low_range,
                    high_range_0 = range_i$high_range,
                    low_range_T_0 = range_i$low_range_T,
                    high_range_T_0 = range_i$high_range_T)
      return(p)
    })

    # plot eload vs Temp for the selected building
    output$scatter_plot_pre_sav <- renderPlot({
      p <- eload_vs_input_plot(pre_Data,input$var_pre_sav)
      return(p)
    })
    output$scatter_plot_post_sav <- renderPlot({
      p <- eload_vs_input_plot(post_Data,input$var_post_sav)
      return(p)
    })
  })


  ###########################  Train Baseline Models (sav) #####################

  # generate UI corresponding to the baseline Models
  output$Model_Desc_sav <- renderText({
   switch(input$Model_sav,
    "TOWT" = paste("TOWT is a piecewise linear model and where the predicted
    energy consumption is a combination of two terms that relate the energy
    consumption to the time of the week and the piecewise-continuous effect
    of the temperature. Each time of the week has a different predicted energy
    consumption, and the temperature effect is estimated separately
    for periods of the day with high and low energy consumption in order to
    capture the pattern for occupied and unoccupied building periods."),
    "GBM" = paste("The GBM baseline model is based on the Gradient Boosting
    Machine (GBM) algorithm that is an ensemble trees based machine learning
    method. The GBM generate a model of the energy consumption using time and
    temperature as independent vaiables. However, he practical advantage of using
    the GBM model, in comparison to TOWT model is that it is capable of handle
    additional independent variables, such as holidays indicator, humidity,
    or solar radiation. GBM model has several hyper-parameters that needs to be
    tuned in order to produce an accurate model. These parameters are tuned
    automaticaly using a search grid and a k-folds cross validation procedure.
    It is possible to change the definition of the search grid using the
    Hyper-parameters Setup tab, however for a user that is not familiar with these
    hyper-paprameters, we advise using the default values.")
   )
  })

  output$Model_Name_sav <- renderText({
      switch(input$Model_sav,
        "TOWT" = paste("Time-of-Week-and-Temperature model"),
        "GBM" = paste("Gradient Boosting Machine model")
      )
   })

  # Train the baseline model and format the results
  observeEvent(input$Train_go_sav,{
    switch(input$Model_sav,
      "TOWT" = pam_list <- list(timescaleDays = input$timescaleDays_sav),
      "GBM" = pam_list <- list(k_folds = input$kfolds_sav,
                               ncores = input$ncores_sav,
                               iter = input$gbm_iter_sav,
                               depth = input$depth_sav,
                               lr = input$lr_sav)
    )
    if (input$Model_sav == "GBM"){
      switch(input$d_off_GBM_sav,
        "no_sav" = days_off_path <- NULL,
        "def_d_off_sav" = days_off_path <- system.file("extdata",
                                                      "USA_Fed_Holidays.csv",
                                                       package = "RMV2.0"),
        "yes_sav" = {path_obj <- input$d_off_path_sav
                    days_off_path <- path_obj$datapath}
      )
    }
    res_base <- suppressWarnings(train_model(sav_out, screen = F,
                                             Model = input$Model_sav,
                                             pam_list = pam_list,
                                             days_off_path = days_off_path))
    if (length(res_base$failures)==0){
      sav_out$files_names_mod <- sav_out$files_names
      models_list <- res_base$res_list
      results_summary <- train_model_summary(models_list,
                                             sav_out$files_names)
      sav_out$model_obj_list <- list(models_list = models_list,
                                     results_summary = results_summary)
      output$trainEndBox_sav <- renderInfoBox({
        infoBox(h4("The Baseline models training is completed"),
                "No failures reported",
                icon = icon("thumbs-o-up"),
                fill = T,
                color = "navy")
      })
    }
    else{
      failures <- sav_out$Data_pre_summary[res_base$failures,1]
      sav_out$files_names_mod <- sav_out$files_names[sav_out$files_names %nin% failures]
      models_list <- res_base$res_list
      results_summary <- train_model_summary(models_list,
                                             sav_out$files_names_mod)
      sav_out$model_obj_list <- list(models_list = models_list,
                                     results_summary = results_summary)
      output$trainEndBox_sav <- renderInfoBox({
        infoBox(h4("Baseline modeling failed for:"),
                paste0(failures, collapse = "; "),
                icon = icon("times-circle-o"),
                fill = T,
                color = "red")
      })
    }
    sav_out$Model <- input$Model_sav

  })



  ###########################  Visualize Baseline Results ######################

  # Render the model summary tab
  output$model_metrics_tab_sav <- renderDataTable({
    results_obj <- sav_out$model_obj_list
    summary_tab <- results_obj$results_summary
    return(summary_tab)
  }, options = list(pageLength = 5))

  #Download the table
  output$model_metrics_tab_sav_dl <- downloadHandler(
    filename = function () {
      paste0(input$p_name_sav, "_model_metrics", ".csv")
    },
    content = function(file) {
      write.csv(sav_out$model_obj_list$results_summary,
        file, row.names = FALSE)
    }
  )


  #Perform the Screening
  observeEvent(input$screen_go_sav,{
    results_obj <- sav_out$model_obj_list
    summary_tab <- results_obj$results_summary
    sav_out$screen_summary_list <- screen_summary(summary_tab,
                                                  input$R2_tresh_sav,
                                                  input$CVRMSE_tresh_sav,
                                                  input$NMBE_tresh_sav)
    output$pie_plot_screen_sav <- plotly::renderPlotly({
      p <- screen_pie_plot(sav_out$screen_summary_list)
      return(p)
    })
  })


  # update the pre-installation files names for the visualization
  observe({
    updateSelectInput(session, "Res_vis_sav",choices = sav_out$files_names_mod)
  })

  # plot time serie for the selected building
  observeEvent(input$base_plot_go_sav,{
    name_i <- input$Res_vis_sav

    # Pre data
    pre_Data_list <- sav_out$Data_pre
    pre_Data <- pre_Data_list[[name_i]]

    # Post data
    post_Data_list <- sav_out$Data_post
    post_Data <- post_Data_list[[name_i]]

    # Axis range
    range_i <- axis_range(pre_Data,post_Data)

    # Data variables
    if (sav_out$Model == "GBM"){
      variables_i <- c(c("Temp"),
                       names(pre_Data)[names(pre_Data) %nin%
                                       c("time","eload","Temp")])
    }
    if (sav_out$Model == "TOWT"){
      variables_i <- "Temp"
    }
    output$radio_plot_err_sav <- renderUI({
      radioButtons(inputId = 'var_err_sav',
                   label = 'Select the Input Variable to Plot',
                   choices = variables_i,
                   selected = "Temp",
                   inline = T)
    })


    # model results plot
    idx_i <-  which(input$Res_vis_sav == sav_out$files_names_mod)
    model_obj_list <- sav_out$model_obj_list
    model_list <- model_obj_list$models_list
    model_obj <- model_list[[idx_i]]

    output$pre_ts_plot_mod_sav <- dygraphs::renderDygraph({
      p <- pre_plot(model_obj,
                    low_range_0 = range_i$low_range,
                    high_range_0 = range_i$high_range,
                    low_range_T_0 = range_i$low_range_T,
                    high_range_T_0 = range_i$high_range_T)
      return(p)
    })

    output$post_ts_plot_mod_sav <- dygraphs::renderDygraph({
      p <- post_plot(model_obj,
                    low_range_0 = range_i$low_range,
                    high_range_0 = range_i$high_range,
                    low_range_T_0 = range_i$low_range_T,
                    high_range_T_0 = range_i$high_range_T)
      return(p)
    })

    # plot actual vs fit for the selected building
    output$scatter_plot_act_fit_sav <- renderPlot({
      p <- act_vs_fit_plot(model_obj)
      return(p)
    })

    # plot actual vs fit for the selected building
    output$scatter_plot_err_input_sav <- renderPlot({
      p <- errors_vs_input_plot(model_obj, input$var_err_sav)
      return(p)
    })

    # Residual autocorrelation plot for the selected building
    output$acf_plot_sav <- renderPlot({
      p <- acf_plot(model_obj, lag_max = input$lag_max_sav)
      return(p)
    })
  })


  ###########################  Savings Analysis ###############################

  ##  -----  Deprecated  -----
  ## exclude the uncertainty calculation
  # observeEvent(input$sav_est_go,{
  #  sav_out$sav_est_tab <- savings_summary(sav_out, input$inCL)
  #  sav_out$CL <- input$inCL
  # })
  observeEvent(input$sav_est_go,{
   sav_out$sav_est_tab <- savings_summary(sav_out)
  })

  output$sav_est_tab <- renderDataTable({
    sav_tab <- sav_out$sav_est_tab
    return(sav_tab)
  }, options = list(pageLength = 5))

  #Download the table
  output$sav_est_tab_dl <- downloadHandler(
    filename = function () {
      paste0(input$p_name_sav, "_savings_analysis", ".csv")
    },
    content = function(file) {
      write.csv(sav_out$sav_est_tab, file, row.names = FALSE)
    }
  )


  bar_plot_sav_error <- eventReactive(input$sav_est_go,{
   p <- savings_results_plot(sav_out$sav_est_tab)
   return(p)
  })

  output$bar_plot_sav_error <- plotly::renderPlotly({
   p <- bar_plot_sav_error()
   return(p)
  })

  ###########################  Savings & CUSUM ########################

  # update the pre-installation files names for the visualization
  observe({
    updateSelectInput(session,
                      "Res_vis_sav_2",
                      choices = sav_out$files_names_mod)
  })

  ##  -----  Deprecated  -----
  # # plot time serie for the selected building
  # model_obj_to_plot_sav_2 <- eventReactive(input$plot_gran_go_sav,{
  #   idx_i <-  which(input$Res_vis_sav_2 == sav_out$files_names_mod)
  #   model_obj_list <- sav_out$model_obj_list
  #   model_obj_list <- model_obj_list$models_list
  #   model_obj <- model_obj_list[[idx_i]]
  #   return(model_obj)
  # })
  #
  # output$ts_post_plot_sav <- dygraphs::renderDygraph({
  #  post_plot(model_obj_to_plot_sav_2(), plot_group="savings_1")
  # })
  observeEvent(input$plot_gran_go_sav,{
    idx_i <-  which(input$Res_vis_sav_2 == sav_out$files_names_mod)
    model_obj_list <- sav_out$model_obj_list
    model_obj_list <- model_obj_list$models_list
    model_obj <- model_obj_list[[idx_i]]

    # plot savings time serie for the selected building
    output$ts_savings_plot_sav <- dygraphs::renderDygraph({
                                    savings_plot_type(model_obj,
                                                      input$Plot_gran_sav)})

    # plot CUSUM for the selected building
    output$ts_cusum_plot_sav <- dygraphs::renderDygraph({
                                  cusum_plot_type(model_obj,
                                                  input$Plot_cusum_gran_sav)})

    # Savings heatmap for the selected building
    output$heatmap_savings_sav <- plotly::renderPlotly({
      p <- savings_heatmap(model_obj,
                         zauto = T)
      return(p)
    })
  })
  ##  -----  Deprecated  -----
  # # plot time serie for the selected building
  # plot_obj_savings_sav_2 <- eventReactive(input$plot_gran_go_sav,{
  #  idx_i <-  which(input$Res_vis_sav_2 == sav_out$files_names_mod)
  #  model_obj_list <- sav_out$model_obj_list
  #  model_obj_list <- model_obj_list$models_list
  #  model_obj <- model_obj_list[[idx_i]]
  #  switch(input$Plot_gran_sav,
  #    "Original Granularity" = output$ts_savings_plot_sav <- dygraphs::renderDygraph({save_plot(model_obj, plot_group="savings_1")}),
  #    "Daily" = output$ts_savings_plot_sav <- dygraphs::renderDygraph({daily_save_barplot(model_obj, plot_group="savings_1")}),
  #    "Weekly" = output$ts_savings_plot_sav <- dygraphs::renderDygraph({weekly_save_barplot(model_obj, plot_group="savings_1")}),
  #    "Monthly" = output$ts_savings_plot_sav <- dygraphs::renderDygraph({monthly_save_barplot(model_obj, plot_group="savings_1")})
  #  )
  # })
  #
  # output$ts_savings_plot_sav <- dygraphs::renderDygraph({
  #  plot_obj_savings_sav_2()
  # })
  #
  # plot_obj_cusum_sav_2 <- eventReactive(input$plot_gran_go_sav,{
  #  idx_i <-  which(input$Res_vis_sav_2 == sav_out$files_names_mod)
  #  model_obj_list <- sav_out$model_obj_list
  #  model_obj_list <- model_obj_list$models_list
  #  model_obj <- model_obj_list[[idx_i]]
  #  switch(input$Plot_cusum_gran_sav,
  #    "Original Granularity" = cusum_plot(model_obj, plot_group="savings_1"),
  #    "Daily" = daily_cusum_barplot(model_obj, plot_group="savings_1"),
  #    "Weekly" = weekly_cusum_barplot(model_obj, plot_group="savings_1"),
  #    "Monthly" = monthly_cusum_barplot(model_obj, plot_group="savings_1")
  #  )
  # })
  #
  # output$ts_cusum_plot_sav <- dygraphs::renderDygraph({
  #  plot_obj_cusum_sav_2()
  # })
  #
  # # Savings heatmap for the selected building
  # output$heatmap_savings_sav <- plotly::renderPlotly({
  #   p <- savings_heatmap(model_obj_to_plot_sav_2(),
  #                      zauto = T)
  #   return(p)
  # })

  #####################  Non routine events identification #####################

  # Train the baseline model and format the results
  observeEvent(input$nre_go_sav,{
    res_cbt <- suppressWarnings(nre_eval(sav_out))
    sav_out$nre_done <- TRUE
    if (dim(res_cbt$sav_est_tab_2)[1]!=0){
      sav_est_tab_2 <- res_cbt$sav_est_tab_2
      sav_out$files_names_nre <- sav_est_tab_2$Name
      sav_out$nre_obj_list <- res_cbt
      num_nre <- dim(res_cbt$sav_est_tab_2)[1]
      output$nreEndBox_sav <- renderInfoBox({
        infoBox(h4("Number of Buildings with NRE"),
                icon = icon("warning"),
                paste0(num_nre, collapse = "; "),
                fill = T,
                color = "orange")
      })
      output$nre_test_tab_sav <- renderDataTable({
        sav_tab_2 <- res_cbt$sav_est_tab_2
        sav_tab_2 <- subset(sav_tab_2, select=-NRE)
        return(sav_tab_2)
      }, options = list(pageLength = 5))
    }
    else{
      output$nreEndBox_sav <- renderInfoBox({
        infoBox(h4("No NRE detected"),
                icon = icon("thumbs-o-up"),
                fill = T,
                color = "aqua")
      })
    }

  })

  #Download the table
  output$nre_test_tab_sav_dl <- downloadHandler(
    filename = function () {
      paste0(input$p_name_sav, "_non_routine", ".csv")
    },
    content = function(file) {
      write.csv(subset(sav_out$nre_obj_list$sav_est_tab_2,
                        select=-NRE),
                        file, row.names = FALSE)
    }
  )

  # update the nre files names for the visualization
  observe({
    updateSelectInput(session, "nre_vis_sav",choices = sav_out$files_names_nre)
  })

  observeEvent(input$nre_plot_go_sav,{
    name_i <- input$nre_vis_sav

    # nre results
    #idx_i <-  which(input$nre_vis_sav == sav_out$files_names_nre)
    nre_obj_list <- sav_out$nre_obj_list
    cbt_obj_list <- nre_obj_list$cbt_obj_list
    cbt_obj_list <- cbt_obj_list[[name_i]]

    # model results plot
    idx_j <-  which(input$nre_vis_sav == sav_out$files_names_mod)
    model_obj_list <- sav_out$model_obj_list
    model_list <- model_obj_list$models_list
    model_obj <- model_list[[idx_j]]

    output$nre_ts_plot_sav <- dygraphs::renderDygraph({
      p <- cpt_save_plot(model_obj,cbt_obj_list)
      return(p)
    })

  })

 #####################  Non routine events identification (load)################
  observeEvent(input$nre_go_sav_lo,{
    if(sav_out$nre_done){
      res_cbt <- sav_out$nre_obj_list
    }
    else{
      res_cbt <- suppressWarnings(nre_eval(sav_out))
    }
    if (dim(res_cbt$sav_est_tab_2)[1]!=0){
      sav_est_tab_2 <- res_cbt$sav_est_tab_2
      sav_out$files_names_nre <- sav_est_tab_2$Name
      sav_out$nre_obj_list <- res_cbt
      num_nre <- dim(res_cbt$sav_est_tab_2)[1]
      output$nreEndBox_sav_lo <- renderInfoBox({
        infoBox(h4("Number of Buildings with Potential NRE"),
                icon = icon("warning"),
                paste0(num_nre, collapse = "; "),
                fill = T,
                color = "orange")
      })
      output$nre_test_tab_sav_lo <- renderDataTable({
        sav_tab_2 <- res_cbt$sav_est_tab_2
        sav_tab_2 <- subset(sav_tab_2, select=-NRE)
        return(sav_tab_2)
      }, options = list(pageLength = 5))
    }
    else{
      output$nreEndBox_sav_lo <- renderInfoBox({
        infoBox(h4("No Potential NRE detected"),
                icon = icon("thumbs-o-up"),
                fill = T,
                color = "aqua")
      })
    }

  })

  #Download the table
  output$nre_test_tab_sav_lo_dl <- downloadHandler(
    filename = function () {
      paste0(input$p_name_sav, "_savings_analysis", ".csv")
    },
    content = function(file) {
      write.csv(subset(sav_out$nre_obj_list$sav_est_tab_2,
                        select=-NRE),
        file, row.names = FALSE)
    }
  )

  # update the nre files names for the visualization
  observe({
    updateSelectInput(session, "nre_vis_sav_lo",choices = sav_out$files_names_nre)
  })

  observeEvent(input$nre_plot_go_sav_lo,{
    name_i <- input$nre_vis_sav_lo

    # nre results
    #idx_i <-  which(input$nre_vis_sav == sav_out$files_names_nre)
    nre_obj_list <- sav_out$nre_obj_list
    cbt_obj_list <- nre_obj_list$cbt_obj_list
    cbt_obj_list <- cbt_obj_list[[name_i]]

    # model results plot
    idx_j <-  which(input$nre_vis_sav_lo == sav_out$files_names_mod)
    model_obj_list <- sav_out$model_obj_list
    model_list <- model_obj_list$models_list
    model_obj <- model_list[[idx_j]]

    output$nre_ts_plot_sav_lo <- dygraphs::renderDygraph({
      p <- cpt_save_plot(model_obj,cbt_obj_list)
      return(p)
    })

  })

  ############################  Results summary ################################

  # update the pre-data files names for the visualization
   observe({
     updateSelectInput(session, "Res_summ_sav",choices = sav_out$files_names_mod)
   })

  observeEvent(input$summary_go_sav,{
    if (input$type_summ == 2){
      sav_tab <- sav_out$sav_est_tab
      idx_i <- which(input$Res_summ_sav == sav_tab$Name)
      output$R2BoxSav <- renderValueBox({
        valueBox(
          paste0("R2"),
          h4(strong(paste0(sav_tab$R2[idx_i], "%"))),
          icon = icon("area-chart"),
          color = "aqua"
        )
      })
      output$CVRMSEBoxSav <- renderValueBox({
        valueBox(
          paste0("CV(RMSE)"),
          h4(strong(paste0(sav_tab$CVRMSE[idx_i], "%"))),
          icon = icon("area-chart"),
          color = "aqua"
        )
      })
      output$NMBEBoxSav <- renderValueBox({
        valueBox(
          paste0("NMBE"),
          h4(strong(paste0(sav_tab$NMBE[idx_i], "%"))),
          icon = icon("area-chart"),
          color = "aqua"
        )
      })
      output$pre_ts_plot_mod_sav_2 <- dygraphs::renderDygraph({
        model_obj_list <- sav_out$model_obj_list
        model_list <- model_obj_list$models_list
        model_obj <- model_list[[idx_i]]
        p <- pre_plot(model_obj)
        return(p)
      })
      output$post_ts_plot_mod_sav_2 <- dygraphs::renderDygraph({
        model_obj_list <- sav_out$model_obj_list
        model_list <- model_obj_list$models_list
        model_obj <- model_list[[idx_i]]
        p <- post_plot(model_obj)
        return(p)
      })
      output$SavingsBoxSav <- renderValueBox({
        valueBox(
          paste0("Savings"),
          h4(strong(paste0(sav_tab$Savings[idx_i], " kWh"))),
          icon = icon("leaf"),
          color = "teal"
        )
      })
      output$FsBoxSav <- renderValueBox({
        valueBox(
          paste0("Fractional Savings (FS)"),
          h4(strong(paste0(sav_tab$FS[idx_i], " %"))),
          icon = icon("leaf"),
          color = "teal"
        )
      })
      output$FsBoxSav <- renderValueBox({
        valueBox(
          paste0("Fractional Savings (FS)"),
          h4(strong(paste0(sav_tab$FS[idx_i], " %"))),
          icon = icon("leaf"),
          color = "teal"
        )
      })
      if(input$nre_go_sav || input$nre_go_sav_lo){
        res_cbt <- sav_out$nre_obj_list
        if (dim(res_cbt$sav_est_tab_2)[1]!=0){
          sav_est_tab_2 <- res_cbt$sav_est_tab_2
          idx_i_2 <- which(input$Res_summ_sav == sav_est_tab_2$Name)
          if (length(idx_i_2)!=0){
            output$NreBoxSav <- renderInfoBox({
              valueBox(
                paste0("Number of detected change points"),
                h4(strong(paste0(sav_est_tab_2$cpts[idx_i_2]))),
                icon = icon("warning"),
                color = "orange"
             )
           })
          }
          else{
            output$NreBoxSav <- renderInfoBox({
              valueBox(
                paste0("No Potential NRE detected"),
                h4("_"),
                icon = icon("thumbs-o-up"),
                color = "aqua"
              )
            })
          }
        }
      }



      ##  -----  Deprecated  -----
      ## exclude the uncertainty calculation
      # output$SavRangeBoxSav <- renderValueBox({
      #   valueBox(
      #     paste0("Savings Range"),
      #     h4(strong(paste0(sav_tab$Savings_Range[idx_i], " (@ ", sav_out$CL, "%", " CL)"))),
      #     icon = icon("leaf"),
      #     color = "teal"
      #   )
      # })
      # output$FsRangeBoxSav <- renderValueBox({
      #   valueBox(
      #     paste0("FS Range (in %)"),
      #     h4(strong(paste0(sav_tab$FS_Range[idx_i], " (@ ", sav_out$CL, "%", " CL)"))),
      #     icon = icon("leaf"),
      #     color = "teal"
      #   )
      # })
      # output$FsuBoxSav <- renderValueBox({
      #   valueBox(
      #     paste0("FSU"),
      #     h4(strong(paste0(sav_tab$FSU[idx_i], "%", " (@ ", sav_out$CL, "%", " CL)"))),
      #     icon = icon("bar-chart-o"),
      #     color = "aqua"
      #   )
      # })
    }
    else if (input$type_summ == 1 & input$level_summ == 1){
      port_sav_tab <- portfolio_savings(sav_out)
      output$bar_plot_sav_error_2 <- plotly::renderPlotly({
       p <- savings_results_plot(sav_out$sav_est_tab)
       return(p)
      })
      output$PortSavingsBoxSav <- renderValueBox({
        valueBox(
          paste0("Savings"),
          h4(strong(paste0(port_sav_tab$Savings_portfolio, " kWh"))),
          icon = icon("leaf"),
          color = "teal"
        )
      })
      output$PortFsBoxSav <- renderValueBox({
        valueBox(
          paste0("FS (in %)"),
          h4(strong(paste0(port_sav_tab$FS_portfolio, " %"))),
          icon = icon("leaf"),
          color = "teal"
        )
      })
      ##  -----  Deprecated  -----
      ## exclude the uncertainty calculation
      # output$PortFsuBoxSav <- renderValueBox({
      #   valueBox(
      #     paste0("FSU"),
      #     h4(strong(paste0(port_sav_tab$FSU_portfolio, "%", " (@ ", sav_out$CL, "%", " CL)"))),
      #     icon = icon("bar-chart-o"),
      #     color = "aqua"
      #   )
      # })
      # output$PortSavRangeBoxSav <- renderValueBox({
      #   valueBox(
      #     paste0("Savings Range"),
      #     h4(strong(paste0(port_sav_tab$Savings_Range, " (@ ", sav_out$CL, "%", " CL)"))),
      #     icon = icon("leaf"),
      #     color = "teal"
      #   )
      # })
      # output$PortFsRangeBoxSav <- renderValueBox({
      #   valueBox(
      #     paste0("FS Range (in %)"),
      #     h4(strong(paste0(port_sav_tab$FS_Range, " (@ ", sav_out$CL, "%", " CL)"))),
      #     icon = icon("leaf"),
      #     color = "teal"
      #   )
      # })
    }
    else if (input$type_summ == 1 & input$level_summ == 2){
      port_sav_tab <- portfolio_savings(sav_out, screened =T)
      output$bar_plot_sav_error_3 <- plotly::renderPlotly({
       p <- savings_results_plot(sav_out$sav_est_tab)
       return(p)
      })
      output$PortSavingsBoxSav_2 <- renderValueBox({
        valueBox(
          paste0("Savings"),
          h4(strong(paste0(port_sav_tab$Savings_portfolio, " kWh"))),
          icon = icon("leaf"),
          color = "teal"
        )
      })
      output$PortFsBoxSav_2 <- renderValueBox({
        valueBox(
          paste0("FS (in %)"),
          h4(strong(paste0(port_sav_tab$FS_portfolio, " %"))),
          icon = icon("leaf"),
          color = "teal"
        )
      })
      ##  -----  Deprecated  -----
      ## exclude the uncertainty calculation
      # output$PortFsuBoxSav_2 <- renderValueBox({
      #   valueBox(
      #     paste0("FSU"),
      #     h4(strong(paste0(port_sav_tab$FSU_portfolio, "%", " (@ ", sav_out$CL, "%", " CL)"))),
      #     icon = icon("bar-chart-o"),
      #     color = "aqua"
      #   )
      # })
      # output$PortSavRangeBoxSav_2 <- renderValueBox({
      #   valueBox(
      #     paste0("Savings Range"),
      #     h4(strong(paste0(port_sav_tab$Savings_Range, " (@ ", sav_out$CL, "%", " CL)"))),
      #     icon = icon("leaf"),
      #     color = "teal"
      #   )
      # })
      # output$PortFsRangeBoxSav_2 <- renderValueBox({
      #   valueBox(
      #     paste0("FS Range (in %)"),
      #     h4(strong(paste0(port_sav_tab$FS_Range, " (@ ", sav_out$CL, "%", " CL)"))),
      #     icon = icon("leaf"),
      #     color = "teal"
      #   )
      # })
    }

  })
  ########################  Save the new Project ###############################

  observeEvent(input$save_sav,{
   save_session(path_save_dir_sav(),input$p_name_sav,sav_out)
  })

  ########################  Save the predictions ###############################

  observeEvent(input$save_pred_sav,{
   save_predictions(sav_out$model_obj_list,path_save_dir_sav())
  })

  #=============================================================================
  #                Savings Analysis Server Functions loaded project            #
  #=============================================================================


  ###########################  Load a Project ##################################

  observe({change_box("load_sav_box", !(is.null(input$load_sav)))})

  # Extract the project file path
  shinyFileChoose(input,
                  'load_sav',
                  roots = volumes,
                  filetypes = c('', 'rds'))

   observeEvent(input$load_sav, {
     load_sav <- parseFilePaths(roots=volumes, input$load_sav)
     sav_out$load_sav <- as.character(load_sav$datapath)
     output$load_sav_out <- renderText({basename(sav_out$load_sav)})
   })

   output$fields_sav_load <- reactive(!(is.null(input$load_sav)))
   outputOptions(output, "fields_sav_load", suspendWhenHidden = FALSE)

   # Finalize the Project loading
   observeEvent(input$next_init_sav_lo,{
     load_res <- load_session(sav_out$load_sav)

     #Populate screen_out variable
     sav_out$load <- TRUE
     sav_out$p_name_sav <- load_res$p_name_sav
     sav_out$files_names <- load_res$files_names
     sav_out$Data_pre <- load_res$Data_pre
     sav_out$Data_pre_summary <- load_res$Data_pre_summary
     sav_out$Data_pre_summary_0 <- load_res$Data_pre_summary_0
     sav_out$Data_post <- load_res$Data_post
     sav_out$Data_post_summary <- load_res$Data_post_summary
     sav_out$Data_post_summary_0 <- load_res$Data_post_summary_0
     sav_out$Model <- load_res$Model
     sav_out$model_obj_list <- load_res$model_obj_list
     sav_out$files_names_mod <- load_res$files_names_mod
     sav_out$sav_est_tab <- load_res$sav_est_tab
     ##  -----  Deprecated  -----
     ## exclude the uncertainty calculation
     #sav_out$CL <- load_res$CL
     sav_out$screen_summary_list <- load_res$screen_summary_list
     sav_out$files_names_nre <- load_res$files_names_nre
     sav_out$nre_obj_list <- load_res$nre_obj_list
     sav_out$nre_done <- load_res$nre_done

     output$intEndBox_sav_lo <- renderInfoBox({
       infoBox(h4("The project is loaded"),
               "Proceed to the savings analysis",
               icon = icon("thumbs-o-up"),
               fill = T, color = "navy")
     })
   })

 })#end of shinyServer
LBNL-ETA/RMV2.0 documentation built on Nov. 9, 2020, 5:44 a.m.