inst/application/src/server/09_export_data.R

#------------------
# gestion de la liste
#------------------
output$info_list_data_export <- renderUI({
  list_data <- list_data_all$antaresDataList
  if(length(list_data) > 0){
    isolate({
      # affichage du nom de l'etude
      study <- lapply(1:length(list_data), function(i) {
        study_name <- paste0("export_list_study_", i)
        div(
          h4(textOutput(study_name)), style = 'height:24px', align = "center")
      })
      # checkbox de selection
      check_list <- lapply(1:length(list_data), function(i) {
        check_name <- paste0("export_list_study_check", i)
        div(
          checkboxInput(check_name, antaresVizMedTSO:::.getLabelLanguage("Select this study", current_language$language), value = ifelse(i == 1, T, F)), align = "center")
      })

      # bouton pour afficher les parametres
      params_list <- lapply(1:length(list_data), function(i) {
        btn_name <- paste0("export_list_study_params", i)
        div(
          actionButton(btn_name, antaresVizMedTSO:::.getLabelLanguage("View parameters", current_language$language)), align = "center")
      })

      # format et retour
      fluidRow(
        column(4, do.call(tagList, study)),
        column(2, do.call(tagList, params_list)),
        column(2, do.call(tagList, check_list), offset = 0)
      )
    })
  }else {
    # element vide si pas de donnees
    fluidRow()
  }
})

# creation des outputs
# - titre de l'etude
# - print des parametres
observe({
  # lancement lors de la recuperation des donnees formatees
  list_data_tmp <- list_data_all$antaresDataList
  if(length(list_data_tmp) > 0){
    isolate({
      ctrl <- lapply(1:length(list_data_tmp), function(i) {
        study_name <- paste0("export_list_study_", i)
        study_params <- paste0("export_list_study_params", i)
        output[[study_name]] <- renderText({
          names(list_data_tmp)[i]
        })
        
        output[[study_params]] <- renderPrint({
          str(list_data_all$params[[i]])
        })
      })
    })
  }
})

# observe locaux pour l'affichage des parametres
# et pour la suppression des etudes
for(j in 1:16){
  local({
    l_j <- j
    observe({
      if(!is.null(input[[paste0("export_list_study_params", l_j)]])){
        if(input[[paste0("export_list_study_params", l_j)]] > 0){
          showModal(modalDialog(
            easyClose = TRUE,
            footer = NULL,
            verbatimTextOutput(paste0("export_list_study_params", l_j))
          ))
        }
      }
    })
  })
}

# observe locaux pour selectionner une etude de reference

imported_data <- reactiveVal(NULL)

observe({
  list_data <- list_data_all$antaresDataList
  if(length(list_data) == 0){
    imported_data(NULL)
  }
})

for(j in 1:16){
  local({
    l_j <- j
    #on ne peut avoir qu une etude de reference a la fois 
    observe({
      list_data <- list_data_all$antaresDataList
      if(length(list_data) > 0){
        if(!is.null(input[[paste0("export_list_study_check", l_j)]])){
          if(input[[paste0("export_list_study_check", l_j)]] > 0){
            isolate({
              for(k in 1:16){
                if(k != l_j){
                  #on ne peut avoir qu une etude de reference a la fois 
                  updateCheckboxInput(session, paste0("export_list_study_check", k), 
                                      label = antaresVizMedTSO:::.getLabelLanguage("Select this study", 
                                                                                   current_language$language),
                                      value = FALSE)
                } else {
                  data <- list_data[[k]]
                  imported_data(data)
                }
              }
            })
          }
        }
      }
    })
  })
}


# ui et initialisation des inputs -----------------------------------------

output$panels_tab <- renderUI({
  imported_data <- imported_data()
  # browser()
  isolate({
    if(!is.null(imported_data)) {
      nb_panels <- ifelse("list" %in% class(imported_data), length(imported_data), 1)
      if(nb_panels == 1) {
        panel_name <- paste0(attributes(imported_data)$names[1], "s")
        if(attributes(imported_data)$names[2] == "cluster") panel_name <- "clusters"

        if(panel_name == "clusters") {
          res_list <- tabsetPanel(
            tabPanel(title = panel_name,
                     fluidRow(
                       column(3,
                              selectInput("lig1", label = "Areas", choices = NULL, selected = NULL, multiple = T)),
                       column(3,
                              selectInput("lig1_2", label = "Clusters", choices = NULL, selected = NULL, multiple = T)),
                       column(3,
                              selectInput("col1", label = "Variables", choices = NULL, selected = NULL, multiple = T))
                     ),
                     tags$hr(),
                     fluidRow(column(3,infoBoxOutput("box_tab1_1", 12)),
                              column(3,infoBoxOutput("box_tab1_2", 12)),
                              column(3,infoBoxOutput("box_tab1_3", 12)),
                              column(2, downloadButton("import_tab1", antaresVizMedTSO:::.getLabelLanguage("Export this table", current_language$language))),
                              column(1, tags$div(style="padding-top:0px; display: none", id = "export_busy_1",
                                                 tags$img(src="spinner.gif", height = 40, width = 40),align = 'left'))
                     ),
                     tags$hr(),
                     div(h3(antaresVizMedTSO:::.getLabelLanguage("First 10 rows", current_language$language)), align = "center"),
                     DTOutput("dt1")
            )
          )
        } else {
          res_list <- tabsetPanel(
            tabPanel(title = panel_name,
                     fluidRow(
                       column(3,
                              selectInput("lig1", label = panel_name, choices = NULL, selected = NULL, multiple = T)),
                       column(3,
                              selectInput("col1", label = "Variables", choices = NULL, selected = NULL, multiple = T))
                     ),
                     tags$hr(),
                     fluidRow(column(3,infoBoxOutput("box_tab1_1", 12)),
                              column(3,infoBoxOutput("box_tab1_2", 12)),
                              column(3,infoBoxOutput("box_tab1_3", 12)),
                              column(2, downloadButton("import_tab1", antaresVizMedTSO:::.getLabelLanguage("Export this table", current_language$language))),
                              column(1, tags$div(style="padding-top:0px; display: none", id = "export_busy_1",
                                                 tags$img(src="spinner.gif", height = 40, width = 40),align = 'left'))
                     ),
                     tags$hr(),
                     div(h3(antaresVizMedTSO:::.getLabelLanguage("First 10 rows", current_language$language)), align = "center"),
                     DTOutput("dt1")
            )
          )
        }

      }
      else if(nb_panels > 1) {
        liste_tab <- list()
        sapply(1:nb_panels, FUN = function(nb){
          panel_name <- names(imported_data)[nb]
          if(panel_name %in% c("clusters", "clustersRes")) {
            liste_tab[[nb]] <<- tabPanel(title = panel_name,
                                         fluidRow(column(3,
                                                         selectInput(paste0("lig", nb), label = "Areas", choices = NULL, selected = NULL, multiple = T)),
                                                  column(3,
                                                         selectInput(paste0("lig", nb, "_2"), label = "Clusters", choices = NULL, selected = NULL, multiple = T)),
                                                  column(3,
                                                         selectInput(paste0("col", nb), label = "Variables", choices = NULL, selected = NULL, multiple = T))
                                         ),
                                         tags$hr(),
                                         fluidRow(column(3,infoBoxOutput(paste0("box_tab", nb, "_1"), 12)),
                                                  column(3,infoBoxOutput(paste0("box_tab", nb, "_2"), 12)),
                                                  column(3,infoBoxOutput(paste0("box_tab", nb, "_3"), 12)),
                                                  column(2, downloadButton(paste0("import_tab", nb), antaresVizMedTSO:::.getLabelLanguage("Export this table", current_language$language))),
                                                  column(1, tags$div(style="padding-top:0px; display: none", id = paste0("export_busy_", nb),
                                                                     tags$img(src="spinner.gif", height = 40, width = 40),align = 'left'))
                                         ),
                                         tags$hr(),
                                         div(h3(antaresVizMedTSO:::.getLabelLanguage("First 10 rows", current_language$language)), align = "center"),
                                         DTOutput(paste0("dt", nb))
            )
          } else {
            liste_tab[[nb]] <<- tabPanel(title = panel_name,
                                         fluidRow(
                                           column(3,
                                                  selectInput(paste0("lig", nb), label = panel_name, choices = NULL, selected = NULL, multiple = T)),
                                           column(3,
                                                  selectInput(paste0("col", nb), label = "Variables", choices = NULL, selected = NULL, multiple = T))
                                         ),
                                         tags$hr(),
                                         fluidRow(column(3,infoBoxOutput(paste0("box_tab", nb, "_1"), 12)),
                                                  column(3,infoBoxOutput(paste0("box_tab", nb, "_2"), 12)),
                                                  column(3,infoBoxOutput(paste0("box_tab", nb, "_3"), 12)),
                                                  column(2, downloadButton(paste0("import_tab", nb), antaresVizMedTSO:::.getLabelLanguage("Export this table", current_language$language))),
                                                  column(1, tags$div(style="padding-top:0px; display: none", id = paste0("export_busy_", nb),
                                                                     tags$img(src="spinner.gif", height = 40, width = 40),align = 'left'))
                                         ),
                                         tags$hr(),
                                         div(h3(antaresVizMedTSO:::.getLabelLanguage("First 10 rows", current_language$language)), align = "center"),
                                         DTOutput(paste0("dt", nb))
            )
          }
        })

        if(nb_panels == 2) {
          res_list <- tabsetPanel(liste_tab[[1]], liste_tab[[2]])
        } else if(nb_panels == 3) {
          res_list <- tabsetPanel(liste_tab[[1]], liste_tab[[2]], liste_tab[[3]])
        } else if(nb_panels == 4) {
          res_list <- tabsetPanel(liste_tab[[1]], liste_tab[[2]], liste_tab[[3]], liste_tab[[4]])
        } else if(nb_panels == 5) {
          res_list <- tabsetPanel(liste_tab[[1]], liste_tab[[2]], liste_tab[[3]], liste_tab[[4]], liste_tab[[5]])
        }

      } else {
        res_list <- NULL
      }
      res_list
    } else {
      list()
    }
  })
})

outputOptions(output, "panels_tab", suspendWhenHidden = FALSE)


# update des inputs -------------------------------------------------------
observe({
  imported_data <- imported_data()
  if(!is.null(imported_data)) {
    isolate({

      # browser()
      nb_panels <- ifelse("list" %in% class(imported_data), length(imported_data), 1)
      if(nb_panels == 1) {

        panel_name <- paste0(attributes(imported_data)$names[1], "s")
        if(attributes(imported_data)$names[2] == "cluster") panel_name <- "clusters"

        if(panel_name == "areas") {
          choix_lig1 <- unique(imported_data$area)
          choix_col1 <- colnames(imported_data)[-which(colnames(imported_data) == "area")]
        } else if(panel_name == "links") {
          choix_lig1 <- unique(imported_data$link)
          choix_col1 <- colnames(imported_data)[-which(colnames(imported_data) == "link")]
        } else if(panel_name == "districts") {
          choix_lig1 <- unique(imported_data$district)
          choix_col1 <- colnames(imported_data)[-which(colnames(imported_data) == "district")]
        } else if(panel_name %in% c("clusters", "clustersRes")) {
          choix_lig1 <- unique(imported_data$area)
          choix_col1 <- colnames(imported_data)[-which(colnames(imported_data) %in% c("area", "cluster"))]
        }

        if(panel_name %in% c("clusters", "clustersRes")) {
          updateSelectInput(session, "lig1", label = "areas", choices = c("all", as.character(choix_lig1)),
                            selected = "all")
        } else {
          updateSelectInput(session, "lig1", label = panel_name, choices = c("all", as.character(choix_lig1)),
                            selected = "all")
        }


        if(any(c("month", "week", "day", "hour", "time") %in% choix_col1)) {
          choix_col1 <- choix_col1[-which(choix_col1 %in% c("month", "week", "day", "hour", "time"))]
        }

        updateSelectInput(session, "col1", label = "Variables", choices = c("all", as.character(choix_col1)),
                          selected = "all")

      } else if(nb_panels > 0){
        sapply(1:nb_panels, FUN = function(nb) {
          panel_name = names(imported_data)[nb]
          data_nb <- imported_data[[nb]]
          if(panel_name == "areas") {
            choix_lig1 <- unique(data_nb$area)
            choix_col1 <- colnames(data_nb)[-which(colnames(data_nb) %in% c("area","month", "week",
                                                                            "day", "hour", "time"))]
          } else if(panel_name == "links") {
            choix_lig1 <- unique(data_nb$link)
            choix_col1 <- colnames(data_nb)[-which(colnames(data_nb) %in% c("link","month", "week",
                                                                            "day", "hour", "time"))]
          } else if(panel_name == "districts") {
            choix_lig1 <- unique(data_nb$district)
            choix_col1 <- colnames(data_nb)[-which(colnames(data_nb) %in% c("district","month", "week",
                                                                            "day", "hour", "time"))]
          } else if(panel_name %in% c("clusters", "clustersRes")) {
            choix_lig1 <- unique(data_nb$area)
            choix_col1 <- colnames(data_nb)[-which(colnames(data_nb) %in% c("area", "cluster", "month", "week",
                                                                            "day", "hour", "time"))]
          }

          if(panel_name %in% c("clusters", "clustersRes")) {
            updateSelectInput(session, paste0("lig", nb), label = "areas",
                              choices = c("all", as.character(choix_lig1)), selected = "all")
          } else {
            updateSelectInput(session, paste0("lig", nb), label = panel_name,
                              choices = c("all", as.character(choix_lig1)), selected = "all")
          }

          updateSelectInput(session, paste0("col", nb), label = "Variables", choices = c("all", as.character(choix_col1)),
                            selected = "all")
        })
      } else {
        NULL
      }

    })
  } else {
    NULL
  }
})

choix_lig1_2 <- reactive({
  imported_data <- imported_data()
  lig1 <- input$lig1
  isolate({
    if(!is.null(lig1) && length(imported_data) > 1) {
      nb_panels <- ifelse("list" %in% class(imported_data), length(imported_data), 1)
      if(nb_panels > 1) {
        panel_name = names(imported_data)[1]
        data_nb <- imported_data[[1]]
      } else {
        panel_name <- paste0(attributes(imported_data)$names[1], "s")
        if(attributes(imported_data)$names[2] == "cluster") panel_name <- "clusters"
        data_nb <- imported_data
      }

      if(panel_name %in% c("clusters", "clustersRes") & !is.null(input[[paste0("lig", 1)]])) {
        if("all" %in% lig1) {
          lig1 <- as.character(unique(data_nb$area))
        }
        data_2 <- data_nb[area %in% lig1]
        choix_lig1_2 <- c("all", as.character(unique(data_2$cluster)))

        current_sel <- isolate(input$lig1_2)
        selected <- intersect(current_sel, choix_lig1_2)
        if(length(selected) == 0){
          selected = "all"
        }
        choix_lig1_2 <- list(choices = choix_lig1_2, selected = selected)
      } else {
        choix_lig1_2 <- NULL
      }

    } else {
      choix_lig1_2 <- NULL
    }
    return(choix_lig1_2)
  })
})

observe({
  choix_lig1_2 <- choix_lig1_2()
  if(!is.null(choix_lig1_2)) {
    isolate({
      updateSelectInput(session, "lig1_2", label = "Clusters", choices = as.character(choix_lig1_2$choices),
                        selected = as.character(choix_lig1_2$selected))
    })
  }
})

choix_lig2_2 <- reactive({
  imported_data <- imported_data()
  lig2 <- input$lig2
  isolate({
    if(!is.null(lig2) && length(imported_data) > 1) {
      nb_panels <- ifelse("list" %in% class(imported_data), length(imported_data), 1)
      if(nb_panels > 1) {
        panel_name = names(imported_data)[2]
        data_nb <- imported_data[[2]]
        if(panel_name %in% c("clusters", "clustersRes") & !is.null(input[[paste0("lig", 2)]])) {
          if("all" %in% lig2) {
            lig2 <- as.character(unique(data_nb$area))
          }
          data_2 <- data_nb[area %in% lig2]
          choix_lig2_2 <- c("all", as.character(unique(data_2$cluster)))

          current_sel <- isolate(input$lig2_2)
          selected <- intersect(current_sel, choix_lig2_2)
          if(length(selected) == 0){
            selected = "all"
          }
          choix_lig2_2 <- list(choices = choix_lig2_2, selected = selected)

        } else {
          choix_lig2_2 <- NULL
        }

      } else {
        choix_lig2_2 <- NULL
      }
      return(choix_lig2_2)
    }

  })
})

observe({
  choix_lig2_2 <- choix_lig2_2()
  if(!is.null(choix_lig2_2)) {
    isolate({
      updateSelectInput(session, "lig2_2", label = "Clusters", choices = as.character(choix_lig2_2$choices),
                        selected = as.character(choix_lig2_2$selected))

    })
  }
})

choix_lig3_2 <- reactive({
  imported_data <- imported_data()
  lig3 <- input$lig3
  isolate({
    if(!is.null(lig3) & length(imported_data) > 2) {
      nb_panels <- ifelse("list" %in% class(imported_data), length(imported_data), 1)
      if(nb_panels > 1) {
        panel_name = names(imported_data)[3]
        data_nb <- imported_data[[3]]
        if(panel_name %in% c("clusters", "clustersRes") & !is.null(input[[paste0("lig", 3)]])) {
          if("all" %in% lig3) {
            lig3 <- as.character(unique(data_nb$area))
          }
          data_2 <- data_nb[area %in% lig3]
          choix_lig3_2 <- c("all", as.character(unique(data_2$cluster)))

          current_sel <- isolate(input$lig3_2)
          selected <- intersect(current_sel, choix_lig3_2)
          if(length(selected) == 0){
            selected = "all"
          }
          choix_lig3_2 <- list(choices = choix_lig3_2, selected = selected)
        } else {
          choix_lig3_2 <- NULL
        }

      } else {
        choix_lig3_2 <- NULL
      }
      return(choix_lig3_2)
    }

  })
})

observe({
  choix_lig3_2 <- choix_lig3_2()
  if(!is.null(choix_lig3_2)) {
    isolate({
      updateSelectInput(session, "lig3_2", label = "Clusters", choices = as.character(choix_lig3_2$choices),
                        selected = as.character(choix_lig3_2$selected))

    })
  }
})

choix_lig4_2 <- reactive({
  imported_data <- imported_data()
  lig4 <- input$lig4
  isolate({
    if(!is.null(lig4) & length(imported_data) > 3) {
      nb_panels <- ifelse("list" %in% class(imported_data), length(imported_data), 1)
      if(nb_panels > 1) {
        panel_name = names(imported_data)[4]
        data_nb <- imported_data[[4]]
        if(panel_name %in% c("clusters", "clustersRes") & !is.null(input[[paste0("lig", 4)]])) {
          if("all" %in% lig4) {
            lig4 <- as.character(unique(data_nb$area))
          }
          data_2 <- data_nb[area %in% lig4]
          choix_lig4_2 <- c("all", as.character(unique(data_2$cluster)))

          current_sel <- isolate(input$lig4_2)
          selected <- intersect(current_sel, choix_lig4_2)
          if(length(selected) == 0){
            selected = "all"
          }
          choix_lig4_2 <- list(choices = choix_lig4_2, selected = selected)
        } else {
          choix_lig4_2 <- NULL
        }

      } else {
        choix_lig4_2 <- NULL
      }
      return(choix_lig4_2)
    }

  })
})

observe({
  choix_lig4_2 <- choix_lig4_2()
  if(!is.null(choix_lig4_2)) {
    isolate({
      updateSelectInput(session, "lig4_2", label = "Clusters", choices = as.character(choix_lig4_2$choices),
                        selected = as.character(choix_lig4_2$selected))

    })
  }
})

choix_lig5_2 <- reactive({
  imported_data <- imported_data()
  lig5 <- input$lig5
  isolate({
    if(!is.null(lig5) & length(imported_data) > 3) {
      nb_panels <- ifelse("list" %in% class(imported_data), length(imported_data), 1)
      if(nb_panels > 1) {
        panel_name = names(imported_data)[5]
        data_nb <- imported_data[[5]]
        if(panel_name %in% c("clusters", "clustersRes") & !is.null(input[[paste0("lig", 5)]])) {
          if("all" %in% lig5) {
            lig5 <- as.character(unique(data_nb$area))
          }
          data_2 <- data_nb[area %in% lig5]
          choix_lig5_2 <- c("all", as.character(unique(data_2$cluster)))
          
          current_sel <- isolate(input$lig5_2)
          selected <- intersect(current_sel, choix_lig5_2)
          if(length(selected) == 0){
            selected = "all"
          }
          choix_lig5_2 <- list(choices = choix_lig5_2, selected = selected)
        } else {
          choix_lig5_2 <- NULL
        }
        
      } else {
        choix_lig5_2 <- NULL
      }
      return(choix_lig5_2)
    }
    
  })
})

observe({
  choix_lig5_2 <- choix_lig5_2()
  if(!is.null(choix_lig5_2)) {
    isolate({
      updateSelectInput(session, "lig5_2", label = "Clusters", choices = as.character(choix_lig5_2$choices),
                        selected = as.character(choix_lig4_2$selected))
      
    })
  }
})
# donnees et tables -------------------------------------------------------

data_dt1 <- reactive({
  imported_data <- imported_data()
  if(!is.null((imported_data))) {
    nb_panels <- ifelse("list" %in% class(imported_data), length(imported_data), 1)
    if(nb_panels == 1) {
      panel_name <- paste0(attributes(imported_data)$names[1], "s")
      if(attributes(imported_data)$names[2] == "cluster") panel_name <- "clusters"

      data2 <- imported_data
    } else if(nb_panels > 1) {
      panel_name <- names(imported_data)[1]
      data2 <- imported_data[[1]]
    }

    data2 <- subsetDataTable(data = data2, panel_name = panel_name,
                             lig1 = input$lig1, lig2 = input$lig1_2, col1 = input$col1)

    data2

  } else {
    data.table("No data")
  }
})

output$dt1 <- renderDT({
  datatable(head(data_dt1(), 10), rownames = FALSE,
            options = list(dom = 't', scrollX = TRUE))
})

output$box_tab1_1 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("N. Rows", current_language$language), value = nrow(data_dt1()), icon = icon("bars"), color = "green", fill = FALSE)
})

output$box_tab1_2 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("N. Cols", current_language$language), value = ncol(data_dt1()), icon = icon("barcode"), color = "green", fill = FALSE)
})

output$box_tab1_3 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("Size", current_language$language), value = format(object.size(data_dt1()), units = "auto"), icon = icon("archive"), color = "green", fill = FALSE)
})

data_dt2 <- reactive({
  imported_data <- imported_data()
  if(!is.null((imported_data))) {
    nb_panels <- ifelse("list" %in% class(imported_data), length(imported_data), 1)

    panel_name <- names(imported_data)[2]
    data2 <- imported_data[[2]]

    data2 <- subsetDataTable(data = data2, panel_name = panel_name,
                             lig1 = input$lig2, lig2 = input$lig2_2, col1 = input$col2)

    data2

  } else {
    data.table("No data")
  }
})

output$dt2 <- renderDT({
  datatable(head(data_dt2(), 10), rownames = FALSE,
            options = list(dom = 't', scrollX = TRUE))
})

output$box_tab2_1 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("N. Rows", current_language$language), value = nrow(data_dt2()), icon = icon("bars"), color = "green", fill = FALSE)
})

output$box_tab2_2 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("N. Cols", current_language$language), value = ncol(data_dt2()), icon = icon("barcode"), color = "green", fill = FALSE)
})

output$box_tab2_3 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("Size", current_language$language), value = format(object.size(data_dt2()), units = "auto"), icon = icon("archive"), color = "green", fill = FALSE)
})

data_dt3 <- reactive({
  imported_data <- imported_data()
  if(!is.null((imported_data))) {
    nb_panels <- ifelse("list" %in% class(imported_data), length(imported_data), 1)

    panel_name <- names(imported_data)[3]
    data2 <- imported_data[[3]]

    data2 <- subsetDataTable(data = data2, panel_name = panel_name,
                             lig1 = input$lig3, lig2 = input$lig3_2, col1 = input$col3)

    data2

  } else {
    data.table("No data")
  }
})

output$dt3 <- renderDT({
  datatable(head(data_dt3(), 10), rownames = FALSE,
            options = list(dom = 't', scrollX = TRUE))
})

output$box_tab3_1 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("N. Rows", current_language$language), value = nrow(data_dt3()), icon = icon("bars"), color = "green", fill = FALSE)
})

output$box_tab3_2 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("N. Cols", current_language$language), value = ncol(data_dt3()), icon = icon("barcode"), color = "green", fill = FALSE)
})

output$box_tab3_3 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("Size", current_language$language), value = format(object.size(data_dt3()), units = "auto"), icon = icon("archive"), color = "green", fill = FALSE)
})

data_dt4 <- reactive({
  imported_data <- imported_data()
  if(!is.null((imported_data))) {
    nb_panels <- ifelse("list" %in% class(imported_data), length(imported_data), 1)

    panel_name <- names(imported_data)[4]
    data2 <- imported_data[[4]]

    data2 <- subsetDataTable(data = data2, panel_name = panel_name,
                             lig1 = input$lig4, lig2 = input$lig4_2, col1 = input$col4)

    data2

  } else {
    data.table("No data")
  }
})

output$dt4 <- renderDT({
  datatable(head(data_dt4(), 10), rownames = FALSE,
            options = list(dom = 't', scrollX = TRUE))
})

output$box_tab4_1 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("N. Rows", current_language$language), value = nrow(data_dt4()), icon = icon("bars"), color = "green", fill = FALSE)
})

output$box_tab4_2 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("N. Cols", current_language$language), value = ncol(data_dt4()), icon = icon("barcode"), color = "green", fill = FALSE)
})

output$box_tab4_3 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("Size", current_language$language), value = format(object.size(data_dt4()), units = "auto"), icon = icon("archive"), color = "green", fill = FALSE)
})


data_dt5 <- reactive({
  imported_data <- imported_data()
  if(!is.null((imported_data))) {
    nb_panels <- ifelse("list" %in% class(imported_data), length(imported_data), 1)
    
    panel_name <- names(imported_data)[5]
    data2 <- imported_data[[5]]
    
    data2 <- subsetDataTable(data = data2, panel_name = panel_name,
                             lig1 = input$lig5, lig2 = input$lig5_2, col1 = input$col5)
    
    data2
    
  } else {
    data.table("No data")
  }
})

output$dt5 <- renderDT({
  datatable(head(data_dt5(), 10), rownames = FALSE,
            options = list(dom = 't', scrollX = TRUE))
})

output$box_tab5_1 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("N. Rows", current_language$language), value = nrow(data_dt5()), icon = icon("bars"), color = "green", fill = FALSE)
})

output$box_tab5_2 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("N. Cols", current_language$language), value = ncol(data_dt5()), icon = icon("barcode"), color = "green", fill = FALSE)
})

output$box_tab5_3 <- renderInfoBox({
  infoBox(title = antaresVizMedTSO:::.getLabelLanguage("Size", current_language$language), value = format(object.size(data_dt4()), units = "auto"), icon = icon("archive"), color = "green", fill = FALSE)
})

# Import des donnees ------------------------------------------------------
output$import_data <- downloadHandler(
  filename = function() {
    paste0("Antares_IO_", format(Sys.time(), "%d%m%Y_%H%M%S"), ".xlsx")
  },
  content = function(file) {
    data_res <- imported_data()
    if(!is.null(data_res)){
      session$sendCustomMessage(type = 'show_spinner',
                                message = list(id = "#export_busy"))

      withCallingHandlers({
        tryCatch({openxlsx::write.xlsx(data_res, file, rowNames = FALSE)},
                 error = function(e){
                   showModal(modalDialog(
                     title = "Error writing data",
                     easyClose = TRUE,
                     footer = NULL,
                     paste("You can try to reduce size... Error : ", e$message, sep = "\n")
                   ))
                   openxlsx::write.xlsx(NULL, file, rowNames = FALSE)
                 })},
        warning = function(w){
          showModal(modalDialog(
            title = "Warning writing data",
            easyClose = TRUE,
            footer = NULL,
            w$message
          ))
        }
      )

      if(is_electron){
        showModal(modalDialog(
          antaresVizMedTSO:::.getLabelLanguage("File automatically downloaded in default folder", current_language),
          easyClose = TRUE,
          footer = NULL
        ))
      }
      session$sendCustomMessage(type = 'hide_spinner',
                                message = list(id = "#export_busy"))
    }
  }
)

output$import_data_sel <- downloadHandler(
  filename = function() {
    paste0("Antares_IO_", format(Sys.time(), "%d%m%Y_%H%M%S"), ".xlsx")
  },
  content = function(file) {
    data_res <- imported_data()
    data_import <- NULL
    if("list" %in% class(data_res)) {
      data_import <- lapply(1:length(data_res), FUN = function(i) {
        eval(parse(text = paste0("data_dt", i, "()")))
      })

    } else if("data.frame" %in% class(data_res) | "data.table" %in% class(data_res)){
      data_import <- data_dt1()
    }

    if(!is.null(data_import)){
      session$sendCustomMessage(type = 'show_spinner',
                                message = list(id = "#export_busy"))

      withCallingHandlers({
        tryCatch({openxlsx::write.xlsx(data_import, file, rowNames = FALSE)},
                 error = function(e){
                   showModal(modalDialog(
                     title = "Error writing data",
                     easyClose = TRUE,
                     footer = NULL,
                     paste("You can try to reduce size... Error : ", e$message, sep = "\n")
                   ))
                   openxlsx::write.xlsx(NULL, file, rowNames = FALSE)
                 })},
        warning = function(w){
          showModal(modalDialog(
            title = "Warning writing data",
            easyClose = TRUE,
            footer = NULL,
            w$message
          ))
        }
      )

      if(is_electron){
        showModal(modalDialog(
          antaresVizMedTSO:::.getLabelLanguage("File automatically downloaded in default folder", current_language),
          easyClose = TRUE,
          footer = NULL
        ))
      }
      
      session$sendCustomMessage(type = 'hide_spinner',
                                message = list(id = "#export_busy"))
    }
  }
)

output$import_tab1 <- downloadHandler(
  filename = function() {
    paste0("Antares_IO_", format(Sys.time(), "%d%m%Y_%H%M%S"), ".xlsx")
  },
  content = function(file) {
    data_res <- data_dt1()
    if(!is.null(data_res)){
      session$sendCustomMessage(type = 'show_spinner',
                                message = list(id = "#export_busy_1"))

      withCallingHandlers({
        tryCatch({openxlsx::write.xlsx(data_res, file, rowNames = FALSE)},
                 error = function(e){
                   showModal(modalDialog(
                     title = "Error writing data",
                     easyClose = TRUE,
                     footer = NULL,
                     paste("You can try to reduce size... Error : ", e$message, sep = "\n")
                   ))
                   openxlsx::write.xlsx(NULL, file, rowNames = FALSE)
                 })},
        warning = function(w){
          showModal(modalDialog(
            title = "Warning writing data",
            easyClose = TRUE,
            footer = NULL,
            w$message
          ))
        }
      )

      if(is_electron){
        showModal(modalDialog(
          antaresVizMedTSO:::.getLabelLanguage("File automatically downloaded in default folder", current_language),
          easyClose = TRUE,
          footer = NULL
        ))
      }
      
      session$sendCustomMessage(type = 'hide_spinner',
                                message = list(id = "#export_busy_1"))
    }
  }
)

output$import_tab2 <- downloadHandler(
  filename = function() {
    paste0("Antares_IO_", format(Sys.time(), "%d%m%Y_%H%M%S"), ".xlsx")
  },
  content = function(file) {
    data_res <- data_dt2()
    if(!is.null(data_res)){
      session$sendCustomMessage(type = 'show_spinner',
                                message = list(id = "#export_busy_2"))

      withCallingHandlers({
        tryCatch({openxlsx::write.xlsx(data_res, file, rowNames = FALSE)},
                 error = function(e){
                   showModal(modalDialog(
                     title = "Error writing data",
                     easyClose = TRUE,
                     footer = NULL,
                     paste("You can try to reduce size... Error : ", e$message, sep = "\n")
                   ))
                   openxlsx::write.xlsx(NULL, file, rowNames = FALSE)
                 })},
        warning = function(w){
          showModal(modalDialog(
            title = "Warning writing data",
            easyClose = TRUE,
            footer = NULL,
            w$message
          ))
        }
      )

      if(is_electron){
        showModal(modalDialog(
          antaresVizMedTSO:::.getLabelLanguage("File automatically downloaded in default folder", current_language),
          easyClose = TRUE,
          footer = NULL
        ))
      }
      
      session$sendCustomMessage(type = 'hide_spinner',
                                message = list(id = "#export_busy_2"))
    }
  }
)

output$import_tab3 <- downloadHandler(
  filename = function() {
    paste0("Antares_IO_", format(Sys.time(), "%d%m%Y_%H%M%S"), ".xlsx")
  },
  content = function(file) {
    data_res <- data_dt3()
    if(!is.null(data_res)){
      session$sendCustomMessage(type = 'show_spinner',
                                message = list(id = "#export_busy_3"))

      withCallingHandlers({
        tryCatch({openxlsx::write.xlsx(data_res, file, rowNames = FALSE)},
                 error = function(e){
                   showModal(modalDialog(
                     title = "Error writing data",
                     easyClose = TRUE,
                     footer = NULL,
                     paste("You can try to reduce size... Error : ", e$message, sep = "\n")
                   ))
                   openxlsx::write.xlsx(NULL, file, rowNames = FALSE)
                 })},
        warning = function(w){
          showModal(modalDialog(
            title = "Warning writing data",
            easyClose = TRUE,
            footer = NULL,
            w$message
          ))
        }
      )

      if(is_electron){
        showModal(modalDialog(
          antaresVizMedTSO:::.getLabelLanguage("File automatically downloaded in default folder", current_language),
          easyClose = TRUE,
          footer = NULL
        ))
      }
      
      session$sendCustomMessage(type = 'hide_spinner',
                                message = list(id = "#export_busy_3"))
    }
  }
)

output$import_tab4 <- downloadHandler(
  filename = function() {
    paste0("Antares_IO_", format(Sys.time(), "%d%m%Y_%H%M%S"), ".xlsx")
  },
  content = function(file) {
    data_res <- data_dt4()
    if(!is.null(data_res)){
      session$sendCustomMessage(type = 'show_spinner',
                                message = list(id = "#export_busy_4"))

      withCallingHandlers({
        tryCatch({openxlsx::write.xlsx(data_res, file, rowNames = FALSE)},
                 error = function(e){
                   showModal(modalDialog(
                     title = "Error writing data",
                     easyClose = TRUE,
                     footer = NULL,
                     paste("You can try to reduce size... Error : ", e$message, sep = "\n")
                   ))
                   openxlsx::write.xlsx(NULL, file, rowNames = FALSE)
                 })},
        warning = function(w){
          showModal(modalDialog(
            title = "Warning writing data",
            easyClose = TRUE,
            footer = NULL,
            w$message
          ))
        }
      )

      if(is_electron){
        showModal(modalDialog(
          antaresVizMedTSO:::.getLabelLanguage("File automatically downloaded in default folder", current_language),
          easyClose = TRUE,
          footer = NULL
        ))
      }
      
      session$sendCustomMessage(type = 'hide_spinner',
                                message = list(id = "#export_busy_4"))
    }
  }
)

output$import_tab5 <- downloadHandler(
  filename = function() {
    paste0("Antares_IO_", format(Sys.time(), "%d%m%Y_%H%M%S"), ".xlsx")
  },
  content = function(file) {
    data_res <- data_dt5()
    if(!is.null(data_res)){
      session$sendCustomMessage(type = 'show_spinner',
                                message = list(id = "#export_busy_5"))
      
      withCallingHandlers({
        tryCatch({openxlsx::write.xlsx(data_res, file, rowNames = FALSE)},
                 error = function(e){
                   showModal(modalDialog(
                     title = "Error writing data",
                     easyClose = TRUE,
                     footer = NULL,
                     paste("You can try to reduce size... Error : ", e$message, sep = "\n")
                   ))
                   openxlsx::write.xlsx(NULL, file, rowNames = FALSE)
                 })},
        warning = function(w){
          showModal(modalDialog(
            title = "Warning writing data",
            easyClose = TRUE,
            footer = NULL,
            w$message
          ))
        }
      )
      
      if(is_electron){
        showModal(modalDialog(
          antaresVizMedTSO:::.getLabelLanguage("File automatically downloaded in default folder", current_language),
          easyClose = TRUE,
          footer = NULL
        ))
      }
      
      session$sendCustomMessage(type = 'hide_spinner',
                                message = list(id = "#export_busy_5"))
    }
  }
)
output$export_btn <- renderUI({
  current_language <- current_language$language
  isolate({
    fluidRow(column(6,div(downloadButton("import_data", antaresVizMedTSO:::.getLabelLanguage("Export all tables (without filters)", current_language), icon = icon("upload")),
                          align = "right")),
             column(3,div(downloadButton("import_data_sel", antaresVizMedTSO:::.getLabelLanguage("Export all tables (with filters)", current_language), icon = icon("upload")),
                          align = "left")),
             column(3,
                    tags$div(style="padding-top:0px; display: none", id = "export_busy",
                             tags$img(src = "spinner.gif", height = 40, width = 40),align = 'left')
             )
    )
  })
})
rte-antares-rpackage/antaresVizMedTSO documentation built on April 27, 2022, 1:28 a.m.