library(shinythemes) library (DT) library(ggplot2) library(gridExtra) library(emmeans) library(readxl) library(dplyr) library(carData) library(car) library(factoextra) library(shinylogs) library(plotly) library(auth0) library(httr) library(shinyjs) library(openssl) library(urltools) library(openssl) library(pls) library(shinyBS) library(multcomp) options(shiny.port=8080) client_id <- Sys.getenv("CLIENT_ID") client_secret <- Sys.getenv("CLIENT_SECRET") uri_url <- Sys.getenv("URI_URL") authorize_url = Sys.getenv("AUTHORIZE_URL") token_url = Sys.getenv("TOKEN_URL") userinfo_url = Sys.getenv("USERINFO_URL") response_type <- 'code' random_bytes <- rand_bytes(16) random_state <- toupper(paste0(sprintf("%02x", as.integer(random_bytes)), collapse = "")) facet_formula = as.formula('.~.') comparisonGraph = function(emmeansObj, prefix="hypothèse", groupe=T){ letterComparison = cld(emmeansObj, Letters = LETTERS) var = colnames(letterComparison)[1:which(colnames(letterComparison)=="emmean")-1] letterComparison = letterComparison %>% arrange(desc(emmean)) nom_col = paste(var, collapse = "+") if (length(var) > 1){ letterComparison["var"] = apply(letterComparison[, var], 1, paste, collapse = "+") } else { letterComparison["var"] = letterComparison[var] } letterComparison$var = factor(letterComparison$var, levels = letterComparison$var, labels = letterComparison$var) # Crée le graphique ggplot g = ggplot(letterComparison, aes_string(y = "emmean", x = "var")) + geom_bar(stat = "identity") + xlab(nom_col) + ylab("Moyenne ajustée") + theme(axis.text.x = element_text(angle = 90)) if (groupe == T){ g = g + geom_text(aes(label = .group), position = position_stack(vjust = 0.5), col = "orange") } # Conversion du graphique ggplot en graphique Plotly graphique_comparaison = ggplotly(g) return(graphique_comparaison) } ui <- fluidPage( useShinyjs(), # Ici on empêche l'utilisateur de pouvoir rafraîchir la page accidentellement tags$script(' window.onbeforeunload = function() { return "Voulez-vous vraiment quitter cette page ?"; }; '), #theme = shinytheme("readable"), navbarPage( "Stat Plateform", tabPanel("Accueil", fluidRow( column(4, textOutput("welcome"), wellPanel( fileInput("files", "Sélectionnez les fichiers Excel (xlsx) :", multiple = TRUE), selectInput("ignore_columns", "Colonnes à ignorer :", multiple = TRUE, choices = NULL), bsTooltip("columnTypes","Choisir les types des colonnes",placement = "right",trigger = "hover"), uiOutput("columnTypes"), actionButton("applyTypes", "Appliquer les types de données"), ) ), column(8, wellPanel( style = 'overflow-x: scroll;height: 950px;', DT::dataTableOutput("merged_data_table") ) ) ), ), navbarMenu("Analyse", tabPanel("ANOVA", fluidRow( column(4, wellPanel( selectInput("var_expliquees","Choisir la variable à expliquer",multiple = FALSE,choices = NULL), selectInput("var_explicatives","Choisir les variables explicatives",multiple = TRUE,choices = NULL), actionButton("anova_button", "ANOVA",class="btn-primary") ), wellPanel( selectInput("emmeans_expliquees","Choisir la variable à expliquer",multiple = FALSE,choices = NULL), selectInput("emmeans_explicatives","Choisir les variables explicatives",multiple = TRUE,choices = NULL), uiOutput("Temoins"), selectInput("type_comp", "Type de comparaison", multiple = FALSE, choices = c("pairwise","trt.vs.ctrl")), actionButton("emmeans_button", "EMMEANS",class="btn-primary") ) ), column(8, tabsetPanel( tabPanel('Table', wellPanel( style = 'overflow-x: scroll;height: 650px;', DT::dataTableOutput("anova_table"), downloadButton("anova_button_download", "Télécharger le tableau",class="btn-primary") ), wellPanel( style = 'overflow-x: scroll;height: 650px;', DT::dataTableOutput("emmeans_table"), downloadButton("emmeans_button_download", "Télécharger le tableau",class="btn-primary"), DT::dataTableOutput("contrast_table"), downloadButton("contrast_button_download", "Télécharger le tableau",class="btn-primary") ) ), tabPanel("result", h2("Résultat Anova"), verbatimTextOutput("anova_result"), h2("Résultat Emmeans"), verbatimTextOutput("emmeans_result"), h2('Moyenne comparée'), plotlyOutput('graph_compared_mean') ) ) ) ) ), tabPanel("Test de Krustal-Wallis", fluidRow( column(4, wellPanel( selectInput("var_expliquees_kw","Choisir la variable à expliquer",multiple = FALSE,choices = NULL), selectInput("var_explicatives_kw","Choisir la variable explicative",multiple = FALSE,choices = NULL), actionButton("kw_button", "KW",class="btn-primary") ), ), column(8, wellPanel( style = 'overflow-x: scroll;height: 650px;', DT::dataTableOutput("kw_table"), downloadButton("kw_button_download", "Télécharger le tableau",class="btn-primary") ), wellPanel( "KW Resultat", verbatimTextOutput("kw_resultat") ) ) ) ), tabPanel("Khi 2", fluidRow( column(4, wellPanel( selectizeInput("khi2_cat","Choisir les variables",multiple = TRUE,choices = NULL), actionButton("khi2_button", "KHI2",class="btn-primary") ) ), column(8, wellPanel( style = 'overflow-x: scroll;height: 650px;', DT::dataTableOutput("khi2_table"), downloadButton("khi2_button_download", "Télécharger le tableau",class="btn-primary") ) ) ) ) ), tabPanel("Graphique", column(3, wellPanel( h2('Analyse Statistique'), selectInput("dataset_graph", "dataset_graph à prendre", multiple = FALSE, choices = c("cars","airquality","iris")), selectInput("type_graph", "Type de graphique", multiple = FALSE, choices = c("Barplot","Boxplot","Density plot","Geomline","Histograme","Scatterplot")), selectInput("graph_x", "X", multiple = FALSE, choices = NULL), selectInput("graph_y", "Y", multiple = FALSE, choices = NULL), selectInput("graph_fill", "Fill", multiple = FALSE, choices = NULL), selectInput("facet_a","Face grid",multiple = FALSE,choices = '.',), selectInput("facet_b","Face grid",multiple = FALSE,choices = '.',) ) ), column(9, fluidRow( wellPanel( plotlyOutput("graph_graph"), ) ) ) ), tabPanel("Instructions", fluidRow( column(8, includeMarkdown("README.md") ) ) ), navbarMenu("Régressions", tabPanel("ACP", column(3, wellPanel( h2('ACP'), selectInput("acp_col", "Numerical Columns", multiple = TRUE, choices = NULL), actionButton("acp_button", "ACP",class="btn-primary"), ), ), column(9, fluidRow( wellPanel( plotlyOutput("plotly_acp_graph") ) ) ) ), tabPanel("PLS", column(3, wellPanel( h2('PLS'), selectInput("pls_x", "X", multiple = TRUE, choices = NULL), selectInput("pls_y", "Y", multiple = FALSE, choices = NULL), sliderInput("pls_slider","Nombre de composante",1,1,1,step = 1), actionButton("pls_button", "PLS",class="btn-primary") ) ), column(9, fluidRow( wellPanel( h2('Résultats'), verbatimTextOutput("pls_text"), ) ) ) ), ), ) ) server <- function(input, output, session) { track_usage( storage_mode = store_null() ) observe({ if(is.null(session$userData$authorize)) { session$userData$authorize <- 0 } }) merged_data <- eventReactive(input$files, { # On lit la liste des fichiers et on les fusionne # Charger les données à partir des fichiers sélectionnés tables <- lapply(input$files$datapath, function(datapath) { # Vérifier l'extension du fichier if (tools::file_ext(datapath) %in% c("csv", "CSV")) { data <- read.csv(datapath) # Utilisez read.csv() pour les fichiers CSV } else if (tools::file_ext(datapath) %in% c("xlsx", "xls")) { data <- readxl::read_excel(datapath) # Utilisez read_excel() pour les fichiers Excel } else { stop("Type de fichier non pris en charge : ", tools::file_ext(datapath)) } print(data) filename <- input$files$name[input$files$datapath == datapath] filename <- substr(filename, 1, nchar(filename) - 4) # Supprimez l'extension du fichier data$Source <- filename # Ajoutez une colonne 'Source' avec le nom du fichier return(data) }) concatenated_table <- bind_rows(tables) #concatenated_table <- concatenated_table[,colSums(is.na(concatenated_table))==0] return(concatenated_table) }) columnTypes <- reactiveVal(list()) observe({ data <- merged_data() types <- list() for (col in setdiff(colnames(data),input$ignore_columns)) { column_class <- class(data[[col]]) # Utilisez class() pour obtenir la classe de la colonne default_choice <- switch( column_class, "Date" = "Date", "character" = "Character", "integer" = "Integer", "numeric" = "Numeric", "factor" = "Factor", "logical" = "Logical", "Date" # Par défaut, utilisez "Date" si la classe n'est pas reconnue ) types[[col]] <- selectInput( inputId = paste0("type_", col), label = col, choices = c("Date", "Character", "Numeric", "Factor", "Integer", "Logical"), selected = default_choice ) } columnTypes(types) }) output$columnTypes <- renderUI({ types <- columnTypes() if (!is.null(types) && length(types) > 0) { div( lapply(names(types), function(col) { types[[col]] }) ) } }) merged_data_type <- eventReactive(input$applyTypes, { data <- merged_data()[,setdiff(colnames(merged_data()),input$ignore_columns)] types <- columnTypes() if (!is.null(types) && length(types) > 0) { for (col in names(types)) { selectedType <- input[[paste0("type_", col)]] if (selectedType == "Date") { data[[col]] <- as.Date(data[[col]]) } else if (selectedType == "Character") { data[[col]] <- as.character(data[[col]]) } else if (selectedType == "Numeric") { data[[col]] <- as.numeric(data[[col]]) } else if (selectedType == "Factor") { data[[col]] <- as.factor(data[[col]]) } else if (selectedType == "Integer") { data[[col]] <- as.integer(data[[col]]) } else if (selectedType == "Logical") { data[[col]] <- as.logical(data[[col]]) } } output$merged_data_table <- renderDataTable(data, options = list( pageLength = 10, autoWidth = TRUE, lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) )) } return(data) }) #On sélectionne les colonnes à ignorer observe({ if (!is.null(merged_data())) { updateSelectInput(session, "ignore_columns", choices = colnames(merged_data()), selected = NULL) output$merged_data_table <- renderDataTable(merged_data()[,setdiff(colnames(merged_data()),input$ignore_columns)], options = list( pageLength = 10, autoWidth = TRUE, lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) )) } }) #On sélectionne les colonnes numériques observe({ updateSelectInput(session, "var_expliquees", choices = colnames( merged_data_type() %>% select_if(function(x) is.numeric(x) || is.integer(x)))) updateSelectInput(session, "var_explicatives", choices = colnames( merged_data_type() %>% select_if(function(x) is.factor(x)))) updateSelectInput(session, "emmeans_expliquees", choices = colnames( merged_data_type() %>% select_if(function(x) is.numeric(x) || is.integer(x)))) updateSelectInput(session, "emmeans_explicatives", choices = colnames( merged_data_type() %>% select_if(function(x) is.factor(x)))) updateSelectInput(session, "var_expliquees_kw", choices = colnames( merged_data_type() %>% select_if(function(x) is.numeric(x) || is.integer(x)))) updateSelectInput(session, "var_explicatives_kw", choices = colnames( merged_data_type() %>% select_if(function(x) is.factor(x)))) updateSelectInput(session, "khi2_cat", choices = colnames( merged_data_type() %>% select_if(function(x) is.factor(x)))) updateSelectInput(session, "khi2_num", choices = colnames( merged_data_type() %>% select_if(function(x) is.numeric(x) || is.integer(x)))) }) #On utilise une fonction permettant d'obternir la liste des variables numériques num_columns <- eventReactive(input$applyTypes,{ numeric_integer_columns <- colnames( merged_data_type() %>% select_if(function(x) is.numeric(x) || is.integer(x))) return(numeric_integer_columns) }) #On utilise une fonction permettant d'obternir la liste des variables cat cat_col <- eventReactive(input$applyTypes,{ return(factor_columns <- sapply(merged_data(), is.factor)) }) #On utilise une fonction permettant d'obternir la liste des variables columns <- eventReactive(input$applyTypes,{ a <- colnames(merged_data()) a <- setdiff(a,input$ignore_columns) return(a) }) explicative_col <- eventReactive(input$files,{ return(input$var_expliquees) }) kw_explicative_col <- eventReactive(input$kw_button,{ return(input$var_expliquees_kw) }) #On utilise une fonction permettant d'obtenir la liste des différentes sources liste_source <- eventReactive(input$cat_id,{ return(unique(merged_data()[[input$cat_id]])) }) # Afficher les résultats de la fusion dans une table output$merged_data_table <- renderDataTable(merged_data(), options = list( pageLength = 10, autoWidth = TRUE, lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) ) ) #============================================================================= #Cette partie gère la partie "Graphiques" observe({ updateSelectInput(session,"dataset_graph", choices = c("cars","airquality","iris",input$files$name)) }) graph_data <- eventReactive(input$dataset_graph,{ if (input$dataset_graph == 'cars') { return(datasets::cars) } if (input$dataset_graph == "airquality"){ return(datasets::airquality) } if (input$dataset_graph == "iris"){ return(datasets::iris) } if (input$dataset_graph == input$files$name) { return(merged_data_type()) } }) observe({ updateSelectInput(session,"graph_x", choices = colnames(graph_data())) updateSelectInput(session,"graph_y", choice = colnames(graph_data())) updateSelectInput(session,"graph_fill", choices = c("None",colnames(graph_data())),selected = "None") updateSelectInput(session,"facet_a", choices = c(".",colnames(graph_data())),selected = ".") updateSelectInput(session,"facet_b", choices = c(".",colnames(graph_data())),selected = ".") }) observe({ facet_formula = as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)) print(facet_formula) }) observe({ output$graph_graph <- renderPlotly({ if (input$type_graph == 'Barplot'){ if (input$graph_fill == 'None'){ p <- ggplot(data = graph_data(),aes(x=!!sym(input$graph_x),y=!!sym(input$graph_y))) + geom_bar(stat="identity") + facet_grid(as.formula(paste0(input$facet_a, ' ~ ', input$facet_b))) + labs(x = input$graph_x, y = input$graph_y) #p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),type='bar') #p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y)) p <- ggplotly(p) } else { p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y), fill = !!sym(input$graph_fill))) + geom_bar(stat = "identity") + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) + labs(x = input$graph_x, y = input$graph_y) #p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),color=~get(input$graph_fill),type='bar') #p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y)) p <- ggplotly(p) } return(p) } if (input$type_graph == 'Geomline'){ if (input$graph_fill == 'None'){ p <- ggplot(data = graph_data(),aes(x=!!sym(input$graph_x),y=!!sym(input$graph_y))) + stat_summary(fun = "mean", geom = "line") + facet_grid(as.formula(paste0(input$facet_a, ' ~ ', input$facet_b))) + labs(x = input$graph_x, y = input$graph_y) #p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),type='bar') #p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y)) p <- ggplotly(p) } else { p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y), colour=!!sym(input$graph_fill))) + stat_summary(fun = "mean", geom = "line",aes(group=!!sym(input$graph_fill))) + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) + labs(x = input$graph_x, y = input$graph_y) #p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),color=~get(input$graph_fill),type='bar') #p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y)) p <- ggplotly(p) } return(p) } if (input$type_graph == 'Boxplot'){ if (input$graph_fill == 'None'){ p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y))) + geom_boxplot() + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) + labs(x = input$graph_x, y = input$graph_y) p <- ggplotly(p) } else { p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y), fill = !!sym(input$graph_fill))) + geom_boxplot() + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) + labs(x = input$graph_x, y = input$graph_y) } return(p) } if (input$type_graph == 'Density plot'){ p <- ggplot(graph_data(), aes_string(x=input$graph_x)) + geom_density() + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) return(ggplotly(p)) } if (input$type_graph == 'Histograme'){ if (input$graph_fill == 'None') { p <- ggplot(graph_data(), aes_string(x=input$graph_x)) + geom_histogram() + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) } else { p <- ggplot(graph_data(), aes_string(x=input$graph_x,color=input$graph_fill)) + geom_histogram() + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) } return(ggplotly(p)) } if (input$type_graph == 'Scatterplot'){ if (input$graph_fill == 'None') { p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y))) + geom_point() + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) + labs(x = input$graph_x, y = input$graph_y) p <- ggplotly(p) } else { p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y), fill = !!sym(input$graph_fill))) + geom_point() + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) + labs(x = input$graph_x, y = input$graph_y) } return(p) } }) }) #============================================================================= #Cette partie gère l'analyse des données shapiro_table <- eventReactive(input$files,{ num_col <- num_columns() shapiro <- data.frame() merged_data <- merged_data() for (col in num_col){ tryCatch({ a <- shapiro.test(as.numeric(merged_data[[col]])) shapiro <- rbind(shapiro,c(col,"","Shapiro",a$p.value)) colnames(shapiro) <- c("Column","Classe","Test","p-value") }, error=function(e) { print(co) message('An Error Occurred') cat("Erreur :", conditionMessage(e), "\n") traceback() }, warning=function(w) { message('A Warning Occured') print(w) return(NA) }) } return(shapiro) }) output$shapiro_table <- renderDataTable(shapiro_table(), options = list( pageLength = 10, autoWidth = TRUE, lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) ) ) anova_table <- eventReactive(input$anova_button,{ tryCatch({ merged_data <- merged_data_type() var_expliquee <- input$var_expliquees var_explicatives <- input$var_explicatives form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*"))) mod = lm(as.formula(form),data=merged_data) anova_table <- as.data.frame(Anova(mod)) for (col in names(anova_table)) { if (is.numeric(anova_table[[col]])) { anova_table[[col]] <- round(anova_table[[col]], 3) } } output$anova_result <- renderPrint({return(Anova(mod))}) return(anova_table) }, error = function(e) { message('An Error Occurred') cat("Erreur :", conditionMessage(e), "\n") traceback() return(NULL) }, warning = function(w) { message('A Warning Occured') print(w) formula <- formula(paste(num_column, "~", cat)) a <- leveneTest(formula, data = merged_data) return(a) }) }) output$anova_table <- renderDataTable(anova_table(), extensions = "Buttons", options = list( pageLength = 10, autoWidth = TRUE, lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) ) ) output$anova_button_download <- downloadHandler( filename = function(){"anova_results.csv"}, content = function(fname){ write.csv(anova_table(), fname) } ) Temoins <- reactiveVal(list()) observe({ temoins <- list() for (col in input$emmeans_explicatives) { temoins[[col]] <- selectInput( inputId = paste0("temoin_", col), label = col, choices = unique(merged_data()[[col]]), selected = unique(merged_data()[[col]])[1] ) } Temoins(temoins) }) output$Temoins <- renderUI({ temoins <- Temoins() if (!is.null(temoins) && length(temoins) > 0) { div( lapply(names(temoins), function(col) { temoins[[col]] }) ) } }) ref_index <- eventReactive(input$emmeans_button,{ tryCatch({ merged_data <- merged_data_type() var_expliquee <- input$emmeans_expliquees var_explicatives <- input$emmeans_explicatives t = "" for (col in names(Temoins())) { t <- paste(t,input[[paste0("temoin_", col)]],collapse = " ") } print(t) t <- substr(t,2,nchar(t)) form1 = as.formula(paste0("~",paste(var_explicatives,collapse = "*"))) form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*"))) mod = lm(form,data=merged_data) emm <- emmeans(mod,form1) row_concat <- apply(emm@grid[,-ncol(emm@grid)], 1, function(row) { paste(row, collapse = " ") }) ind <- which(row_concat == t) return(ind) }, error = function(e) { message('An Error Occurred') cat("Erreur :", conditionMessage(e), "\n") traceback() return(NULL) }, warning = function(w) { message('A Warning Occured') print(w) formula <- formula(paste(num_column, "~", cat)) a <- leveneTest(formula, data = merged_data) return(a) }) }) emmeans_table <- eventReactive(input$emmeans_button,{ merged_data <- merged_data_type() var_expliquee <- input$emmeans_expliquees var_explicatives <- input$emmeans_explicatives type_comp <- input$type_comp print(type_comp) if (type_comp == 'trt.vs.ctrl') { form1 = as.formula(paste0("trt.vs.ctrl~",paste(var_explicatives,collapse = "*"))) } else { form1 = as.formula(paste0("pairwise~",paste(var_explicatives,collapse = "*"))) } form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*"))) mod = lm(as.formula(form),data=merged_data) output$emmeans_result <- renderPrint({ return(emmeans(mod,form1)) }) output$graph_compared_mean <- renderPlotly({ return(comparisonGraph(emmeansObj = emmeans(mod,form1))) }) emmeans_table <- as.data.frame(emmeans(mod,form1)$emmeans) for (col in names(emmeans_table)) { if (is.numeric(emmeans_table[[col]])) { emmeans_table[[col]] <- round(emmeans_table[[col]], 3) } } emmeans_table <- na.omit(emmeans_table) return(emmeans_table) }) contrasts_table <- eventReactive(input$emmeans_button,{ merged_data <- merged_data_type() var_expliquee <- input$emmeans_expliquees var_explicatives <- input$emmeans_explicatives type_comp <- input$type_comp form1 = as.formula(paste0("~",paste(var_explicatives,collapse = "*"))) form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*"))) mod = lm(form,data=merged_data) print(form) print(form1) emm <- emmeans(mod,form1) print(as.data.frame(ref_grid(mod)@grid)) contr <- contrast(emm,type_comp,ref=ref_index()) emmeans_table <- as.data.frame(contr) for (col in names(emmeans_table)) { if (is.numeric(emmeans_table[[col]])) { emmeans_table[[col]] <- round(emmeans_table[[col]], 3) } } emmeans_table <- na.omit(emmeans_table) return(emmeans_table) }) output$emmeans_table <- renderDataTable(datatable(emmeans_table(), options = list( pageLength = 10, autoWidth = TRUE, lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) ), caption = "Moyennes ajustées", ) ) output$emmeans_button_download <- downloadHandler( filename = function(){"emmeans_results.csv"}, content = function(fname){ write.csv(emmeans_table(), fname,row.names = FALSE) } ) output$contrast_table <- renderDataTable(datatable(contrasts_table(), options = list( pageLength = 10, autoWidth = TRUE, lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) ), caption = "Contrasts", ) ) output$contrast_button_download <- downloadHandler( filename = function(){"contrast_results.csv"}, content = function(fname){ write.csv(contrasts_table(), fname,row.names = FALSE) } ) kw_table <- eventReactive(input$kw_button,{ cat_col <- input$var_explicatives_kw num_col <- input$var_expliquees_kw kw_table = data.frame() tryCatch({ krustal_formule <- as.formula(paste0(num_col,'~',cat_col)) print(krustal_formule) kruskal_test <- kruskal.test(krustal_formule,data=merged_data()) kw_table <- rbind(kw_table,c(num_col,cat_col,"KW",kruskal_test$p.value)) colnames(kw_table) <-c("Column","Classe","Test","p-value") output$kw_resultat <- renderPrint({ return(kruskal_test) }) }, error=function(e) { message('An Error Occurred') cat("Erreur :", conditionMessage(e), "\n") traceback() }, warning=function(w) { message('A Warning Occured') print(w) kruskal_test <- kruskal.test(merged_data()[[col]]~interaction(merged_data()[[cat]], merged_data()[[cat_id()]])) kw_table <- rbind(kw_table,c(col,cat,"KW",kruskal_test$p.value)) colnames(kw_table) <-c("Column","Classe","Test","p-value") }) return(kw_table) }) output$kw_table <- renderDataTable(kw_table(), options = list( pageLength = 10, autoWidth = TRUE, lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) ) ) #============================================================================= #Cette partie gère la partie "Modèles classiques" observe({ updateSelectInput(session, "acp_col", choices = num_columns()) }) observe({ updateSliderInput(session,"pls_slider",max = length(input$pls_x)) }) observeEvent(input$acp_button,{ output$plotly_acp_graph <- renderPlotly({ acp_data <- merged_data()[, input$acp_col] res.pca <- prcomp(acp_data, scale = TRUE) pl <- fviz_pca_ind( res.pca, col.ind = merged_data()[["Source"]], # Color by the quality of representation repel = TRUE, # Avoid text overlapping label = "None" ) + scale_color_discrete() # Convertir le graphique ggplot2 en graphique plotly pl <- ggplotly(pl) return(pl) }) }) observe({ updateSelectInput(session, "pls_x", choices = num_columns()) updateSelectInput(session, "pls_y", choices = num_columns()) }) observeEvent(input$pls_button,{ output$pls_text <- renderPrint({ pls_formula <- as.formula(paste0(input$pls_y,'~',paste(input$pls_x,collapse='*'))) pls.result <- plsr(pls_formula,data=merged_data_type(),scale=TRUE, validation="CV") pls_sum <- summary(pls.result) return(pls_sum) }) }) #output$pls_text <- renderText({'print'}) } shinyApp(ui, server)