inst/AppACM/myapp/server.R

#\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
# Packages -----
#\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

require(shiny)
require(FactoMineR)
require(explor)
require(scatterD3)
require(DT)
require(cluster)
require(JLutils)
require(RColorBrewer)
require(questionr)
require(tidyverse)
# require(tidyr)
# require(dplyr)
require(stringr)
# require(stringi)
# require(GDAtools)

options(shiny.maxRequestSize=30*1024^2)

#\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
# Fonctions pour les graphiques -----------
#\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

# ACM Spéciales :
# A FAIRE ?


# MCA Var plot sans fixe = T
MCA_var_data <- function(res, xax = 1, yax = 2, var_sup = TRUE, var_lab_min_contrib = 0) {
  tmp_x <- res$vars %>%
    arrange(Axis, Type, Variable) %>%
    filter(Axis == xax) %>%
    select_("Variable", "Level", "Type", "Class", "Coord", "Contrib", "Cos2", "Count")
  tmp_y <- res$vars %>% 
    filter(Axis == yax) %>%
    select_("Variable", "Level", "Type", "Class", "Coord", "Contrib", "Cos2", "Count")
  if (!(var_sup)) {
    tmp_x <- tmp_x %>% filter(Type == 'Active')
    tmp_y <- tmp_y %>% filter(Type == 'Active')
  }
  tmp <- tmp_x %>%
    left_join(tmp_y, by = c("Variable", "Level", "Type", "Class", "Count")) %>%
    mutate(Contrib = Contrib.x + Contrib.y,
           Cos2 = Cos2.x + Cos2.y,
           tooltip = paste(paste0("<strong>", Level, "</strong><br />"),
                           paste0("<strong>",
                                  gettext("Variable", domain = "R-explor"),
                                  ":</strong> ", Variable, "<br />"),
                           paste0("<strong>Axis ",xax," :</strong> ", Coord.x, "<br />"),
                           paste0("<strong>Axis ", yax," :</strong> ", Coord.y, "<br />"),
                           ifelse(is.na(Cos2), "",
                                  paste0("<strong>",
                                         gettext("Squared cosinus", domain = "R-explor"),
                                         ":</strong> ", Cos2, "<br />")),
                           ifelse(is.na(Contrib), "",
                                  paste0("<strong>",
                                         gettext("Contribution:", domain = "R-explor"),
                                         "</strong> ", Contrib, "<br />")),
                           ifelse(is.na(Count), "",
                                  paste0("<strong>",
                                         gettext("Count:", domain = "R-explor"),
                                         "</strong> ", Count))),
           Lab = ifelse(Contrib >= as.numeric(var_lab_min_contrib) | 
                          is.na(Contrib) & as.numeric(var_lab_min_contrib) == 0, Level, ""))
  data.frame(tmp)
}


MCA_var_plot2 <- function(res, xax = 1, yax = 2, var_sup = TRUE, var_lab_min_contrib = 0,
                         point_size = 64,
                         col_var = NULL,
                         symbol_var = NULL,
                         size_var = NULL,
                         size_range = c(10,300),
                         zoom_callback = NULL,
                         in_explor = FALSE, ...) {
  
  ## Settings changed if not run in explor
  html_id <- if(in_explor) "explor_var" else  NULL
  dom_id_svg_export <- if(in_explor) "explor-var-svg-export" else NULL
  dom_id_lasso_toggle <- if(in_explor) "explor-var-lasso-toggle" else NULL
  lasso <- if(in_explor) TRUE else FALSE 
  lasso_callback <- if(in_explor) explor_multi_lasso_callback() else NULL
  zoom_callback <- if(in_explor) explor_multi_zoom_callback(type = "var") else NULL
  
  var_data <- MCA_var_data(res, xax, yax, var_sup, var_lab_min_contrib)
  
  scatterD3::scatterD3(
    x = var_data[, "Coord.x"],
    y = var_data[, "Coord.y"],
    xlab = names(res$axes)[res$axes == xax],
    ylab = names(res$axes)[res$axes == yax],
    lab = var_data[, "Lab"],
    point_size = point_size,
    point_opacity = 1,
    col_var = if (is.null(col_var)) NULL else var_data[,col_var],
    col_lab = col_var,
    symbol_var = if (is.null(symbol_var)) NULL else var_data[,symbol_var],
    symbol_lab = symbol_var,
    size_var = if (is.null(size_var)) NULL else var_data[,size_var],
    size_lab = size_var,
    size_range = if (is.null(size_var)) c(10,300) else c(30,400) * point_size / 32,
    tooltip_text = var_data[, "tooltip"],
    type_var = ifelse(var_data[,"Class"] == "Quantitative", "arrow", "point"),
    unit_circle = var_sup && "Quantitative" %in% var_data[,"Class"],
    key_var = paste(var_data[, "Variable"], var_data[, "Level"], sep = "-"),
    fixed = FALSE,
    html_id = html_id,
    dom_id_svg_export = dom_id_svg_export,
    dom_id_lasso_toggle = dom_id_lasso_toggle,
    lasso = lasso,
    lasso_callback = lasso_callback,
    zoom_callback = zoom_callback,
    ...
  )  
}
# Adaptation des graphiques des individus d'explor (Julien Barnier) :
MCA_ind_data <- function(res, xax = 1, yax = 2, ind_sup, col_var = NULL, 
                         ind_lab_min_contrib = 0,opacity_var = NULL) {
  tmp_x <- res$ind %>% 
    filter(Axis == xax) %>%
    select(Name, Type, Coord, Contrib, Cos2)
  if (!ind_sup)
    tmp_x <- tmp_x %>% filter(Type == "Active")
  tmp_y <- res$ind %>% 
    filter(Axis == yax) %>%
    select(Name, Type, Coord, Contrib, Cos2)
  if (!ind_sup)
    tmp_y <- tmp_y %>% filter(Type == "Active")
  tmp <- tmp_x %>%
    left_join(tmp_y, by = c("Name", "Type")) %>%
    mutate(Contrib = Contrib.x + Contrib.y,
           Cos2 = Cos2.x + Cos2.y,
           tooltip = paste(paste0("<strong>", Name, "</strong><br />"),
                           paste0("<strong>Axis ", xax," :</strong> ", Coord.x, "<br />"),
                           paste0("<strong>Axis ", yax," :</strong> ", Coord.y, "<br />"),
                           ifelse(is.na(Cos2), "",
                                  paste0("<strong>",
                                         gettext("Squared cosinus", domain = "R-explor"),
                                         ":</strong> ", Cos2, "<br />")),
                           ifelse(is.na(Contrib), "",
                                  paste0("<strong>",
                                         gettext("Contribution:", domain = "R-explor"),
                                         "</strong> ", Contrib, "<br />"))),
           Lab = ifelse(Contrib >= as.numeric(ind_lab_min_contrib) | 
                          (is.na(Contrib) & as.numeric(ind_lab_min_contrib) == 0), Name, ""))
  if (!(is.null(col_var) || col_var %in% c("None", "Type"))) {
    tmp_data <- res$quali_data %>% select_("Name", col_var)
    tmp <- tmp %>%
      left_join(tmp_data, by = "Name")
  }
  data.frame(tmp)
}

MCA_ind_plot <- function(res, xax = 1, yax = 2, ind_sup = TRUE,
                         col_var = NULL,
                         symbol_var = NULL,
                         opacity_var = NULL,
                         size_var = NULL,
                         size_range = c(10,300),
                         lab_var = NULL,
                         zoom_callback = NULL,
                         in_explor = FALSE,
                         ind_lab_min_contrib = 0,
                         ...) {
  
  html_id <- if(in_explor) "explor_ind" else  NULL
  dom_id_svg_export <- if(in_explor) "explor-ind-svg-export" else NULL
  dom_id_lasso_toggle <- if(in_explor) "explor-ind-lasso-toggle" else NULL
  lasso <- if(in_explor) TRUE else FALSE 
  lasso_callback <- if(in_explor) explor_multi_lasso_callback() else NULL
  zoom_callback <- if(in_explor) explor_multi_zoom_callback(type = "ind") else NULL
  
  ind_data <- MCA_ind_data(res, xax, yax, ind_sup, col_var,ind_lab_min_contrib)
  
  scatterD3::scatterD3(
    x = ind_data[, "Coord.x"],
    y = ind_data[, "Coord.y"],
    xlab = names(res$axes)[res$axes == xax],
    ylab = names(res$axes)[res$axes == yax],
    lab=ind_data[,"Lab"],
    col_var = if (is.null(col_var)) NULL else ind_data[,col_var],
    col_lab = col_var,
    opacity_var = if (is.null(opacity_var)) NULL else ind_data[,opacity_var],
    tooltip_text = ind_data[, "tooltip"],
    key_var = ind_data[, "Name"],
    fixed = TRUE,
    html_id = html_id,
    dom_id_svg_export = dom_id_svg_export,
    dom_id_lasso_toggle = dom_id_lasso_toggle,
    lasso = lasso,
    lasso_callback = lasso_callback,
    zoom_callback = zoom_callback,
    ...)
  
}

#\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
# Fichier server ------------
#\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

shinyServer(function(input, output, session) { 
  
  # A/ Mise en forme et modifications de la table brute importée --------------
  #\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
  # Données importées (adaptation d'explore-data, Paris Descartes) :
  output$donnees.fichier.ui <- renderUI({
    list(
      fileInput("donnees.fichier.input", "Choisir le fichier :"),
      radioButtons("donnees.fichier.header", 
                   "Noms de variables en 1ère ligne :",
                   c("oui", "non")),
      radioButtons("donnees.fichier.sep", 
                   "Séparateur de champs :", 
                   c("point-virgule" = ";", 
                     "virgule" = ",", 
                     "espace" = " ", 
                     "tabulation" = "\t")),
      radioButtons("donnees.fichier.dec", 
                   "Séparateur de décimales :",
                   c("point" = ".", "virgule" = ",")),
      radioButtons("donnees.fichier.enc",
                   "Encodage des caractères :",
                   c("UTF-8 (par défaut sur Linux/Mac)" = "UTF-8",
                     "Windows-1252 (par défaut sur Windows)" = "WINDOWS-1252")),
      uiOutput("donnees.fichier.ok")
    )
    
  })
  file_name <- reactive({
    inFile <- input$donnees.fichier.input
    if (is.null(inFile))
      return("NULL")
    return (stringi::stri_extract_first(str = inFile$name, regex = ".*(?=\\.)"))
  })
  donnees_entree <-reactive({
    if (is.null(input$donnees.fichier.input)) return (NULL)
    don <- NULL
    try({
      don <- read.table(
        input$donnees.fichier.input$datapath, 
        header = input$donnees.fichier.header == "oui", 
        sep = input$donnees.fichier.sep,
        dec = input$donnees.fichier.dec, 
        fileEncoding = input$donnees.fichier.enc,
        stringsAsFactors = FALSE)
    }, silent = TRUE)
    don <- unique(don)
    for (i in 1:ncol(don)){
      if (class(don[,i])!="numeric" &&class(don[,i])!="integer" )
   { don[,i][is.na(don[,i])]<-""}}
    
    don
  })
  
  
  donnees_entree2 <- reactive ({
    LabelGraphInd <- input$LabelGraphInd
    don <- donnees_entree()
    if (is.null(LabelGraphInd)) don 
    row.names(don)<- don[,LabelGraphInd]
    
    don
  })
  
  # setwd("C:/Users/Cecile Rodriguez/Documents/Recherche/TMI2")
  #  donnees_entree <- read.csv2("EtatCivil/BiosFinal.csv") 
  #  donnees_entree$X <- NULL
  #  donnees_entree <- unique (donnees_entree)
  #  names(donnees_entree)[5]<-"Prenom"
  #  row.names (donnees_entree)<- paste0(donnees_entree$Noms, ".",donnees_entree$Prénom)
  # donnees_entree
  
  # taille et str du tableau de départ :  
  
  output$Dimensions <- renderText(
    if (is.null(input$donnees.fichier.input)) return ("")
    else {
      paste("Tableau constitué de", ncol(donnees_entree()),
            "colonnes et de", nrow(donnees_entree()),"lignes.
            Détail des variables :")
      
    })
  
  output$Resume <- renderTable({
    
    if (is.null(input$donnees.fichier.input)) return (NULL)
    tmp<-donnees_entree()
    donnees_entree<- data.frame( Variable = names(tmp[1]),
                                 Type = class(tmp[,1]),
                                 NbreValeursDiff = nrow(unique(tmp[1])))
    for (i in (2:ncol(tmp))) {
      donnees_entree<-rbind(donnees_entree, data.frame( Variable = names(tmp[i]),
                                                        Type = class(tmp[,i]),
                                                        NbreValeursDiff = nrow(unique(tmp[i]))))
    }
    donnees_entree
  })
  
  
  # Listes déroulantes dynamiques :
  
  ## Modalités du 1er critère :
  Choose_Field <- reactive({
    Var1 <- input$Variable1
    donnees_entree <- donnees_entree()
    if (is.null(input$Variable1)) return (NULL)
    Choose_Field <- as.list(c("",unique(as.character(donnees_entree[,Var1]))))
  })
  
  ## Modalités du 2ème critère :
  Choose_Field2 <- reactive({
    if (is.null(input$Variable2)) return (NULL)
    donnees_entree <- donnees_entree()
    Var2 <- input$Variable2
    Choose_Field <- as.list(c("",unique(as.character(donnees_entree[,Var2]))))
  })
  
  ## Modalités du 3ème critère :
  Choose_Field3 <- reactive({
    donnees_entree <- donnees_entree()
    Var3 <- input$Variable3
    if (is.null(input$Variable3)) return (NULL)
    Choose_Field <- as.list(c("",unique(as.character(donnees_entree[,Var3]))))
  })
  
  ## Modalités du 4ème critère :
  Choose_Field4 <- reactive({
    donnees_entree <- donnees_entree()
    Var4 <- input$Variable4
    if (is.null(input$Variable4)) return (NULL)
    Choose_Field <- as.list(c("",unique(as.character(donnees_entree[,Var4]))))
  })
  
  ## Variables conservées dans l'ACM (pour var illustratives) :
  Choose_Illus <- reactive ({
    Vars <- input$VarPourACM
    donnees_entree <- test()
    validate(need(length(input$VarPourACM)>1, " "))
    if (is.null(input$VarPourACM)) return (NULL)
    Choose_Illus <- data.frame(donnees_entree[,Vars])
  })
  
  ## ACM spéciale : Index pour choix des modalités à exclure :
  Choose_Spe <- reactive ({
    TableACM <- TableACM()
    
    if (is.null(TableACM)) return (NULL)
    Choose_Spe <- GDAtools::getindexcat(TableACM)
  })
  
  output$Choose_ModaSpe <- renderUI({
    
    ACMSpe <- input$ACMSpe
    
  #  if (ACMSpe == TRUE ) {
  #  selectizeInput("ModaSpe", "Choix des modalités à exclure :",
 #               choices=c(" ",Choose_Spe()) , selected = NULL, multiple = TRUE)  
  #  }
  
  })
  
  ListeModaSpe <- reactive({
    ModaSpe <- input$ModaSpe
    Choose_Spe <- Choose_Spe()
    c<-which(as.list(Choose_Spe)== ModaSpe[1])
    if (length(ModaSpe)<2){
      c<-which(as.list(Choose_Spe)== ModaSpe[1])
    }else{
      c<-which(as.list(Choose_Spe)== ModaSpe[1])
      #if (length(VarsIllus>1))
      for (i in 2:length(ModaSpe)) {
        c <- c(c, which(as.list(Choose_Spe)== ModaSpe[i]))
      }
    }
    c
    
  })
  
  
  # Elements de sélection / choix / input -----
  #\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
  # Sélection des individus :
  
  ## Choix de l'identifiant (pour jointures des différents tableaux "critères"):
  output$SelectID <- renderUI({
    selectInput("ID", "Choix de l'identifiant (doit être unique) :",
                choices=c(" ",names(donnees_entree())) , selected = NULL)  
  }) 
  
  ## Message d'erreur identifiant :
  
  
  output$ErreurID <- renderUI({
    
    ID <- input$ID
    Donnees <- donnees_entree()
    
      validate(
       need(is.null(Donnees)==F , "Charger une table")
       )
      
    if (ID == " ") {return ("Sélectionner une variable")} else{
    if (length(unique(Donnees[,ID]))==nrow(Donnees)){"Identifiant OK"}else{
      p("Identifiant pas OK : en choisir un autre ou \n télécharger la table avec un ID :", style = "color:red")
  }
    }
    })
  
  # Choix de la variable donnant les noms des étiquettes "individus" :
  
  output$SelectLabelGraphInd <- renderUI({
    selectInput("LabelGraphInd", "Noms des individus (Même variable que l'identifiant, par défaut) :",
                choices=c(" ",names(donnees_entree())) , selected = input$ID)  
  }) 
  
  
  ## Message d'erreur étiquette graphe individu :
  
  
  output$ErreurLabelGraphInd <- renderUI({
    
    LabelGraphInd <- input$LabelGraphInd
    Donnees <- donnees_entree()
    
    validate(
      need(is.null(Donnees)==F , "Charger une table")
    )
    
    if (LabelGraphInd == " ") {return ("Sélectionner une variable")}else{
      if (length(unique(Donnees[,LabelGraphInd]))==nrow(Donnees)){"Label OK"}else{
        p("Label pas OK : en choisir un autre ou laisser l'identifant pas défaut", style = "color:red")
        }
    }
  })
  
  
  
  # Sélection des variables :
  
  ## Choix des variables pour l'ACM :    
  output$SelectACM <- renderUI({
    if (input$SelectAll == TRUE){
      selectizeInput("VarPourACM", "Variables pour l'ACM :", 
                     choices = names(donnees_entree()), 
                     selected = names(donnees_entree()), multiple = TRUE,
                     options = NULL)
    }
    else if (input$SelectAll == FALSE) {
      selectizeInput("VarPourACM", "Variables pour l'ACM :", 
                     choices = names(donnees_entree()), 
                     selected = NULL, multiple = TRUE,
                     options = NULL)
    }
  })
  
  ## Choix des variables illustratives de l'ACM :
  output$SelectIllus <- renderUI({
    
    ## Validations / erreurs
    validate(
      need(nrow(donnees_entree())!=0, "Charger une table (onglet 1)")
    )
    
    
    validate(
      need(input$ID!= " ", "Sélectionner un identifiant (onglet 1)")
    )
    
    
    
    ## Contenu
    
    selectizeInput("VarIllusPourACM", "Variables illustratives quali (parmi celles conservées pour l'ACM) :", 
                   choices = names(Choose_Illus()), 
                   selected = NULL, multiple = TRUE,
                   options = NULL)
  })
  
  
  output$SelectIllusQuanti <- renderUI({
    ## Validations / erreurs
    validate(
      need(nrow(donnees_entree())!=0, "Charger une table (onglet 1)")
    )
    
    
    validate(
      need(input$ID!= " ", "Sélectionner un identifiant (onglet 1)")
    )
    
    
    ## Contenu
    selectizeInput("VarIllusQuantiPourACM", "Variables illustratives quanti (parmi celles conservées pour l'ACM) :", 
                   choices = names(Choose_Illus()), 
                   selected = NULL, multiple = TRUE,
                   options = NULL)
  })
  
  
  ## Choix des variables illustratives QUANTI de l'ACM :
  

  
  # Sélection des variables, opérateurs et modalités de chaque critère :
  
  output$SelectVar1 <- renderUI ({
    selectInput("Variable1", "Variable :",
                choices=as.list(c(" ",names(donnees_entree()))),selected=" ")
  })

    output$Select <- renderUI({
    
    Variable1 <- input$Variable1
    Donnees <- donnees_entree()
    validate(
      need(input$Variable1 !=" "  , "Choisir une variable")
    )
    
    if (class(Donnees[,Variable1])=="character" |
        class(Donnees[,Variable1])=="logical"){
      selectInput("Modalite1", "Modalité :",
                  choices=Choose_Field() , selected = NULL)  
    }
    else if (class(Donnees[,Variable1])=="integer" |
             class(Donnees[,Variable1])=="numeric"){
      sliderInput("Modalite1", "Modalité :",
                  min=min(Donnees[,Variable1], na.rm=T),
                  max=max(Donnees[,Variable1], na.rm=T), round=1, step=.5, value=0)
    }
  })
  
  output$SelectVar2 <- renderUI ({
    
    selectInput("Variable2", "Variable :",
                choices=as.list(c(" ",names(donnees_entree()))),selected=" ")
  })
  
  output$Select2 <- renderUI({
    Variable2 <- input$Variable2
    Donnees <- donnees_entree()
    
    
    validate(
      need(input$Variable2 !=" "  , "Choisir une variable")
    )
    if (class(Donnees[,Variable2])=="character" |
        class(Donnees[,Variable2])=="logical"){
      selectInput("Modalite2", "Modalité :",
                  choices=Choose_Field2() , selected = NULL)  
    }
    else if (class(Donnees[,Variable2])=="integer" |
             class(Donnees[,Variable2])=="numeric"){
      sliderInput("Modalite2", "Modalité :",
                  min=min(Donnees[,Variable2], na.rm=T),
                  max=max(Donnees[,Variable2], na.rm=T), round=1, step=.5, value=0)
    }
  })
  
  output$SelectVar3 <- renderUI ({
    selectInput("Variable3", "Variable :",
                choices=as.list(c(" ",names(donnees_entree()))),selected=" ")
  })
  
  output$Select3 <- renderUI({
    
    validate(
      need(input$Variable3 !=" "  , "Choisir une variable")
    )
    Variable3 <- input$Variable3
    Donnees <- donnees_entree()
    if(is.null(input$Variable3)) return(NULL)
    if (class(Donnees[,Variable3])=="character" |
        class(Donnees[,Variable3])=="logical"){
      selectInput("Modalite3", "Modalité :",
                  choices=Choose_Field3() , selected = NULL)  
    }
    else if (class(Donnees[,Variable3])=="integer" |
             class(Donnees[,Variable3])=="numeric"){
      sliderInput("Modalite3", "Modalité :",
                  min=min(Donnees[,Variable3], na.rm=T),
                  max=max(Donnees[,Variable3], na.rm=T), round=1, step=.5, value=0)
    }
  })
  
  output$SelectVar4<- renderUI ({
    selectInput("Variable4", "Variable :",
                choices=as.list(c(" ",names(donnees_entree()))),selected=" ")
  })
  
  output$Select4 <- renderUI({
    
    Variable4 <- input$Variable4
    Donnees <- donnees_entree()
    
    validate(
      need(input$Variable4 !=" "  , "Choisir une variable")
    )
    
    
    if (class(Donnees[,Variable4])=="character" |
        class(Donnees[,Variable4])=="logical"){
      selectInput("Modalite4", "Modalité :",
                  choices=Choose_Field4() , selected = NULL)  
    }
    else if (class(Donnees[,Variable4])=="integer" |
             class(Donnees[,Variable4])=="numeric"){
      sliderInput("Modalite4", "Modalité :",
                  min=min(Donnees[,Variable4], na.rm=T),
                  max=max(Donnees[,Variable4], na.rm=T), round=1, step=.5, value=0)
    }
  })
  output$SelectNbreAxes <- renderUI({
    
    ACM <- ACM()
    Max <- nrow(ACM$eig)
    
    sliderInput("NbreAxes", "Nombre d'axes à afficher :", min=1, max = Max, value=ifelse(Max < 11, Max, 10), step=1)
  })
  
  # B/ Création de la table selon les sous-ensembles définis ----------------
  #\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
  
  Critere1 <- reactive({
    Var1 <- input$Variable1
    Moda1 <- input$Modalite1
    BiosFinal <- donnees_entree2()
    BiosFinal<-  switch(input$Operateur1,
                        " " = BiosFinal,
                        "=" =  BiosFinal[BiosFinal[,Var1] == Moda1,], 
                        "diff. de" =  BiosFinal[BiosFinal[,Var1] != Moda1,],
                        ">" = BiosFinal[BiosFinal[,Var1] > Moda1,],
                        ">=" = BiosFinal[BiosFinal[,Var1] >= Moda1,],
                        "<" = BiosFinal[BiosFinal[,Var1] < Moda1,],
                        "<=" = BiosFinal[BiosFinal[,Var1] <= Moda1,])
    BiosFinal <- BiosFinal[!(str_detect(row.names(BiosFinal),"NA")),] 
  })
  
  Critere2 <- reactive({
    Var2 <- input$Variable2
    Moda2 <- input$Modalite2
    BiosFinal <- donnees_entree2()
    BiosFinal <- switch(input$Operateur2,
                        " " = BiosFinal,
                        "=" =  BiosFinal[BiosFinal[,Var2] == Moda2,], 
                        "diff. de" =  BiosFinal[BiosFinal[,Var2] != Moda2,],
                        ">" = BiosFinal[BiosFinal[,Var2] > Moda2,],
                        ">=" = BiosFinal[BiosFinal[,Var2] >= Moda2,],
                        "<" = BiosFinal[BiosFinal[,Var2] < Moda2,],
                        "<=" = BiosFinal[BiosFinal[,Var2] <= Moda2,])
    BiosFinal <- BiosFinal[!(str_detect(row.names(BiosFinal),"NA")),] 
  })
  
  Critere3 <- reactive({
    Var3 <- input$Variable3
    Moda3 <- input$Modalite3
    BiosFinal <- donnees_entree2()
    BiosFinal<- switch(input$Operateur3,
                       " " = BiosFinal,
                       "=" =  BiosFinal[BiosFinal[,Var3] == Moda3,], 
                       "diff. de" =  BiosFinal[BiosFinal[,Var3] != Moda3,],
                       ">" = BiosFinal[BiosFinal[,Var3] > Moda3,],
                       ">=" = BiosFinal[BiosFinal[,Var3] >= Moda3,],
                       "<" = BiosFinal[BiosFinal[,Var3] < Moda3,],
                       "<=" = BiosFinal[BiosFinal[,Var3] <= Moda3,])
    BiosFinal <- BiosFinal[!(str_detect(row.names(BiosFinal),"NA")),] 
  })
  
  Critere4 <- reactive({
    Var4 <- input$Variable4
    Moda4 <- input$Modalite4
    BiosFinal <- donnees_entree2()
    BiosFinal<- switch(input$Operateur4,
                       " " = BiosFinal,
                       "=" =  BiosFinal[BiosFinal[,Var4] == Moda4,], 
                       "diff. de" =  BiosFinal[BiosFinal[,Var4] != Moda4,],
                       ">" = BiosFinal[BiosFinal[,Var4] > Moda4,],
                       ">=" = BiosFinal[BiosFinal[,Var4] >= Moda4,],
                       "<" = BiosFinal[BiosFinal[,Var4] < Moda4,],
                       "<=" = BiosFinal[BiosFinal[,Var4] <= Moda4,])
    BiosFinal <- BiosFinal[!(str_detect(row.names(BiosFinal),"NA")),] 
  })
  
  
  test <- reactive({
    Critere1 <- Critere1()
    Critere2 <- Critere2()
    ID <- input$ID
    Crit <- data.frame(Critere2[,ID]) 

    names(Crit)[1]<- ID
    don<-switch(input$OperateurMid,
                " " = Critere1,
                "OU" =  unique(rbind(Critere1, Critere2)), 
                "ET" =  {
                Critere1$tempProdACMVariableImprobable <- rownames(Critere1)
                testC <- merge(Critere1, Crit, by=ID)
                rownames(testC) <- testC$tempProdACMVariableImprobable
                testC$tempProdACMVariableImprobable <- NULL
                testC
                }
                  # unique(merge(Critere1, Crit, by=ID))
                )

  })
  test2 <- reactive({
    Critere3 <- Critere3()
    Critere2 <- test()
    ID <- input$ID
    Crit <- data.frame(Critere3[,ID])
    names(Crit)[1]<- ID
    switch(input$OperateurMid2,
           " " = Critere2,
           "OU" =  unique(rbind(Critere3, Critere2)), 
           "ET" =  {
             Critere2$tempProdACMVariableImprobable <- rownames(Critere2)
             testC <- merge(Critere2, Crit, by=ID)
             rownames(testC) <- testC$tempProdACMVariableImprobable
             testC$tempProdACMVariableImprobable <- NULL
             testC
           }
             #unique(merge(Critere2, Crit, by=ID))
           )
  })
  
  
  test3 <- reactive({
    Critere4 <- Critere4()
    Critere3 <- test2()
    ID <- input$ID
    
    Crit <- data.frame(Critere4[,ID])

    names(Crit)[1]<- ID
    switch(input$OperateurMid3,
           " " = Critere3,
           "OU" =  unique(rbind(Critere4, Critere3)), 
           "ET" =  {
             Critere3$tempProdACMVariableImprobable <- rownames(Critere3)
             testC <- merge(Critere3, Crit, by=ID)
             rownames(testC) <- testC$tempProdACMVariableImprobable
             testC$tempProdACMVariableImprobable <- NULL
             testC
           } 
           #  unique(merge(Critere3, Crit, by=ID))
           )


  })

  test4 <- reactive({
    test3 <- test3()
    VariableTri <- input$VariableTri
    
    test4 <- test3
    test4[,VariableTri] <- switch(input$ChangementVarTri,
                                  "Pas de modification" = test4[,VariableTri] ,
                                  "Qualitative" = as.character ( test4[,VariableTri]),
                                  "Quantitative" =  as.numeric (test4[,VariableTri]),
                                  "Logique" = as.logical (test4[,VariableTri]))
    test4 <- test4[!(str_detect(row.names(test4),"NA")),]
    
    
  })
  

# C/ Création de la table pour l'ACM selon les variables conservées dans le modèle ----
#\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
  
  # Définition des variables illustratives :
  
  VarsIllus <- reactive({
    VarsIllus <- input$VarIllusPourACM
    TableACM <- TableACM()
    c<-which(as.list(names(TableACM))== VarsIllus[1])
    if (length(VarsIllus)<2){
      c<-which(as.list(names(TableACM))== VarsIllus[1])
    }else{
      c<-which(as.list(names(TableACM))== VarsIllus[1])
      #if (length(VarsIllus>1))
      for (i in 2:length(VarsIllus)) {
        c <- c(c, which(as.list(names(TableACM))== VarsIllus[i]))
      }
    }
    c
  })
  
  
  VarsIllusQuanti <- reactive({
    VarsIllusQuanti <- input$VarIllusQuantiPourACM
    TableACM <- TableACM()
    c<-which(as.list(names(TableACM))== VarsIllusQuanti[1])
    if (length(VarsIllusQuanti)<2){
      c<-which(as.list(names(TableACM))== VarsIllusQuanti[1])
    }else{
      c<-which(as.list(names(TableACM))== VarsIllusQuanti[1])
      #if (length(VarsIllusQuanti>1))
      for (i in 2:length(VarsIllusQuanti)) {
        c <- c(c, which(as.list(names(TableACM))== VarsIllusQuanti[i]))
      }
    }
    c
  })
  
  
  
  Illus <- reactive({
    VarsIllus <- VarsIllus()
    if (length(VarsIllus)<1) {
      test <- ""
    }else{
      d <- paste("c(",VarsIllus[1], sep="")
      if (length(VarsIllus)<2){
        test <- paste(d, ")", sep="")
      }else{
        for (i in 2:length(VarsIllus)) {
          d <- paste(d,",",VarsIllus[i], sep="")
        }
        test <- paste(d, ")", sep="")
      }
    }
    Illus<-  test
    Illus
  })
  IllusQuanti <- reactive({
    VarsIllusQuanti <- VarsIllusQuanti()
    if (length(VarsIllusQuanti)<1) {
      test <- ""
    }else{
      d <- paste("c(",VarsIllusQuanti[1], sep="")
      if (length(VarsIllusQuanti)<2){
        test <- paste(d, ")", sep="")
        
      }else{
        for (i in 2:length(VarsIllusQuanti)) {
          d <- paste(d,",",VarsIllusQuanti[i], sep="")
        }
        test <- paste(d, ")", sep="")
      }
    }
    IllusQuanti<-  test
    IllusQuanti
  })
 
  
  
  # Selection de la variable pour tri à plat :
  
  output$SelectVarTri <- renderUI ({
    ID <- input$ID
    if (ID == " ") {return ("")} else {
    
    selectInput("VariableTri", "Variable :",
                choices=as.list(c(" ",names(test3()))),selected=" ")
    }
  })
  

  TypeVarTri <- reactive({
 
    Donnees <- test4()
    VariableTri <-  input$VariableTri
    class(Donnees[,VariableTri])
  })
  
  output$TypeVarTri <- renderText({
    
    
    ## Validations / erreurs 
    validate(
      need(nrow(donnees_entree())!=0, "")
    )
    validate(
      need(input$ID!= " ", "")
    )
    validate(
      need(input$VariableTri!= " ", "")
    )
    
    ## Contenu
    
      TypeVarTri()
    })
  
  
  output$TableVarTri <- renderTable({
    
   ## Validations / erreurs 
    validate(
      need(nrow(donnees_entree())!=0, "Charger une table (onglet 1)")
    )
    
    
    validate(
      need(input$ID!= " ", "Sélectionner un identifiant (onglet 1)")
    )
    
    
    validate(
      need(input$VariableTri!= " ", "Sélectionner une variable")
    )
    
    ## Données
    Donnees <- test4()
    VariableTri <-  input$VariableTri
    
    ## Contenu
    if (class(Donnees[,VariableTri])=="character" |
        class(Donnees[,VariableTri])=="logical"){
      t<- freq(Donnees[,VariableTri], sort="dec",total = T) 
      t$Modalites <- row.names(t)
      t <- t[,c(4,1:3)]
      t
    }
    else if (class(Donnees[,VariableTri])=="integer" |
             class(Donnees[,VariableTri])=="numeric"){

      t <- Donnees %>% 
        dplyr::summarise (Min = min(eval(parse(text=VariableTri)), na.rm= T), 
                          Quartile1 = quantile(eval(parse(text=VariableTri)), .25, na.rm = T),
                          Mediane = median(eval(parse(text=VariableTri)), na.rm = T),
                          Moyenne = round(mean(eval(parse(text=VariableTri)), na.rm = T),1), 
                          Quartile3 = quantile(eval(parse(text=VariableTri)), .75, na.rm = T),
                          Max = max(eval(parse(text=VariableTri)), na.rm = T), 
                          NbreNA = sum(is.na(eval(parse(text=VariableTri)))))
      t
    }
    
  })
  
  
  # Table pour l'ACM :
  
  TableACM <- reactive({
    validate(
      need(length(input$VarPourACM)>1, " ")
    )
    Vars <- input$VarPourACM
    VarQuanti <- input$VarIllusQuantiPourACM
    BiosFinal <- test3()
    TableACM <- data.frame(BiosFinal[,Vars])
    for (i in 1:ncol(TableACM)) {
      TableACM[,i] <- factor(TableACM[,i])
    }
    if (length(VarQuanti)==0) {
      TableACM <- TableACM
    } else{
      for (i in 1:length(VarQuanti)){
        TableACM[,unlist(VarQuanti)[i]] <- as.numeric(TableACM[,unlist(VarQuanti)[i]])
      }
    }
    TableACM
    
  })
  
  
  # D/ Résultat de l'ACM  ------------
  #\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
  ACM <- reactive({
    tmp<-TableACM()
    Illus <- Illus()
    IllusQuanti <- IllusQuanti()
    ListeModaSpe <- ListeModaSpe()
  #  ACMSpe <- input$ACMSpe
  #  if (ACMSpe == TRUE) {
  #    ACM <- GDAtools::speMCA(tmp)
  #  } else {
    
    ACM <- MCA(tmp, quali.sup =  eval(parse(text=Illus)), ncp=100,
               quanti.sup=eval(parse(text=IllusQuanti)), graph = F)
#    }
    ACM
    
  })
  
  
  # Préparation des données pour les représentations :
  res <- reactive({
    ACMSpe <- input$ACMSpe
    ACM <- ACM()
    
  #  if (ACMSpe == TRUE) {
  #   res <- explor::prepare_results.speMCA(ACM)
   # } else {
    res <- explor::prepare_results(ACM)
   # }
  })
  
  # Choix pour la classification ---------------
  
  output$NbAxes.Cl.Choix <- renderUI({
    Type.Cl <- input$Type.Cl
    ACM <- ACM()
    Max <- nrow(ACM$eig)
    if (Type.Cl == "Hiérarchique"){
    sliderInput("NbAxes.Cl", label = "1. Nombre d'axes à inclure (max = nbre d'axes total, limité à 100)", min = 1, 
                max = Max, value = ifelse(Max < 11, Max, 10), step=1)}
    
  })
  
  output$Metric.Cl.Choix <- renderUI({
    Type.Cl <- input$Type.Cl
    if (Type.Cl == "Hiérarchique"){
    selectInput("Metric.Cl", "2. Choix de la métrique",
                choices=as.list(c("euclidienne","manhattan")),
                selected="euclidienne")
    }
  })
  
  output$Agreg.Cl.Choix <- renderUI({
    Type.Cl <- input$Type.Cl
    if (Type.Cl == "Hiérarchique"){
    selectInput("Agreg.Cl", "3. Critère d'agrégation",
                choices=as.list(c("saut minimum","diamètre","moyennes","ward")),
                selected="ward")
    }
  })
  
  output$Part.H.Cl.Choix <- renderUI({
    Type.Cl <- input$Type.Cl
    if (Type.Cl == "Hiérarchique"){
      selectInput("Part.H.Cl", "4. Type de partition",
                  choices=as.list(c("ascendante","descendante")),
                  selected="ascendante")
    }
  })
  
  
  output$NbreCl.Cl.Choix <- renderUI({
    Type.Cl <- input$Type.Cl
    if (Type.Cl == "Hiérarchique"){
      
      numericInput("NbreClasses","5. Nombre classes résultantes",5)
    }    
    else if (Type.Cl == "Pas de classification"){
      
      numericInput("NbreClasses","5. Nombre classes résultantes",1)
    }
  })
  
 


  # Résultation de la classification ---------------

  
  # Arbre selon le nbre de classes :
  cahTree <- reactive({
    ACM <- ACM()
    NbAxes.Cl <- input$NbAxes.Cl
    NbreClasses <- input$NbreClasses
    Metric.Cl <- switch(input$Metric.Cl,
                        "euclidienne"="euclidean",
                        "manhattan"= "manhattan")
    Agreg.Cl <- switch(input$Agreg.Cl,
                       "saut minimum" = "single",
                       "diamètre"="complete",
                       "moyennes"="average",
                       "ward"="ward")
    agnes(ACM$ind$coord[,1:NbAxes.Cl], method = Agreg.Cl, metric=Metric.Cl) 
  })
  
  DataClust <- reactive({
    # On veut : Noms + Classes
    Donnees <- test3()
    cahTree <- cahTree()
    NbreClasses <- input$NbreClasses
    Agnes.Cl <- cutree(cahTree, k=NbreClasses)
   # Agnes.Cl.vect <- factor(Agnes.Cl,labels=paste('classe',1:NbreClasses, sep=' '))
    
    DataClust <- data.frame(Name=rownames(cahTree$data), clust= cutree(cahTree, k=NbreClasses), stringsAsFactors = F)
   # DataClust <- data.frame(Name=rownames(cahTree$data), clust=Agnes.Cl.vect, stringsAsFactors = F)
   
     DataClust$clust <- as.character(DataClust$clust)
    
    # DataClust <-data.frame(Agnes.Cl.vect)
    # rownames (DataClust) <- rownames(Donnees)
    # colnames(DataClust) <- "clust"
    # DataClust$Name <- rownames(DataClust)
    # 
    
    DataClust
    
    
  })
  
  # E/ EN SORTIE : Tables et graphiques -----------
  #\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
  
  # Table des types de variables conservées pour l'ACM :
  
  output$Type <- renderTable({
    tmp <- TableACM()
    
    VarQuanti <- input$VarIllusQuantiPourACM
    
    Var <- input$VarIllusPourACM
    
    validate(
      need(length(input$VarPourACM)>0 , "Choisir au moins 2 variables pour l'ACM")
    )
    
    
    Type <-  data.frame( Variable = names(tmp[1]),
                         Type = class(tmp[,1]))
    for (i in (2:ncol(tmp))) {
      Type<-rbind(Type, data.frame( Variable = names(tmp[i]),
                                    Type = class(tmp[,i])))
    }
    
    Type$StatutACM <- "Active"
    if (length(Var)==0) {Type <- Type}else{
      for (i in (1:nrow(Type))){
        for (j in (1:length(Var))) {
          if (Type$Variable[i]==unlist(Var)[j]){
            Type$StatutACM[i] <- "Supplémentaire"
          }}}
    }
    
    if (length(VarQuanti)==0) {Type <- Type }else{
      for (i in (1:nrow(Type))){
        for (j in (1:length(VarQuanti))) {
          if (Type$Variable[i]==unlist(VarQuanti)[j]){
            Type$StatutACM[i] <- "Supplémentaire"
          }}}
    }
    
    
    Type
  })

  #  Valeurs propres :
  
  output$ValeursPropres<-renderTable({
    NbreAxes <- input$NbreAxes
    ACM <- ACM()
    ACMSpe <- input$ACMSpe
    
    validate(
      need(length(input$VarPourACM)>1, "Choisir au moins 2 variables pour l'ACM")
    )

   # if (ACMSpe == TRUE) {
      
    #  ValeursPropres <- data.frame (var=round(ACM$eig[,"rate"],digits=1),
    #                                VarCumulee=round(ACM$eig[,"cum.rate"],digits=1))
    #  ValeursPropres$Axe <- row.names(ValeursPropres)
    #  ValeursPropres <- ValeursPropres[,c(3,1,2)]
    #  ValeursPropres <- ValeursPropres[1:NbreAxes,]
    #  ValeursPropres[,1] <- paste("dim",ValeursPropres[,1], " ")
    #  row.names(ValeursPropres) <- ValeursPropres[,1]
      
      
   # } else {
    ValeursPropres <- data.frame (Axe= row.names(ACM$eig),
                                  var=round(ACM$eig[,"percentage of variance"],digits=1),
                                  VarCumulee=round(ACM$eig[,"cumulative percentage of variance"],digits=1))
    ValeursPropres <- ValeursPropres[1:NbreAxes,]
  #  }
  })
  
  # Graphes des valeurs propres :
  
  output$Variance <- renderPlot({
    ACM <- ACM()
    
    NbreAxes <- input$NbreAxes
    validate(
      need(length(input$VarPourACM)>1, "Choisir au moins 2 variables pour l'ACM")
    )
    
    Val10 <- data.frame (Axe= row.names(ACM$eig),
                                  var=round(ACM$eig[,"percentage of variance"],digits=1),
                                  VarCumulee=round(ACM$eig[,"cumulative percentage of variance"],digits=1))
    Val10<- Val10[1:NbreAxes,]
    
    Val10 <- arrange (Val10,  desc(var))
    Val10$Axe <- factor(Val10$Axe,
                        levels = Val10$Axe[order(Val10$VarCumulee)])
    ggplot(Val10, aes(x=Axe, y=var))+geom_bar(stat="identity")+
      ggtitle("Variance")+labs(y="Variance (%)")
  })
  
  output$VarianceCum <- renderPlot({
    
    validate(
      need(length(input$VarPourACM)>1, "Choisir au moins 2 variables pour l'ACM")
    )
    
    ACM <- ACM()
    
    NbreAxes <- input$NbreAxes
    Val10 <- data.frame (Axe= row.names(ACM$eig),
                         var=round(ACM$eig[,"percentage of variance"],digits=1),
                         VarCumulee=round(ACM$eig[,"cumulative percentage of variance"],digits=1))
    Val10<- Val10[1:NbreAxes,]
    
    Val10 <- arrange (Val10,  desc(var))
    Val10$Axe <- factor(Val10$Axe,
                        levels = Val10$Axe[order(Val10$VarCumulee)])
    ggplot(Val10, aes(x=Axe, y=var))+geom_bar(stat="identity")+
      ggtitle("Variance")+labs(y="Variance (%)")
    ggplot(Val10, aes(x=Axe, y=VarCumulee))+geom_bar(stat="identity")+
      ggtitle("Variance cumulée")+labs(y="Variance cumulée (%)")
  })
  
  # Graphiques des variables : 
  
  output$GraphVarAxeA <- renderScatterD3({
    
    validate(
      need(length(input$VarPourACM)>1, "Choisir au moins 2 variables pour l'ACM")
    )
    res <-res()
    ACM <- ACM()
    VarAxeA <- input$VarAxeA
    Graphiques1 <- explor::prepare_results(ACM)
    MaxCoord1 <- round(max(ACM$var$coord[,VarAxeA]), digits=2)
    MinCoord1 <- round(min(ACM$var$coord[,VarAxeA]), digits=2)
    vars <-Graphiques1$vars[Graphiques1$vars[,"Axis"]==VarAxeA,] 
    ind <-Graphiques1$ind[Graphiques1$ind[,"Axis"]==VarAxeA,] 
    eig <- Graphiques1$eig[Graphiques1$eig[,"dim"]==VarAxeA,]
    vareta2<-Graphiques1$vareta2
    quali_data <- Graphiques1$quali_data
    
    
  Graphiques1 <- list("vars"=vars, "ind"=ind, "eig"=eig,"axes"=as.integer(1), 
                      "vareta2"=vareta2,"quali_data"=quali_data)
  
  Graphiques1$vars <- Graphiques1$vars[Graphiques1$vars$Type == "Active",]
  
  Graphiques1$vars <- dplyr::arrange (Graphiques1$vars, Variable)
  
  scatterD3::scatterD3(data = Graphiques1$vars, x = Coord, y = Axis, fixed = F,
                       ylim = c(VarAxeA-.1,VarAxeA+.1) ,
                       xlim = c(MinCoord1-.5, MaxCoord1+.5),
                       col_var =  Variable, legend_width = F)
    })
 
  
  
  output$GraphVarAxeB <- renderScatterD3({
    
    validate(
      need(length(input$VarPourACM)>1, "Choisir au moins 2 variables pour l'ACM")
    )
    res <-res()
    ACM <- ACM()
    Graphiques1 <- explor::prepare_results(ACM)
    VarAxeB <- input$VarAxeB
    MaxCoord1 <- round(max(ACM$var$coord[,VarAxeB]), digits=2)
    MinCoord1 <- round(min(ACM$var$coord[,VarAxeB]), digits=2)
    vars <-Graphiques1$vars[Graphiques1$vars[,"Axis"]==VarAxeB,] 
    ind <-Graphiques1$ind[Graphiques1$ind[,"Axis"]==VarAxeB,] 
    eig <- Graphiques1$eig[Graphiques1$eig[,"dim"]==VarAxeB,]
    vareta2<-Graphiques1$vareta2
    quali_data <- Graphiques1$quali_data
    
    
    Graphiques1 <- list("vars"=vars, "ind"=ind, "eig"=eig,"axes"=as.integer(1), 
                        "vareta2"=vareta2,"quali_data"=quali_data)
    
    Graphiques1$vars <- Graphiques1$vars[Graphiques1$vars$Type == "Active",]
    Graphiques1$vars <- dplyr::arrange (Graphiques1$vars, Variable)
    
    scatterD3::scatterD3(data = Graphiques1$vars, x = Axis, y = Coord, fixed = F,
                         ylim = c(MinCoord1-.5, MaxCoord1+.5),
                         xlim = c(VarAxeB-.1, VarAxeB+.1) ,
                         col_var =  Variable, legend_width = F)
  })
  
  
  output$GraphVar <- renderScatterD3({
    
    validate(
      need(length(input$VarPourACM)>1, "Choisir au moins 2 variables pour l'ACM")
    )
    
    res <-res()
    ACM <- ACM()
    MinContribVar1 <- input$MinContribVar1
    VarAxeA <- input$VarAxeA
    VarAxeB <- input$VarAxeB
    MaxCoord1 <- round(max(ACM$var$coord[,VarAxeA]), digits=2)
    MinCoord1 <- round(min(ACM$var$coord[,VarAxeA]), digits=2)
    MaxCoord2 <- round(max(ACM$var$coord[,VarAxeB]), digits=2)
    MinCoord2 <- round(min(ACM$var$coord[,VarAxeB]), digits=2)
    GraphVar<- explor::MCA_var_plot(res, xax = VarAxeA, yax = VarAxeB,
                                    var_sup = TRUE, var_lab_min_contrib = MinContribVar1,
                                    col_var = "Variable", symbol_var = "Type",
                                    size_var = "Contrib", size_range = c(52.5, 700),
                                    labels_size = 12, point_size = 56,
                                    transitions = TRUE, labels_positions = NULL,
                                    xlim = c(MinCoord1-.5, MaxCoord1+.5),
                                    ylim = c(MinCoord2-.5, MaxCoord2+.5)) 
  })
  
  
  
  output$GraphVarAxeC <- renderScatterD3({
    
    validate(
      need(length(input$VarPourACM)>1, "Choisir au moins 2 variables pour l'ACM")
    )
    res <-res()
    ACM <- ACM()
    VarAxeC <- input$VarAxeC
    Graphiques1 <- explor::prepare_results(ACM)
    MaxCoord1 <- round(max(ACM$var$coord[,VarAxeC]), digits=2)
    MinCoord1 <- round(min(ACM$var$coord[,VarAxeC]), digits=2)
    vars <-Graphiques1$vars[Graphiques1$vars[,"Axis"]==VarAxeC,] 
    ind <-Graphiques1$ind[Graphiques1$ind[,"Axis"]==VarAxeC,] 
    eig <- Graphiques1$eig[Graphiques1$eig[,"dim"]==VarAxeC,]
    vareta2<-Graphiques1$vareta2
    quali_data <- Graphiques1$quali_data
    
    
    Graphiques1 <- list("vars"=vars, "ind"=ind, "eig"=eig,"axes"=as.integer(1), 
                        "vareta2"=vareta2,"quali_data"=quali_data)
    
    Graphiques1$vars <- Graphiques1$vars[Graphiques1$vars$Type == "Active",]
    
    Graphiques1$vars <- dplyr::arrange (Graphiques1$vars, Variable)
    
    scatterD3::scatterD3(data = Graphiques1$vars, x = Coord, y = Axis, fixed = F,
                         ylim = c(VarAxeC-.1,VarAxeC+.1) ,
                         xlim = c(MinCoord1-.5, MaxCoord1+.5),
                         col_var =  Variable, legend_width = F)
  })
  
  
  
  output$GraphVarAxeD <- renderScatterD3({
    
    validate(
      need(length(input$VarPourACM)>1, "Choisir au moins 2 variables pour l'ACM")
    )
    res <-res()
    ACM <- ACM()
    Graphiques1 <- explor::prepare_results(ACM)
    VarAxeD <- input$VarAxeD
    MaxCoord1 <- round(max(ACM$var$coord[,VarAxeD]), digits=2)
    MinCoord1 <- round(min(ACM$var$coord[,VarAxeD]), digits=2)
    vars <-Graphiques1$vars[Graphiques1$vars[,"Axis"]==VarAxeD,] 
    ind <-Graphiques1$ind[Graphiques1$ind[,"Axis"]==VarAxeD,] 
    eig <- Graphiques1$eig[Graphiques1$eig[,"dim"]==VarAxeD,]
    vareta2<-Graphiques1$vareta2
    quali_data <- Graphiques1$quali_data
    
    
    Graphiques1 <- list("vars"=vars, "ind"=ind, "eig"=eig,"axes"=as.integer(1), 
                        "vareta2"=vareta2,"quali_data"=quali_data)
    
    Graphiques1$vars <- Graphiques1$vars[Graphiques1$vars$Type == "Active",]
    Graphiques1$vars <- dplyr::arrange (Graphiques1$vars, Variable)
    
    scatterD3::scatterD3(data = Graphiques1$vars, x = Axis, y = Coord, fixed = F,
                         ylim = c(MinCoord1-.5, MaxCoord1+.5),
                         xlim = c(VarAxeD-.1, VarAxeD+.1) ,
                         col_var =  Variable, legend_width = F)
  })
  
  
  
  output$GraphVar2 <- renderScatterD3({
    
    validate(
      need(length(input$VarPourACM)>1, "Choisir au moins 2 variables pour l'ACM")
    )
    
    res <-res()
    ACM <- ACM()
    MinContribVar2 <- input$MinContribVar2
    VarAxeC <- input$VarAxeC
    VarAxeD <- input$VarAxeD
    MaxCoord3 <- round(max(ACM$var$coord[,VarAxeC]), digits=2)
    MinCoord3 <- round(min(ACM$var$coord[,VarAxeC]), digits=2)
    MaxCoord4 <- round(max(ACM$var$coord[,VarAxeD]), digits=2)
    MinCoord4 <- round(min(ACM$var$coord[,VarAxeD]), digits=2)
    GraphVar<- explor::MCA_var_plot(res, xax = VarAxeC, yax = VarAxeD,
                                    var_sup = TRUE, var_lab_min_contrib = MinContribVar2,
                                    col_var = "Variable", symbol_var = "Type",
                                    size_var = "Contrib", size_range = c(52.5, 700),
                                    labels_size = 12, point_size = 56,
                                    transitions = TRUE, labels_positions = NULL,
                                    xlim = c(MinCoord3-.5, MaxCoord3+.5),
                                    ylim = c(MinCoord4-.5, MaxCoord4+.5)) 
    GraphVar
  })
  
  # Tables des variables :
  
  TableVar <- reactive({
    
    validate(
      need(length(input$VarPourACM)>1, "Choisir au moins 2 variables pour l'ACM")
    )
    
    ACM <- ACM()
    AxeVar1 <- input$AxeVar1
    ContribVar1 <- input$ContribVar1
    Contrib <- data.frame ( Var=row.names(ACM$var$contrib),
                            Contrib=round(ACM$var$contrib[,AxeVar1],digits=1),
                            Coord=round(ACM$var$coord[,AxeVar1],digits=1),
                            Cos2=round(ACM$var$cos2[,AxeVar1],digits=1))
    Contrib <- arrange(Contrib, desc(Contrib))
    Contrib[(Contrib$Contrib>ContribVar1)  ,]
  }
  
  )
  output$TableVar <- renderDataTable({
    
    validate(
      need(length(input$VarPourACM)>1, "")
    )
    
    TableVar <- TableVar()
    datatable(TableVar,options = list(pageLength = 20))  
  })
  TableVar2 <- reactive({
    
    validate(
      need(length(input$VarPourACM)>1, "Choisir au moins 2 variables pour l'ACM")
    )
    
    ACM <- ACM()
    AxeVar2 <- input$AxeVar2
    ContribVar2 <- input$ContribVar2
    Contrib <- data.frame ( Var=row.names(ACM$var$contrib),
                            Contrib=round(ACM$var$contrib[,AxeVar2],digits=1),
                            Coord=round(ACM$var$coord[,AxeVar2],digits=1),
                            Cos2=round(ACM$var$cos2[,AxeVar2],digits=1))
    Contrib <- arrange(Contrib, desc(Contrib))
    Contrib[(Contrib$Contrib>ContribVar2)  ,]
  })
  output$TableVar2 <- renderDataTable({
    
    validate(
      need(length(input$VarPourACM)>1, "")
    )
    
    TableVar2 <- TableVar2()
    datatable(TableVar2,options = list(pageLength = 20))
    
  })  
  
  # Graphiques des individus
  
  output$GraphInd <- renderScatterD3({
    
    validate(
      need(length(input$VarPourACM)>1, "Choisir au moins 2 variables pour l'ACM")
    )
    
    res <-res()
 #   cah <- cah()
    ACM <- ACM()
    IndAxe1 <- input$IndAxe1
    IndAxe2 <- input$IndAxe2
    MaxCoord1 <- max(ACM$ind$coord[,IndAxe1])
    MinCoord1 <- min(ACM$ind$coord[,IndAxe1])
    MaxCoord2 <- max(ACM$ind$coord[,IndAxe2])
    MinCoord2 <- min(ACM$ind$coord[,IndAxe2])
    MinContrib1 <- input$MinContrib1
    NbreClasses <- input$NbreClasses
    Ellipse <- input$Ellipse
    VarClassesGraphe <- input$VarClassesGraphe
    ID <- input$ID
    TableACM <- test3()
    data.clust <- DataClust()
    
    if (VarClassesGraphe!=" "){
      
      TableACM$Name <- rownames(TableACM)
      TableACM$Name <- as.character(TableACM$Name)
      res$quali_data <- merge( res$quali_data, TableACM[,c("Name",VarClassesGraphe)], by="Name", all.x=T)
      names(res$quali_data) <- gsub("\\.y", "", names(res$quali_data))
      GraphInd <- MCA_ind_plot(res, xax = IndAxe1, yax = IndAxe2,ind_sup = FALSE, ind_lab_min_contrib = MinContrib1,
                               col_var = VarClassesGraphe, lab_var = "Name", labels_size = 12,
                               point_opacity = 0.5, opacity_var = "Contrib", point_size = 64,
                               ellipses = Ellipse, transitions = TRUE, labels_positions = NULL,
                               xlim = c(MinCoord1-.25, MaxCoord1+.25),
                               ylim = c(MinCoord2-.25, MaxCoord2+.25))
      
    } else {
      if (NbreClasses==1){
        GraphInd <- MCA_ind_plot(res, xax = IndAxe1, yax = IndAxe2,ind_sup = FALSE, ind_lab_min_contrib = MinContrib1,
                                 lab_var = "Name", labels_size = 12,
                                 point_opacity = 0.5, opacity_var = "Contrib", point_size = 64,
                                 ellipses = Ellipse, transitions = TRUE, labels_positions = NULL,
                                 xlim = c(MinCoord1-.25, MaxCoord1+.25),
                                 ylim = c(MinCoord2-.25, MaxCoord2+.25))
      } else {
        res$quali_data <- merge(res$quali_data, data.clust[,c("Name","clust")], by="Name", all.x=T)
        
        GraphInd <- MCA_ind_plot(res, xax = IndAxe1, yax = IndAxe2,ind_sup = FALSE, ind_lab_min_contrib = MinContrib1,
                                 col_var = "clust", lab_var = "Name", labels_size = 12,
                                 point_opacity = 0.5, opacity_var = "Contrib", point_size = 64,
                                 ellipses = Ellipse, transitions = TRUE, labels_positions = NULL,
                                 xlim = c(MinCoord1-.25, MaxCoord1+.25),
                                 ylim = c(MinCoord2-.25, MaxCoord2+.25))
      }
    }
        
    
    GraphInd
  })
  
  
  output$GraphInd2 <- renderScatterD3({
    
    validate(
      need(length(input$VarPourACM)>1, "Choisir au moins 2 variables pour l'ACM")
    )
    
    res <-res()
  #  cah <- cah()
    MinContrib2 <- input$MinContrib2
    
    ACM <- ACM()
    IndAxe3 <- input$IndAxe3
    IndAxe4 <- input$IndAxe4
    MaxCoord3 <- max(ACM$ind$coord[,IndAxe3])
    MinCoord3 <- min(ACM$ind$coord[,IndAxe3])
    MaxCoord4 <- max(ACM$ind$coord[,IndAxe4])
    MinCoord4 <- min(ACM$ind$coord[,IndAxe4])
    NbreClasses <- input$NbreClasses
    Ellipse2 <- input$Ellipse2
    VarClassesGraphe <- input$VarClassesGraphe
    ID <- input$ID
    TableACM <- test3()
    data.clust <- DataClust()
    
    if (VarClassesGraphe!=" "){
      
      TableACM$Name <- rownames(TableACM)
      TableACM$Name <- as.character(TableACM$Name)
      res$quali_data <- merge( res$quali_data, TableACM[,c("Name",VarClassesGraphe)], by="Name", all.x=T)
      names(res$quali_data) <- gsub("\\.y", "", names(res$quali_data))
      GraphInd2 <- MCA_ind_plot(res, xax = IndAxe3, yax = IndAxe4,ind_sup = FALSE, ind_lab_min_contrib = MinContrib2,
                               col_var = VarClassesGraphe, lab_var = "Name", labels_size = 12,
                               point_opacity = 0.5, opacity_var = "Contrib", point_size = 64,
                               ellipses = Ellipse2, transitions = TRUE, labels_positions = NULL,
                               xlim = c(MinCoord3-.25, MaxCoord3+.25),
                               ylim = c(MinCoord4-.25, MaxCoord4+.25))
      
    } else {
      if (NbreClasses==1){
        GraphInd2 <- MCA_ind_plot(res, xax = IndAxe3, yax = IndAxe4,ind_sup = FALSE, ind_lab_min_contrib = MinContrib2,
                                 lab_var = "Name", labels_size = 12,
                                 point_opacity = 0.5, opacity_var = "Contrib", point_size = 64,
                                 ellipses = Ellipse2, transitions = TRUE, labels_positions = NULL,
                                 xlim = c(MinCoord3-.25, MaxCoord3+.25),
                                 ylim = c(MinCoord4-.25, MaxCoord4+.25))
      } else {
        res$quali_data <- merge(res$quali_data, data.clust[,c("Name","clust")], by="Name", all.x=T)
        
        GraphInd2 <- MCA_ind_plot(res, xax = IndAxe3, yax = IndAxe4,ind_sup = FALSE, ind_lab_min_contrib = MinContrib2,
                                 col_var = "clust", lab_var = "Name", labels_size = 12,
                                 point_opacity = 0.5, opacity_var = "Contrib", point_size = 64,
                                 ellipses = Ellipse2, transitions = TRUE, labels_positions = NULL,
                                 xlim = c(MinCoord3-.25, MaxCoord3+.25),
                                 ylim = c(MinCoord4-.25, MaxCoord4+.25))
      }
    }
    
    
    GraphInd2
  })
  
  
  # Tables des individus :
  
  TableInd <- reactive ({
    ACM <- ACM()
    AxeInd1 <- input$AxeInd1
    ContribInd1 <- input$ContribInd1
    
    Contrib <- data.frame ( Ind=row.names(ACM$ind$contrib),
                            Contrib=round(ACM$ind$contrib[,AxeInd1],digits=1),
                            Coord=round(ACM$ind$coord[,AxeInd1],digits=1),
                            Cos2=round(ACM$ind$cos2[,AxeInd1],digits=1))
    Contrib <- arrange(Contrib, desc(Contrib))
    Contrib[(Contrib$Contrib>ContribInd1)  ,]
  })
  output$TableInd <- renderDataTable({
    TableInd <- TableInd()
    datatable(TableInd,options = list(pageLength = 20))
    
  })
  
  TableInd2 <- reactive ({
    ACM <- ACM()
    AxeInd2 <- input$AxeInd2
    ContribInd2 <- input$ContribInd2
    Contrib <- data.frame ( Ind=row.names(ACM$ind$contrib),
                            Contrib=round(ACM$ind$contrib[,AxeInd2],digits=1),
                            Coord=round(ACM$ind$coord[,AxeInd2],digits=1),
                            Cos2=round(ACM$ind$cos2[,AxeInd2],digits=1))
    Contrib <- arrange(Contrib, desc(Contrib))
    Contrib[(Contrib$Contrib>ContribInd2)  ,]
  })
  output$TableInd2 <- renderDataTable({
    TableInd2 <- TableInd2()
    datatable(TableInd2,options = list(pageLength = 20))
    
  })  
  
  #  Classification
  
  output$plot <- renderPlot({
    cah <- cahTree()
    NbreClasses <- input$NbreClasses
    A2Rplot(cah,k=NbreClasses, col.up = "gray50", 
            col.down = brewer.pal(NbreClasses, "Dark2"), show.labels = FALSE,boxes = FALSE)
  })
  
  output$plot3 <- renderPlot({
    cah <- cahTree()
    NbreClasses <- input$NbreClasses
    Max <-  ifelse(NbreClasses >5, NbreClasses*2, 10)
    tri <- data.frame(var=sort(cah$height[1:Max], decreasing = TRUE),
                      axe=seq(1,Max,1))
    tri$col <- ifelse(tri$axe <= NbreClasses, "1","2")
    tri$axe<-factor(tri$axe)
    
    ggplot(data=tri, aes(x=axe, y=var, fill=col))+geom_bar(stat="identity",
                                                           colour="black")+
      labs(x="Nombre de classes", y="Inertie") +
      ggtitle("")+
      scale_fill_manual(values=c('brown4','grey'),
                        guide=FALSE)+
      theme_light()+theme(axis.text.x = element_text(angle=45, hjust=1, vjust=1,size=10),
                          axis.title=element_text(size=12,face="bold"),
                          axis.title.y=element_blank(),
                          axis.text.y=element_blank(),
                          legend.text=element_text(size=10),
                          title = element_text(size=12, face="bold"),
                          plot.title=element_text(hjust = 0.5))+theme(legend.position="none")
    
    
    
  })
  
  # Table des individus selon les groupes générés par la classifications

  IndEtClasses <- reactive({
   # cah <- cah()
   # cah$data.clust$Name <- row.names(cah$data.clust)
    data.clust <- DataClust()
    IndEtClasses <- data.frame (Noms = data.clust$Name ,
                                Classes = data.clust$clust)
  })
  output$IndEtClasses <- renderDataTable({
    
    validate(
      need(nrow(donnees_entree())!=0, "")
    )
    validate(
      need(input$ID!= " ", "")
    )
    IndEtClasses <- IndEtClasses()
    
  })
  output$TableEffClasses <- renderTable({
    
    validate(
      need(nrow(donnees_entree())!=0, "")
    )
    validate(
      need(input$ID!= " ", "")
    )
    
    IndEtClasses <- IndEtClasses()
    t<- freq(IndEtClasses$Classes, total= T, cum = F)
    t$Classes <- row.names(t)
    t <- t[,c(4,1:2)]
    names(t) <- c("Classes","Effectifs","%")
    t
  })
  
  # Selection de la variable pour croisé avec les classes :
  
  output$SelectVarClasses <- renderUI ({
    
    ## Validations / erreurs :
    validate(
      need(nrow(donnees_entree())!=0, "")
    )
    
    
    validate(
      need(input$ID!= " ", "")
    )
    
    
    
    ## Contenu :
    
    selectInput("VariableClasses", "Variable :",
                choices=as.list(c(" ",names(test3()))),selected=" ")
  })
  
  
  
  # Croisement classe et autre variable :

  IndEtTableDep <-  reactive ({
    
    ## Validations / erreurs :
    validate(
      need(nrow(donnees_entree())!=0, "")
    )
    
    
    validate(
      need(input$ID!= " ", "")
    )
    
    ## Contenu
    TableDep <- test3()
    IndEtClasses <- IndEtClasses()
    ID <- input$LabelGraphInd
    
    IndEtTableDep <- merge (TableDep, IndEtClasses,
                            by.x = ID, by.y = "Noms",
                            all.x= T)
  })  
  
  TableVarClasses <- reactive({
    
    
    IndEtTableDep <- IndEtTableDep()
    
    VariableClasses <-  input$VariableClasses
    validate(
      need(input$VariableClasses!=" " , "Choisir une variable")
    )
    
    if (class(IndEtTableDep[,VariableClasses])=="character" |
        class(IndEtTableDep[,VariableClasses])=="logical"){
      t<-data.frame(cprop(table(IndEtTableDep[,VariableClasses], 
                                IndEtTableDep [,"Classes"])))
      t$Freq <- round(t$Freq, 2)
      t <- spread(t, "Var2","Freq")
      names(t)[1] <- VariableClasses
      names(t)[2:(ncol(t)-1)] <- paste0 ("Classe ",names(t)[2:(ncol(t)-1)])
      t
    }
    else if (class(IndEtTableDep[,VariableClasses])=="integer" |
             class(IndEtTableDep[,VariableClasses])=="numeric"){
      
      
      t <- IndEtTableDep %>% 
        group_by(Classes) %>% 
        dplyr::summarise (Min = min(eval(parse(text=VariableClasses)), na.rm= T), 
                          Quartile1 = quantile(eval(parse(text=VariableClasses)), .25, na.rm = T),
                   Mediane = round(median(eval(parse(text=VariableClasses)), na.rm = T),0),
                   Moyenne = round(mean(eval(parse(text=VariableClasses)), na.rm = T),1), 
                   Quartile3 = quantile(eval(parse(text=VariableClasses)), .75, na.rm = T),
                   Max = max(eval(parse(text=VariableClasses)), na.rm = T), 
                   NbreNA = sum(is.na(eval(parse(text=VariableClasses)))))
      t
    }
    
  })
  
  
  # Selection de la variable pour représentation des individus dans les graphiques :
  
  output$SelectVarClassesGraphe <- renderUI ({
    
    ## Validations / erreurs :
    validate(
      need(nrow(donnees_entree())!=0, "")
    )
    
    validate(
      need(input$ID!= " ", "")
    )
    
    selectInput("VarClassesGraphe", "Variables en couleurs (classes, par défaut) :",
                choices=as.list(c(" ",names(test3()))),selected=" ")
  })
  
  
  
  output$TableVarClasses <- renderTable({
    TableVarClasses <- TableVarClasses ()
  })

  # output$plot2 <- renderPlot({
  #  cah <- cah()
  #  NbreClasses <- input$NbreClasses
  #  plot(cah, choice = "tree")
  # })
  
  # output$plot4<-renderPlot({
  #    cah <- cah()
  #  plot(cah,choice='3D.map')
  # })
  
  #output$graph3<-renderPlot({
  #  tmp<-HCPCInput()
  #  plot.HCPC(tmp,choice='tree',title='Arbre hiérarchique') 
  #})
  
  # output$bilan_HCPC <- renderTable({
  #    tmp<-HCPCInput()
  #    summary(tmp)
  #  })
  
  # F/ Boutons et téléchargements ------------
  #\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
  # A REVOIR / FAIRE - NON UTILISE
  #\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\====
  
  output$DLMetaDonnees <- downloadHandler( 
    
    #write.csv2(IndEtClasses, "IndividusEtClasses", na="", row.names = F)
    filename=function() {
      paste0("MetaDonneesACM_",Sys.Date(),".csv")
    },
    content = function(file) {
      TableMeta <- TableMeta()
      write.csv2(TableMeta, file, fileEncoding = "UTF-8", na = "", row.names = FALSE )
    }
  )
  output$TableIndividusClasses <- downloadHandler( 
    
    #write.csv2(IndEtClasses, "IndividusEtClasses", na="", row.names = F)
    filename=function() {
      paste0("IndividusEtClasses",".csv")
    },
    content = function(file) {
      IndEtClasses <- IndEtClasses()
      write.csv2(IndEtClasses, file, fileEncoding = "UTF-8", na = "", row.names = FALSE )
    }
  )
  
  
  output$TableDepClasses <- downloadHandler( 
    
    filename=function() {
      paste0("TableDepartEtClasses",".csv")
    },
    content = function(file) {
      IndEtTableDep <- IndEtTableDep()
      write.csv2(IndEtTableDep, file, fileEncoding = "UTF-8", na = "", row.names = FALSE )
    }
  )
  
  output$DlTableVar1 <- downloadHandler( 
    filename=function() {
      paste0("TableVariables",".csv")
    },
    content = function(file) {
      
      TableVar <- TableVar()
      write.csv2(TableVar, file, fileEncoding = "UTF-8", na = "", row.names = FALSE )
    }
  )
  
  output$DlTableVar2 <- downloadHandler( 
    filename=function() {
      paste0("TableVariables2",".csv")
    },
    content = function(file) {
      
      TableVar2 <- TableVar2()
      write.csv2(TableVar2, file, fileEncoding = "UTF-8", na = "", row.names = FALSE )
    }
  )
  
  output$DlTableInd1 <- downloadHandler( 
    filename=function() {
      paste0("TableIndividus",".csv")
    },
    content = function(file) {
      
      TableInd <- TableInd()
      write.csv2(TableInd, file, fileEncoding = "UTF-8", na = "", row.names = FALSE )
    }
  )
  
  
  output$DlTableInd2 <- downloadHandler( 
    filename=function() {
      paste0("TableIndividus2",".csv")
    },
    content = function(file) {
      
      TableInd2 <- TableInd2()
      write.csv2(TableInd2, file, fileEncoding = "UTF-8", na = "", row.names = FALSE )
    }
  )
  
  output$PasDID <- downloadHandler( 
    filename=function() {
      paste0("TablePourACM_",Sys.Date(),".csv")
    },
    content = function(file) {
      
      donnees_entree <- donnees_entree()
      donnees_entree$ID <- row.names(donnees_entree)
      donnees_entree <- donnees_entree[, c(ncol(donnees_entree), 1:ncol(donnees_entree)-1)]
      write.csv2(donnees_entree, file, fileEncoding = "UTF-8", na = "", row.names = FALSE )
    }
  )
  
  output$DlCroisCl <- downloadHandler(
    
    
    filename=function() {
      
      VariableClasses <-  input$VariableClasses
      paste0("Table_",VariableClasses, "_Classes.csv")
    },
    content = function(file) {
      
      
      TableVarClasses <- TableVarClasses() 
      
      write.csv2(TableVarClasses, file, fileEncoding = "UTF-8", na = "", row.names = FALSE , dec=",")
    }
  )
  
  
  
  # output$PasDID <- renderUI ({
  #   checkboxInput("NoID", "Je n'ai pas d'identifiant" )
  # })
  
  
  
  
  # output$DLTableVar <- downloadHandler( 
  
  #    filename = function() {
  #     paste('TableVar_', Sys.Date(), '.csv', sep='')
  #  },
  #  content = function(con) {
  #    write.csv2(TableVar, con, na="")
  #  }
  #    )
  
  
  #   observeEvent(input$PasDID, {
  
  #   donnees_entree <- donnees_entree()
  #   write.csv2(donnees_entree, "Donnees_ACM.csv", na="", fileEncoding = "UTF-8")
  #   donnees_entree <- read.csv2("Donnees_ACM.csv", fileEncoding = "UTF-8")
  # })
  
  
  # output$downloadPlot <- downloadHandler(
  #  filename = "Shinyplot.png",
  # content = function(file) {
  #  png(file, width = 850, height = 500)
  # graphVar()
  #dev.off()
  # }) 
  
  # Noms des variables illustratives (REMONTER) :
  
  VarsIllusMeta <- reactive({
    #  if (is.null(input$VarIllusPourACM)) return (NULL)
    VarsIllus <- input$VarIllusPourACM
    TableACM <- TableACM()
    
    
    if (length(VarsIllus)==0){
      c<-""
    }else if (length(VarsIllus)==1){
      c<-VarsIllus[1]
    }else{
      
      c<- VarsIllus[1]
      for (i in 2:length(VarsIllus)) {
        c <- paste(c, VarsIllus[i], sep=", ")
      }
    }
    c
  })
  
  VarsIllusQuantiMeta <- reactive({
    #  if (is.null(input$VarIllusPourACM)) return (NULL)
    VarsIllusQuanti <- input$VarIllusQuantiPourACM
    
    if (length(VarsIllusQuanti)==0){
      c<-""
    }else if (length(VarsIllusQuanti)==1){
      c<-VarsIllusQuanti[1]
    }else{
      
      c<- VarsIllusQuanti[1]
      for (i in 2:length(VarsIllusQuanti)) {
        c <- paste(c, VarsIllusQuanti[i], sep=", ")
      }
    }
    c
  })
  
  # G/ Informations synthétiques sur les options de la session -------------
  #\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
  
  TableMeta <- reactive ({
    
    # Nom du fichier téléchargé :
    
    NomFichier <-  file_name()
    
    # Noms des variables conservées pour l'ACM :
    
    TableACM <- TableACM()
    NomVar <- names(TableACM[1])
    for (i in 2:ncol(TableACM)) {
      NomVar <-  paste(NomVar, names(TableACM[i]), sep=", ")
    }
    
    # Noms des variables illustratives :
    
    Illus <-  VarsIllusMeta()
    IllusQuanti <- VarsIllusQuantiMeta()
    
    # Filtres sur les individus :
    
    Variable1 <- input$Variable1
    Modalite1 <- input$Modalite1
    Operateur1 <- input$Operateur1
    OperateurMid <- input$OperateurMid
    Variable2 <- input$Variable2
    Modalite2 <- input$Modalite2
    Operateur2 <- input$Operateur2
    OperateurMid2 <- input$OperateurMid2
    Variable3 <- input$Variable3
    Modalite3 <- input$Modalite3
    Operateur3 <- input$Operateur3
    OperateurMid3 <- input$OperateurMid3
    Variable4 <- input$Variable4
    Modalite4 <- input$Modalite4
    Operateur4 <- input$Operateur4
    filtre <- paste(Variable1, Operateur1, Modalite1, OperateurMid,
                    Variable2, Operateur2, Modalite2, OperateurMid2,
                    Variable3, Operateur3, Modalite3,OperateurMid3,
                    Variable4, Operateur4, Modalite4,
                    sep=" ")
    Type.Cl <- input$Type.Cl
    Metric.Cl <- input$Metric.Cl
    Agreg.Cl <- input$Agreg.Cl
    NbAxes.Cl <- input$NbAxes.Cl
    Part.H.Cl <- input$Part.H.Cl
    NbreClasses <- input$NbreClasses
    VarClassesGraphe <- input$VarClassesGraphe
      
      
    # Tables synthétisant les informations métadonnées :
    
    TableMeta <- data.frame (Champs = c("Date et heure",
                                        "Nom du fichier",
                                        "Identifiant principal",
                                        "Identifiant graphique des individus",
                                        "Couleurs dans le graphe des individus",
                                        "Filtre(s) sur les individus",
                                        "Variables incluses dans l'ACM",
                                        "Dont variables illustratives qualitatives",
                                        "Dont variables illustratives quantitatives",
                                        "Type de classification",
                                        "Options sur la classification"), Valeurs = rep("", 11),
                             stringsAsFactors = F)
    
    TableMeta$Valeurs <- ifelse (TableMeta$Champs=="Date et heure",
                                 format(Sys.time(), "%d/%m/%Y, %H:%m"), TableMeta$Valeurs)
    
    TableMeta$Valeurs <- ifelse (TableMeta$Champs=="Nom du fichier",
                                 NomFichier, TableMeta$Valeurs)
    
    TableMeta$Valeurs <- ifelse (TableMeta$Champs=="Identifiant principal",
                                 input$ID, TableMeta$Valeurs)
    TableMeta$Valeurs <- ifelse (TableMeta$Champs=="Identifiant graphique des individus",
                                 input$LabelGraphInd, TableMeta$Valeurs)
    TableMeta$Valeurs <- ifelse (TableMeta$Champs=="Couleurs dans le graphe des individus",
                                 ifelse(VarClassesGraphe == " ",
                                        ifelse(NbreClasses == 1,
                                               "Aucune", 
                                               "Les classes"),
                                        VarClassesGraphe), 
                                 TableMeta$Valeurs)
    
    TableMeta$Valeurs <- ifelse (TableMeta$Champs=="Filtre(s) sur les individus",
                                 filtre, TableMeta$Valeurs)
    TableMeta$Valeurs <- ifelse (TableMeta$Champs=="Variables incluses dans l'ACM",
                                 NomVar, TableMeta$Valeurs)
    TableMeta$Valeurs <- ifelse (TableMeta$Champs=="Dont variables illustratives qualitatives",
                                 Illus, TableMeta$Valeurs)
    TableMeta$Valeurs <- ifelse (TableMeta$Champs=="Dont variables illustratives quantitatives",
                                 IllusQuanti, TableMeta$Valeurs)
    
    TableMeta$Valeurs <- ifelse (TableMeta$Champs=="Type de classification",
                                 Type.Cl, TableMeta$Valeurs)
    
    TableMeta$Valeurs <- ifelse (TableMeta$Champs=="Options sur la classification",
                                 ifelse(Type.Cl == "Pas de classification","-",
                                        paste0("Métrique ",
                                               Metric.Cl,
                                               ", agrégation ",
                                               Agreg.Cl,
                                               ", class. ",
                                               Part.H.Cl,", ", NbreClasses, " classes")), TableMeta$Valeurs)
    
    
    
    TableMeta
  })
  
  output$TableMeta <- renderTable ({
    
    TableMeta()
  })
  
  output$Resume <- renderTable({
    tmp <- donnees_entree()
    if (is.null(tmp)) {return (NULL)}else{
      
      donnees_entree <- data.frame( Variable = names(tmp[1]),
                                    Type = class(tmp[,1]),
                                    NbreValeursDiff = nrow(unique(tmp[1])))
      for (i in (2:ncol(tmp))) {
        donnees_entree <-rbind(donnees_entree, data.frame( Variable = names(tmp[i]),
                                                           Type = class(tmp[,i]),
                                                           NbreValeursDiff = nrow(unique(tmp[i]))))
      }
      donnees_entree
    }
  })
  
})
Grisoudre/ProdFacto documentation built on May 31, 2019, 10:44 p.m.