From 587f6857b7aaff604ecea8d40944bd359e8139c1 Mon Sep 17 00:00:00 2001 From: aslane Date: Mon, 4 Mar 2024 07:26:25 +0000 Subject: [PATCH] =?UTF-8?q?T=C3=A9l=C3=A9verser=20les=20fichiers=20vers=20?= =?UTF-8?q?"/"?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Dockerfile | 82 +- _auth0.yml | 7 + app.R | 2494 +++++++++++++++++++++++++++------------------------- 3 files changed, 1351 insertions(+), 1232 deletions(-) create mode 100644 _auth0.yml diff --git a/Dockerfile b/Dockerfile index 25c99b6..4fbe2ae 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,39 +1,43 @@ -FROM rocker/r-ver - -RUN groupadd shiny && useradd -r -m shiny -g shiny - -RUN apt-get update \ - && apt-get install -y --no-install-recommends \ - pandoc \ - pandoc-citeproc \ - libcurl4-gnutls-dev \ - libcairo2-dev \ - libxt-dev \ - xtail \ - libssl-dev \ - libicu-dev \ - wget - -RUN R -e "install.packages(c('dplyr', 'shiny', 'readxl','remotes','httpuv','shinythemes','DT','ggplot2','gridExtra','emmeans','officer'), repos = 'https://cran.rstudio.com/', method='wget')" -RUN R -e 'install.packages("factoextra")' -RUN R -e 'install.packages("officer")' -RUN R -e 'install.packages("car")' -RUN R -e 'install.packages("markdown")' -RUN R -e 'install.packages("plotly")' -RUN R -e 'install.packages("shinylogs")' - -RUN mkdir -p /srv/shiny && \ - chown shiny:shiny /srv/shiny - -COPY app.R /srv/shiny/app.R -COPY README.md /srv/shiny/README.md -COPY arbre1.png /srv/shiny/arbre1.png -COPY arbre2.png /srv/shiny/arbre2.png - -EXPOSE 8080 - -USER shiny - - - -CMD ["R", "-e", "shiny::runApp('/srv/shiny', host='0.0.0.0', port=8080, launch.browser = F)"] +FROM rocker/r-ver + +# Create a new group and user for Shiny +RUN groupadd shiny && useradd -r -m shiny -g shiny + +# Install system dependencies +RUN apt-get update \ + && apt-get install -y --no-install-recommends \ + pandoc \ + pandoc-citeproc \ + libcurl4-gnutls-dev \ + libcairo2-dev \ + libxt-dev \ + xtail \ + libssl-dev \ + libicu-dev \ + wget + +# Install R packages +RUN R -e 'install.packages("remotes")' +RUN R -e "install.packages(c('dplyr', 'shiny', 'readxl', 'remotes', 'httpuv', 'shinythemes', 'DT', 'ggplot2', 'gridExtra', 'emmeans', 'officer', 'car', 'markdown', 'plotly', 'factoextra', 'shinylogs', 'auth0', 'httr', 'shinyjs'), repos = 'https://cran.rstudio.com/', method='wget')" +RUN R -e 'install_dev("shiny")' + +# Create a directory for your Shiny app +RUN mkdir -p /srv/shiny && \ + chown shiny:shiny /srv/shiny + +# Copy the Shiny app to the container +COPY app.R /srv/shiny/app.R +COPY README.md /srv/shiny/README.md +COPY arbre1.png /srv/shiny/arbre1.png +COPY arbre2.png /srv/shiny/arbre2.png +COPY .Renviron /srv/shiny/.Renviron + +# Expose the port Shiny app runs on +EXPOSE 8080 + +# Use the created shiny user +USER shiny + +# Command to run the Shiny app + +CMD ["R", "-e", "shiny::runApp('/srv/shiny', host='0.0.0.0', port=8080, launch.browser = FALSE)"] diff --git a/_auth0.yml b/_auth0.yml new file mode 100644 index 0000000..a4ca16e --- /dev/null +++ b/_auth0.yml @@ -0,0 +1,7 @@ +name: Stat_Plateform +remote_url: '' +auth0_config: + api_url: !expr paste0('https://', Sys.getenv("AUTH0_USER"), '.okta.com/oauth2/default/v1') + credentials: + key: !expr Sys.getenv("AUTH0_KEY") + secret: !expr Sys.getenv("AUTH0_SECRET") diff --git a/app.R b/app.R index a320e38..791cde4 100644 --- a/app.R +++ b/app.R @@ -1,1194 +1,1302 @@ -library(shinythemes) -library (DT) -library(ggplot2) -library(gridExtra) -library(emmeans) -library(readxl) -library(dplyr) -library(officer) -library(car) -library(factoextra) -library(shinylogs) -library(plotly) - - -ui <- fluidPage( - theme = shinytheme("readable"), - navbarPage( - "Stat Plateform", - tabPanel("Accueil", - fluidRow( - column(4, - wellPanel( - fileInput("files", "Sélectionnez les fichiers Excel (xlsx) :", multiple = TRUE), - selectInput("ignore_columns", "Colonnes à ignorer :", multiple = TRUE, choices = NULL), - 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("Test de Shapiro", - DT::dataTableOutput("shapiro_table") - ), - tabPanel("Test de Student", - DT::dataTableOutput("student_table") - ), - tabPanel("Test de Welch", - DT::dataTableOutput("welch_table") - ), - tabPanel("Test de Wilcoxon", - DT::dataTableOutput("wilcoxon_table") - ), - 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, - 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("Test de Krustal-Wallis", - DT::dataTableOutput("kw_table") - ), - tabPanel("Test de Fisher", - DT::dataTableOutput("fisher_table") - ), - tabPanel("Test de Levene", - DT::dataTableOutput("levene_table") - ), - tabPanel("Test de Barlett", - DT::dataTableOutput("barlett_table") - ), - 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("Tous les tests", - DT::dataTableOutput("test_table") - ), - tabPanel("Rapport", - h3("Résultats des tests statistiques"), - fluidRow( - column(2, - fluidRow( - wellPanel( - h3("Télécharger le rapport :"), - downloadButton("downloadWord", "Download Word Document",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","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), - ) - ), - 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), - actionButton("pls_button", "PLS",class="btn-primary") - ) - ), - column(9, - fluidRow( - wellPanel( - plotlyOutput("pls_acp_graph°") - ) - ) - ) - ), - - ), - - - ) -) - - -server <- function(input, output, session) { - track_usage( - storage_mode = store_null() - ) - - - - # Partie permettant de fusionner les fichiers - 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, "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) - }) - - #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","All data")) - }) - - - 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 == 'All data') { - return(merged_data_type()) - } - }) - - observe({ - updateSelectInput(session,"graph_x", choices = colnames(data())) - updateSelectInput(session,"graph_y", choice = colnames(data())) - updateSelectInput(session,"graph_fill", choices = c("None",colnames(data())),selected = "None") - - }) - - - observeEvent("graph_x",{ - output$graph_graph <- renderPlotly({ - - if (input$type_graph == 'Barplot'){ - if (input$graph_fill == 'None'){ - 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)) - } else { - 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)) - } - - return(p) - } - if (input$type_graph == 'Boxplot'){ - if (input$graph_fill == 'None'){ - p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),type='box') - p <- p %>% layout(boxmode = "group", xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y)) - } else { - p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),color=~get(input$graph_fill),type='box') - p <- p %>% layout(boxmode = "group", xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y),coloraxis=list(title=input$graph_fill)) - } - - return(p) - } - if (input$type_graph == 'Density plot'){ - p <- ggplot(data(), aes_string(x=input$graph_x)) + - geom_density() - return(ggplotly(p)) - } - if (input$type_graph == 'Histograme'){ - if (input$graph_fill == 'None') { - p <- ggplot(data(), aes_string(x=input$graph_x)) + - geom_histogram() - } else { - p <- ggplot(data(), aes_string(x=input$graph_x,color=input$graph_fill)) + - geom_histogram() - } - - return(ggplotly(p)) - } - if (input$type_graph == 'Scatterplot'){ - if (input$graph_fill == 'None') { - p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),type='scatter') - p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y)) - } else { - p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),color=~get(input$graph_fill),type='scatter') - p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y),legend=list(title=list(text=input$graph_fill))) - } - - 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")) - ) - ) - - - student_table <- eventReactive(input$files,{ - num_col <- num_columns() - cat_col <- input$cat_columns - merged_data <- merged_data() - student_table <- data.frame() - cat_id <- input$cat_id - for (cat in cat_col) { - for (clas in unique(merged_data()[[cat]])){ - for (col in num_col) { - tryCatch({ - x = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[1]),], !!sym(cat) == clas)[,col]) - y = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[2]),], !!sym(cat) == clas)[,col]) - if (length(x) >0 & length(y) > 0){ - a = c(t.test(x,y)) - student_table <- rbind(student_table,c(col,paste(cat,'-',clas),"Student",a$p.value)) - colnames(student_table) <- c("Column","Classe","Test","p-value") - } - }, - error=function(e) { - message('An Error Occurred') - cat("Erreur :", conditionMessage(e), "\n") - traceback() - }, - warning=function(w) { - message('A Warning Occured') - print(w) - return(NA) - }) - } - } - } - return(student_table) - }) - - output$student_table <- renderDataTable(student_table(), - options = list( - pageLength = 10, - autoWidth = TRUE, - lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) - ) - ) - - welch_table <- eventReactive(input$files,{ - num_col <- num_columns() - cat_col <- input$cat_columns - merged_data <- merged_data() - welch_table <- data.frame() - cat_id <- input$cat_id - - for (cat in cat_col) { - for (clas in unique(merged_data()[[cat]])){ - for (col in num_col) { - tryCatch({ - x = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[1]),], !!sym(cat) == clas)[,col]) - y = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[2]),], !!sym(cat) == clas)[,col]) - if (length(x) >0 & length(y) > 0){ - a = c(t.test(x,y,var.equal=FALSE)) - welch_table <- rbind(welch_table,c(col,paste(cat,'-',clas),"Welch",a$p.value)) - colnames(welch_table) <- c("Column","Classe","Test","p-value") - } - }, - error=function(e) { - message('An Error Occurred') - cat("Erreur :", conditionMessage(e), "\n") - traceback() - }, - warning=function(w) { - message('A Warning Occured') - print(w) - return(NA) - }) - } - } - } - return(welch_table) - }) - - output$welch_table <- renderDataTable(welch_table(), - options = list( - pageLength = 10, - autoWidth = TRUE, - lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) - ) - ) - - - wilcoxon_table <- eventReactive(input$files,{ - num_col <- num_columns() - cat_col <- input$cat_columns - merged_data <- merged_data() - wilcoxon_table <- data.frame() - cat_id <- input$cat_id - - for (cat in cat_col) { - for (clas in unique(merged_data()[[cat]])){ - for (col in num_col) { - tryCatch({ - x = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[1]),], !!sym(cat) == clas)[,col]) - y = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[2]),], !!sym(cat) == clas)[,col]) - if (length(x) >0 & length(y) > 0){ - a = c(wilcox.test(x,y)) - wilcoxon_table <- rbind(wilcoxon_table,c(col,paste(cat,'-',clas),"Wilcoxon",a$p.value)) - colnames(wilcoxon_table) <- c("Column","Classe","Test","p-value") - } - }, - error=function(e) { - message('An Error Occurred') - cat("Erreur :", conditionMessage(e), "\n") - traceback() - }, - warning=function(w) { - message('A Warning Occured') - print(w) - return(NA) - }) - } - } - } - return(wilcoxon_table) - }) - - output$wilcoxon_table <- renderDataTable(wilcoxon_table(), - options = list( - pageLength = 10, - autoWidth = TRUE, - lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) - ) - ) - - - fisher_table <- eventReactive(input$files,{ - num_col <- num_columns() - cat_col <- input$cat_columns - merged_data <- merged_data() - fisher_table <- data.frame() - cat_id <- input$cat_id - - for (cat in cat_col) { - for (clas in unique(merged_data()[[cat]])){ - for (col in num_col) { - tryCatch({ - x = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[1]),], !!sym(cat) == clas)[,col]) - y = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[2]),], !!sym(cat) == clas)[,col]) - if (length(x) >0 & length(y) > 0){ - a = c(var.test(x,y)) - fisher_table <- rbind(fisher_table,c(col,paste(cat,'-',clas),"Fisher",a$p.value)) - colnames(fisher_table) <- c("Column","Classe","Test","p-value") - } - }, - error=function(e) { - message('An Error Occurred') - cat("Erreur :", conditionMessage(e), "\n") - traceback() - }, - warning=function(w) { - message('A Warning Occured') - print(w) - return(NA) - }) - } - } - } - return(fisher_table) - }) - - output$fisher_table <- renderDataTable(fisher_table(), - options = list( - pageLength = 10, - autoWidth = TRUE, - lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) - ) - ) - - - - levene_table <- eventReactive(input$files, { - num_col <- num_columns() - cat_col <- input$cat_columns - merged_data <- merged_data() - levene_table <- data.frame() - cat_id <- input$cat_id - - for (cat in cat_col) { - for (num_column in num_col) { - levene_result <- tryCatch({ - formula <- formula(paste(num_column, "~", cat)) - a <- leveneTest(formula, data = merged_data) - return(a) - }, - 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) - }) - - if (!is.null(levene_result)) { - levene_result["Column"] = num_column - levene_result["Catégorie"] = cat - levene_result["Test"] = "Levene" - levene_table <- rbind(levene_table, levene_result) - - } - } - } - rownames(levene_table) <- c(1:nrow(levene_table)) - return(levene_table) - }) - - - output$levene_table <- renderDataTable(levene_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) - } - } - 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({ - data <- merged_data() - temoins <- list() - for (col in input$emmeans_explicatives) { - temoins[[col]] <- selectInput( - inputId = paste0("temoin_", col), - label = col, - choices = unique(data[[col]]), - selected = unique(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) - 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$applyTypes,{ - cat_col <- input$cat_columns - num_col <- num_columns() - kw_table = data.frame() - cat_id <- input$cat_id - - for (cat in cat_col) { - for (col in num_col) { - tryCatch({ - 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") - }, - 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")) - ) - ) - - - khi2_table <- eventReactive(input$khi2_button,{ - cat_col <- input$khi2_cat - num_col <- input$khi2_num - khi2_table = data.frame() - merged_data <- merged_data() - for (i in 1:(length(cat_col)-1)) { - for (j in (i+1):length(cat_col)) { - table_croisee <- table(merged_data[[cat_col[[i]]]],merged_data[[cat_col[[j]]]]) - a <- chisq.test(table_croisee) - khi2_table <- rbind(khi2_table,c(cat_col[i],cat_col[j],"Khi 2",a$p.value)) - } - } - - colnames(khi2_table) <- c("Column","Classe","Test","p-value") - return(khi2_table) - }) - - output$khi2_table <- renderDataTable(khi2_table(), - options = list( - pageLength = 10, - autoWidth = TRUE, - lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) - ) - ) - - output$khi2_button_download <- downloadHandler( - filename = function(){"khi2_results.csv"}, - content = function(fname){ - write.csv(khi2_table(), fname,row.names = FALSE) - } - ) - - - test_table <- eventReactive(input$files,{ - test_table <- data.frame() - test_table <- rbind(shapiro_table(),student_table(),welch_table(),wilcoxon_table(),fisher_table()) - return(test_table) - }) - - output$test_table <- renderDataTable(test_table(), - options = list( - pageLength = 10, - autoWidth = TRUE, - lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) - ) - ) - - - - #On gère ici la partie contrasts du test d'emmeans - contrasts_result <- eventReactive(input$applyTypes, { - cat_col <- input$cat_columns - num_col <- num_columns() - result_contrasts <- data.frame() - cat_id <- input$cat_id - - merged_data <- convertToFactor(merged_data(), cat_col) - for (cat in cat_col) { - num_levels <- nlevels(merged_data[[cat]]) - if (num_levels <= 1) { - warning(paste("The factor", cat, "has only", num_levels, "level(s) and cannot be contrasted.")) - } else { - for (col in num_col) { - formula <- formula(paste(col, "~", cat, "*Source")) - model <- lm(formula, data = na.omit(merged_data)) - post_hoc <- emmeans(model, pairwise ~ Source, by = cat) - result_contrasts <- append(result_contrasts, post_hoc$contrasts) - } - } - } - - return(result_contrasts) - }) - - - #On gère ici l'autre partie du test d'emmeans - emmeans_result <- eventReactive(input$applyTypes,{ - cat_col <- input$cat_columns - num_col <- num_columns() - result_emmeans = data.frame() - merged_data <- convertToFactor(merged_data(), cat_col) - cat_id <- input$cat_id - - for (cat in cat_col) { - num_levels <- nlevels(merged_data[[cat]]) - if (num_levels <= 1) { - warning(paste("The factor", cat, "has only", num_levels, "level(s) and cannot be contrasted.")) - } else { - for (col in num_col) { - formula <- formula(paste(col, "~", cat, "*Source")) - model <- lm(formula, data = na.omit(merged_data)) - post_hoc <- emmeans(model, pairwise~Source, by=cat) - result_emmeans <- append(result_emmeans,post_hoc$emmeans) - } - } - } - - return(result_emmeans) - - }) - - #Cette partie permet de générer le .docx contenant le rapport - output$downloadWord <- downloadHandler( - filename = function() { - paste("stat_rapport.docx", sep = "") - }, - content = function(file) { - - cat_col <- input$cat_columns - num_col <- num_columns() - result <- test_table() - result_anova <- anova_table() - result_kw <- kw_table() - result_contrasts <- contrasts_result() - result_emmeans <- emmeans_result() - - - # Créer un document Word - doc <- read_docx() - - # Ajouter un titre - doc <- body_add_par(doc,"Analysis Report", style="heading 1") - - - for (c in unique(result$Column)){ - - # Ajouter un sous-titre - msg <- paste("Column analysis :",c) - doc <- body_add_par(doc,msg, style="heading 2") - - for (test in unique(result[result$Column==c,"Test"])){ - msg_test <- paste("Test :",test) - doc <- body_add_par(doc,msg_test, style="heading 3") - doc <-body_add_table(doc,result[result$Column==c&result$Test == test,]) - } - - } - - doc <- body_add_break(doc, pos = "after") - doc <- body_add_par(doc,"ANOVA result",style="heading 2") - for (i in 1:7) { - doc <- body_add_par(doc,num_col[i],style="heading 3") - doc <- body_add_table(doc,as.data.frame(result_anova[result_anova$Col==num_col[i],])) - doc <- body_add_par(doc," ") - doc <- body_add_par(doc," ") - } - - doc <- body_add_break(doc, pos = "after") - doc <- body_add_par(doc,"Emmeans result",style="heading 2") - for (i in 1:7) { - doc <- body_add_par(doc,c,style="heading 3") - doc <- body_add_table(doc,as.data.frame(result_emmeans[i])) - doc <- body_add_par(doc," ") - doc <- body_add_par(doc," ") - } - - doc <- body_add_break(doc, pos = "after") - doc <- body_add_par(doc,"KW Result",style="heading 2") - doc <- body_add_table(doc,as.data.frame(result_kw)) - - # Écrire le document Word dans un fichier - print(doc, target = file) - } - ) - - #============================================================================= - #Cette partie gère la partie "Modèles classiques" - observe({ - updateSelectInput(session, "acp_col", choices = num_columns()) - updateSelectInput(session, "pls_x", choices = num_columns()) - updateSelectInput(session, "pls_y", choices = num_columns()) - }) - - 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) - }) - - }) - - observeEvent(input$pls_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) - }) - - }) - -} - +library(shinythemes) +library (DT) +library(ggplot2) +library(gridExtra) +library(emmeans) +library(readxl) +library(dplyr) +library(officer) +library(car) +library(factoextra) +library(shinylogs) +library(plotly) +library(auth0) +library(httr) +library(shinyjs) +library(openssl) +library(urltools) + + +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' + + +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), + 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("Test de Shapiro", + DT::dataTableOutput("shapiro_table") + ), + tabPanel("Test de Student", + DT::dataTableOutput("student_table") + ), + tabPanel("Test de Welch", + DT::dataTableOutput("welch_table") + ), + tabPanel("Test de Wilcoxon", + DT::dataTableOutput("wilcoxon_table") + ), + 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, + 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("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 les variables explicatives",multiple = TRUE,choices = NULL), + actionButton("kw_button", "ANOVA",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") + ), + ) + ) + ), + tabPanel("Test de Fisher", + DT::dataTableOutput("fisher_table") + ), + tabPanel("Test de Levene", + DT::dataTableOutput("levene_table") + ), + tabPanel("Test de Barlett", + DT::dataTableOutput("barlett_table") + ), + 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("Tous les tests", + DT::dataTableOutput("test_table") + ), + tabPanel("Rapport", + h3("Résultats des tests statistiques"), + fluidRow( + column(2, + fluidRow( + wellPanel( + h3("Télécharger le rapport :"), + downloadButton("downloadWord", "Download Word Document",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","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), + ) + ), + 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), + actionButton("pls_button", "PLS",class="btn-primary") + ) + ), + column(9, + fluidRow( + wellPanel( + plotlyOutput("pls_acp_graph°") + ) + ) + ) + ), + ), + ) + ) + + +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_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$files,{ + 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","All data")) + }) + + + 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 == 'All data') { + return(merged_data_type()) + } + }) + + observe({ + updateSelectInput(session,"graph_x", choices = colnames(data())) + updateSelectInput(session,"graph_y", choice = colnames(data())) + updateSelectInput(session,"graph_fill", choices = c("None",colnames(data())),selected = "None") + + }) + + + observeEvent("graph_x",{ + output$graph_graph <- renderPlotly({ + + if (input$type_graph == 'Barplot'){ + if (input$graph_fill == 'None'){ + 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)) + } else { + 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)) + } + + return(p) + } + if (input$type_graph == 'Boxplot'){ + if (input$graph_fill == 'None'){ + p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),type='box') + p <- p %>% layout(boxmode = "group", xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y)) + } else { + p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),color=~get(input$graph_fill),type='box') + p <- p %>% layout(boxmode = "group", xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y),coloraxis=list(title=input$graph_fill)) + } + + return(p) + } + if (input$type_graph == 'Density plot'){ + p <- ggplot(data(), aes_string(x=input$graph_x)) + + geom_density() + return(ggplotly(p)) + } + if (input$type_graph == 'Histograme'){ + if (input$graph_fill == 'None') { + p <- ggplot(data(), aes_string(x=input$graph_x)) + + geom_histogram() + } else { + p <- ggplot(data(), aes_string(x=input$graph_x,color=input$graph_fill)) + + geom_histogram() + } + + return(ggplotly(p)) + } + if (input$type_graph == 'Scatterplot'){ + if (input$graph_fill == 'None') { + p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),type='scatter') + p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y)) + } else { + p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),color=~get(input$graph_fill),type='scatter') + p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y),legend=list(title=list(text=input$graph_fill))) + } + + 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")) + ) + ) + + + student_table <- eventReactive(input$files,{ + num_col <- num_columns() + cat_col <- input$cat_columns + merged_data <- merged_data() + student_table <- data.frame() + cat_id <- input$cat_id + for (cat in cat_col) { + for (clas in unique(merged_data()[[cat]])){ + for (col in num_col) { + tryCatch({ + x = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[1]),], !!sym(cat) == clas)[,col]) + y = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[2]),], !!sym(cat) == clas)[,col]) + if (length(x) >0 & length(y) > 0){ + a = c(t.test(x,y)) + student_table <- rbind(student_table,c(col,paste(cat,'-',clas),"Student",a$p.value)) + colnames(student_table) <- c("Column","Classe","Test","p-value") + } + }, + error=function(e) { + message('An Error Occurred') + cat("Erreur :", conditionMessage(e), "\n") + traceback() + }, + warning=function(w) { + message('A Warning Occured') + print(w) + return(NA) + }) + } + } + } + return(student_table) + }) + + output$student_table <- renderDataTable(student_table(), + options = list( + pageLength = 10, + autoWidth = TRUE, + lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) + ) + ) + + welch_table <- eventReactive(input$files,{ + num_col <- num_columns() + cat_col <- input$cat_columns + merged_data <- merged_data() + welch_table <- data.frame() + cat_id <- input$cat_id + + for (cat in cat_col) { + for (clas in unique(merged_data()[[cat]])){ + for (col in num_col) { + tryCatch({ + x = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[1]),], !!sym(cat) == clas)[,col]) + y = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[2]),], !!sym(cat) == clas)[,col]) + if (length(x) >0 & length(y) > 0){ + a = c(t.test(x,y,var.equal=FALSE)) + welch_table <- rbind(welch_table,c(col,paste(cat,'-',clas),"Welch",a$p.value)) + colnames(welch_table) <- c("Column","Classe","Test","p-value") + } + }, + error=function(e) { + message('An Error Occurred') + cat("Erreur :", conditionMessage(e), "\n") + traceback() + }, + warning=function(w) { + message('A Warning Occured') + print(w) + return(NA) + }) + } + } + } + return(welch_table) + }) + + output$welch_table <- renderDataTable(welch_table(), + options = list( + pageLength = 10, + autoWidth = TRUE, + lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) + ) + ) + + + wilcoxon_table <- eventReactive(input$files,{ + num_col <- num_columns() + cat_col <- input$cat_columns + merged_data <- merged_data() + wilcoxon_table <- data.frame() + cat_id <- input$cat_id + + for (cat in cat_col) { + for (clas in unique(merged_data()[[cat]])){ + for (col in num_col) { + tryCatch({ + x = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[1]),], !!sym(cat) == clas)[,col]) + y = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[2]),], !!sym(cat) == clas)[,col]) + if (length(x) >0 & length(y) > 0){ + a = c(wilcox.test(x,y)) + wilcoxon_table <- rbind(wilcoxon_table,c(col,paste(cat,'-',clas),"Wilcoxon",a$p.value)) + colnames(wilcoxon_table) <- c("Column","Classe","Test","p-value") + } + }, + error=function(e) { + message('An Error Occurred') + cat("Erreur :", conditionMessage(e), "\n") + traceback() + }, + warning=function(w) { + message('A Warning Occured') + print(w) + return(NA) + }) + } + } + } + return(wilcoxon_table) + }) + + output$wilcoxon_table <- renderDataTable(wilcoxon_table(), + options = list( + pageLength = 10, + autoWidth = TRUE, + lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) + ) + ) + + + fisher_table <- eventReactive(input$files,{ + num_col <- num_columns() + cat_col <- input$cat_columns + merged_data <- merged_data() + fisher_table <- data.frame() + cat_id <- input$cat_id + + for (cat in cat_col) { + for (clas in unique(merged_data()[[cat]])){ + for (col in num_col) { + tryCatch({ + x = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[1]),], !!sym(cat) == clas)[,col]) + y = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[2]),], !!sym(cat) == clas)[,col]) + if (length(x) >0 & length(y) > 0){ + a = c(var.test(x,y)) + fisher_table <- rbind(fisher_table,c(col,paste(cat,'-',clas),"Fisher",a$p.value)) + colnames(fisher_table) <- c("Column","Classe","Test","p-value") + } + }, + error=function(e) { + message('An Error Occurred') + cat("Erreur :", conditionMessage(e), "\n") + traceback() + }, + warning=function(w) { + message('A Warning Occured') + print(w) + return(NA) + }) + } + } + } + return(fisher_table) + }) + + output$fisher_table <- renderDataTable(fisher_table(), + options = list( + pageLength = 10, + autoWidth = TRUE, + lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) + ) + ) + + + + levene_table <- eventReactive(input$files, { + num_col <- num_columns() + cat_col <- input$cat_columns + merged_data <- merged_data() + levene_table <- data.frame() + cat_id <- input$cat_id + + for (cat in cat_col) { + for (num_column in num_col) { + levene_result <- tryCatch({ + formula <- formula(paste(num_column, "~", cat)) + a <- leveneTest(formula, data = merged_data) + return(a) + }, + 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) + }) + + if (!is.null(levene_result)) { + levene_result["Column"] = num_column + levene_result["Catégorie"] = cat + levene_result["Test"] = "Levene" + levene_table <- rbind(levene_table, levene_result) + + } + } + } + rownames(levene_table) <- c(1:nrow(levene_table)) + return(levene_table) + }) + + + output$levene_table <- renderDataTable(levene_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) + } + } + 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({ + data <- merged_data() + temoins <- list() + for (col in input$emmeans_explicatives) { + temoins[[col]] <- selectInput( + inputId = paste0("temoin_", col), + label = col, + choices = unique(data[[col]]), + selected = unique(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) + 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$applyTypes,{ + cat_col <- input$cat_columns + num_col <- num_columns() + kw_table = data.frame() + cat_id <- input$cat_id + + for (cat in cat_col) { + for (col in num_col) { + tryCatch({ + 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") + }, + 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")) + ) + ) + + + khi2_table <- eventReactive(input$khi2_button,{ + cat_col <- input$khi2_cat + num_col <- input$khi2_num + khi2_table = data.frame() + merged_data <- merged_data() + for (i in 1:(length(cat_col)-1)) { + for (j in (i+1):length(cat_col)) { + table_croisee <- table(merged_data[[cat_col[[i]]]],merged_data[[cat_col[[j]]]]) + a <- chisq.test(table_croisee) + khi2_table <- rbind(khi2_table,c(cat_col[i],cat_col[j],"Khi 2",a$p.value)) + } + } + + colnames(khi2_table) <- c("Column","Classe","Test","p-value") + return(khi2_table) + }) + + output$khi2_table <- renderDataTable(khi2_table(), + options = list( + pageLength = 10, + autoWidth = TRUE, + lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) + ) + ) + + output$khi2_button_download <- downloadHandler( + filename = function(){"khi2_results.csv"}, + content = function(fname){ + write.csv(khi2_table(), fname,row.names = FALSE) + } + ) + + + test_table <- eventReactive(input$files,{ + test_table <- data.frame() + test_table <- rbind(shapiro_table(),student_table(),welch_table(),wilcoxon_table(),fisher_table()) + return(test_table) + }) + + output$test_table <- renderDataTable( + test_table(), + options = list( + pageLength = 10, + autoWidth = TRUE, + lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All")) + ) + ) + + + + #On gère ici la partie contrasts du test d'emmeans + contrasts_result <- eventReactive(input$applyTypes, { + cat_col <- input$cat_columns + num_col <- num_columns() + result_contrasts <- data.frame() + cat_id <- input$cat_id + + merged_data <- convertToFactor(merged_data(), cat_col) + for (cat in cat_col) { + num_levels <- nlevels(merged_data[[cat]]) + if (num_levels <= 1) { + warning(paste("The factor", cat, "has only", num_levels, "level(s) and cannot be contrasted.")) + } else { + for (col in num_col) { + formula <- formula(paste(col, "~", cat, "*Source")) + model <- lm(formula, data = na.omit(merged_data)) + post_hoc <- emmeans(model, pairwise ~ Source, by = cat) + result_contrasts <- append(result_contrasts, post_hoc$contrasts) + } + } + } + + return(result_contrasts) + }) + + + #On gère ici l'autre partie du test d'emmeans + emmeans_result <- eventReactive(input$applyTypes,{ + cat_col <- input$cat_columns + num_col <- num_columns() + result_emmeans = data.frame() + merged_data <- convertToFactor(merged_data(), cat_col) + cat_id <- input$cat_id + + for (cat in cat_col) { + num_levels <- nlevels(merged_data[[cat]]) + if (num_levels <= 1) { + warning(paste("The factor", cat, "has only", num_levels, "level(s) and cannot be contrasted.")) + } else { + for (col in num_col) { + formula <- formula(paste(col, "~", cat, "*Source")) + model <- lm(formula, data = na.omit(merged_data)) + post_hoc <- emmeans(model, pairwise~Source, by=cat) + result_emmeans <- append(result_emmeans,post_hoc$emmeans) + } + } + } + + return(result_emmeans) + + }) + + #Cette partie permet de générer le .docx contenant le rapport + output$downloadWord <- downloadHandler( + filename = function() { + paste("stat_rapport.docx", sep = "") + }, + content = function(file) { + + cat_col <- input$cat_columns + num_col <- num_columns() + result <- test_table() + result_anova <- anova_table() + result_kw <- kw_table() + result_contrasts <- contrasts_result() + result_emmeans <- emmeans_result() + + + # Créer un document Word + doc <- read_docx() + + # Ajouter un titre + doc <- body_add_par(doc,"Analysis Report", style="heading 1") + + + for (c in unique(result$Column)){ + + # Ajouter un sous-titre + msg <- paste("Column analysis :",c) + doc <- body_add_par(doc,msg, style="heading 2") + + for (test in unique(result[result$Column==c,"Test"])){ + msg_test <- paste("Test :",test) + doc <- body_add_par(doc,msg_test, style="heading 3") + doc <-body_add_table(doc,result[result$Column==c&result$Test == test,]) + } + + } + + doc <- body_add_break(doc, pos = "after") + doc <- body_add_par(doc,"ANOVA result",style="heading 2") + for (i in 1:7) { + doc <- body_add_par(doc,num_col[i],style="heading 3") + doc <- body_add_table(doc,as.data.frame(result_anova[result_anova$Col==num_col[i],])) + doc <- body_add_par(doc," ") + doc <- body_add_par(doc," ") + } + + doc <- body_add_break(doc, pos = "after") + doc <- body_add_par(doc,"Emmeans result",style="heading 2") + for (i in 1:7) { + doc <- body_add_par(doc,c,style="heading 3") + doc <- body_add_table(doc,as.data.frame(result_emmeans[i])) + doc <- body_add_par(doc," ") + doc <- body_add_par(doc," ") + } + + doc <- body_add_break(doc, pos = "after") + doc <- body_add_par(doc,"KW Result",style="heading 2") + doc <- body_add_table(doc,as.data.frame(result_kw)) + + # Écrire le document Word dans un fichier + print(doc, target = file) + } + ) + + #============================================================================= + #Cette partie gère la partie "Modèles classiques" + observe({ + updateSelectInput(session, "acp_col", choices = num_columns()) + updateSelectInput(session, "pls_x", choices = num_columns()) + updateSelectInput(session, "pls_y", choices = num_columns()) + }) + + 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) + }) + + }) + + observeEvent(input$pls_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) + }) + + }) + } + }) + } + shinyApp(ui, server) \ No newline at end of file