From 10edac89983a7b846685c2b26d79dfafbf50fdb4 Mon Sep 17 00:00:00 2001 From: aslane Date: Wed, 20 Mar 2024 14:08:41 +0000 Subject: [PATCH] Actualiser app.R --- app.R | 1921 ++++++++++++++++++++++++++++----------------------------- 1 file changed, 935 insertions(+), 986 deletions(-) diff --git a/app.R b/app.R index 68a8fc0..8340eca 100644 --- a/app.R +++ b/app.R @@ -1,987 +1,936 @@ -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 ?"; - }; - '), - - -# Ici on a créé une fonction permettant de masquer tous les éléments de la page - extendShinyjs(text = " - shinyjs.hideAllElements = function() { - $('body > *').hide(); - } - ",functions="shinyjs.hideAllElements"), - - - #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 - } - }) - - observe({ - # Vérifier si aucun paramètre n'est présent dans l'URL - if (!grepl("^[?&].*", session$clientData$url_search)) { - random_bytes <- rand_bytes(16) - random_state <- toupper(paste0(sprintf("%02x", as.integer(random_bytes)), collapse = "")) - scope <- "openid profile" - auth_url <- sprintf("%s?client_id=%s&scope=%s&redirect_uri=%s&response_type=%s&state=%s", - authorize_url,client_id, scope, URLencode(uri_url), response_type, random_state) - jscommand <- sprintf("window.location.href ='%s';",auth_url) - print(jscommand) - runjs(jscommand) - - } else if (grepl("\\bcode\\b", session$clientData$url_search)) { - - - authorization = base64enc::base64encode(charToRaw(paste0(client_id,":",client_secret))) - authorization = paste("Basic",authorization) - code=param_get(session$clientData$url_search,'code')[[1]] - body = list( - 'grant_type' = 'authorization_code', - 'redirect_uri' = 'http://localhost:8080', - 'code' = code, - 'state' = random_state - ) - headers = c( - 'Accept' = 'application/json', - 'Content-Type' = 'application/x-www-form-urlencoded', - 'Authorization' = authorization - ) - res <- VERB("POST", url = "https://pcis.okta.com/oauth2/default/v1/token", body = body, add_headers(headers), encode = 'form') - if (res$status_code == 200){ - res_content <- content(res,"parsed",encoding = "UTF-8") - headers2 = c("Authorization" = paste("Bearer",res_content$access_token)) - res2 <- VERB("GET",url="https://pcis.okta.com/oauth2/default/v1/userinfo",add_headers(headers2)) - print(res2) - name = content(res2, "parsed", encoding = "UTF-8")$name - output$welcome <- renderText({paste("Bonjour",name)}) - session$userData$authorize = 1 - } else { - print('Vous n avez pas l autorisation') - } - - } - }) - # Partie permettant de fusionner les fichiers - observe({ - if (session$userData$authorize == 0) { - shinyjs::runjs("shinyjs.hideAllElements();") - } - if (session$userData$authorize == 1) { - 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'}) - - } - }) - } - +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 + } + }) + + + # Partie permettant de fusionner les fichiers + observe({ + if (session$userData$authorize == 0) { + shinyjs::runjs("shinyjs.hideAllElements();") + } + if (session$userData$authorize == 1) { + 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) \ No newline at end of file