From 1df543badc32cef04456623986eecf7a33d3d938 Mon Sep 17 00:00:00 2001 From: aslane Date: Wed, 20 Mar 2024 14:01:27 +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 | 37 ++- app.R | 679 ++++++++++++++--------------------------------------- 2 files changed, 206 insertions(+), 510 deletions(-) diff --git a/Dockerfile b/Dockerfile index 4fbe2ae..c8b8a60 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,9 +1,5 @@ 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 \ @@ -16,14 +12,26 @@ RUN apt-get update \ 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 +RUN mkdir -p /srv/shiny + +RUN apt-get update + +RUN apt-get install -y cmake + +RUN apt-get install -y libssl-dev + +RUN apt-get install -y libharfbuzz-dev + +RUN apt-get install -y libfribidi-dev + +RUN apt-get install -y libxml2-dev + +RUN apt-get install -y libexpat1 + +RUN apt-get install -y libfontconfig1-dev # Copy the Shiny app to the container COPY app.R /srv/shiny/app.R @@ -35,9 +43,12 @@ 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 - +RUN R -e "install.packages('nloptr',dependencies=TRUE,repos='http://cran.rstudio.com')" +RUN R -e "install.packages('emmeans',dependencies=TRUE,repos='http://cran.rstudio.com')" +RUN R -e "install.packages('officer',dependencies=TRUE,repos='http://cran.rstudio.com')" +RUN R -e "install.packages(c('dplyr', 'shiny', 'readxl', 'remotes', 'httpuv', 'shinythemes', 'DT', 'ggplot2', 'gridExtra', 'emmeans'), repos = 'http://cran.rstudio.com/', method='wget',dependencies=TRUE)" +RUN R -e "install.packages(c('officer','car', 'markdown', 'plotly', 'factoextra', 'shinylogs', 'auth0', 'httr', 'shinyjs','urltools','openssl'), repos = 'http://cran.rstudio.com/', method='wget',dependencies=TRUE)" CMD ["R", "-e", "shiny::runApp('/srv/shiny', host='0.0.0.0', port=8080, launch.browser = FALSE)"] diff --git a/app.R b/app.R index 791cde4..68a8fc0 100644 --- a/app.R +++ b/app.R @@ -5,7 +5,7 @@ library(gridExtra) library(emmeans) library(readxl) library(dplyr) -library(officer) +library(carData) library(car) library(factoextra) library(shinylogs) @@ -15,8 +15,14 @@ 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") @@ -24,6 +30,41 @@ 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( @@ -46,7 +87,7 @@ ui <- fluidPage( ",functions="shinyjs.hideAllElements"), - theme = shinytheme("readable"), + #theme = shinytheme("readable"), navbarPage( "Stat Plateform", tabPanel("Accueil", @@ -56,6 +97,7 @@ ui <- fluidPage( 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"), ) @@ -69,18 +111,6 @@ ui <- fluidPage( ), ), 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, @@ -98,6 +128,8 @@ ui <- fluidPage( ) ), column(8, + tabsetPanel( + tabPanel('Table', wellPanel( style = 'overflow-x: scroll;height: 650px;', DT::dataTableOutput("anova_table"), @@ -110,6 +142,16 @@ ui <- fluidPage( 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') + ) + ) ) ) ), @@ -118,8 +160,8 @@ ui <- fluidPage( 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") + selectInput("var_explicatives_kw","Choisir la variable explicative",multiple = FALSE,choices = NULL), + actionButton("kw_button", "KW",class="btn-primary") ), ), column(8, @@ -128,18 +170,13 @@ ui <- fluidPage( DT::dataTableOutput("kw_table"), downloadButton("kw_button_download", "Télécharger le tableau",class="btn-primary") ), + wellPanel( + "KW Resultat", + verbatimTextOutput("kw_resultat") + ) ) ) ), - 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, @@ -156,22 +193,6 @@ ui <- fluidPage( ) ) ) - ), - 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", @@ -179,10 +200,12 @@ ui <- fluidPage( 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("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, @@ -223,13 +246,15 @@ ui <- fluidPage( 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( - plotlyOutput("pls_acp_graph°") + wellPanel( + h2('Résultats'), + verbatimTextOutput("pls_text"), ) ) ) @@ -243,7 +268,6 @@ server <- function(input, output, session) { track_usage( storage_mode = store_null() ) - observe({ if(is.null(session$userData$authorize)) { session$userData$authorize <- 0 @@ -253,7 +277,7 @@ server <- function(input, output, session) { 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", @@ -459,7 +483,7 @@ server <- function(input, output, session) { return(input$var_expliquees) }) - kw_explicative_col <- eventReactive(input$files,{ + kw_explicative_col <- eventReactive(input$kw_button,{ return(input$var_expliquees_kw) }) @@ -483,11 +507,11 @@ server <- function(input, output, session) { observe({ updateSelectInput(session,"dataset_graph", - choices = c("cars","airquality","iris","All data")) + choices = c("cars","airquality","iris",input$files$name)) }) - data <- eventReactive(input$dataset_graph,{ + graph_data <- eventReactive(input$dataset_graph,{ if (input$dataset_graph == 'cars') { return(datasets::cars) } @@ -497,68 +521,111 @@ server <- function(input, output, session) { if (input$dataset_graph == "iris"){ return(datasets::iris) } - if (input$dataset_graph == 'All data') { + if (input$dataset_graph == input$files$name) { 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") + 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 = ".") }) - observeEvent("graph_x",{ + 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 <- 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 <- 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 <- 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 <- 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 <- 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)) + 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 <- 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)) + 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(data(), aes_string(x=input$graph_x)) + - geom_density() + 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(data(), aes_string(x=input$graph_x)) + - geom_histogram() + 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(data(), aes_string(x=input$graph_x,color=input$graph_fill)) + - geom_histogram() + 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 <- 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)) + 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 <- 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))) - } + 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) } @@ -611,232 +678,6 @@ server <- function(input, output, session) { ) - 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({ @@ -851,6 +692,7 @@ server <- function(input, output, session) { anova_table[[col]] <- round(anova_table[[col]], 3) } } + output$anova_result <- renderPrint({return(Anova(mod))}) return(anova_table) }, error = function(e) { @@ -891,14 +733,13 @@ server <- function(input, output, session) { 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] + choices = unique(merged_data()[[col]]), + selected = unique(merged_data()[[col]])[1] ) } Temoins(temoins) @@ -967,6 +808,12 @@ server <- function(input, output, session) { 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]])) { @@ -1043,18 +890,20 @@ server <- function(input, output, session) { } ) - kw_table <- eventReactive(input$applyTypes,{ - cat_col <- input$cat_columns - num_col <- num_columns() + kw_table <- eventReactive(input$kw_button,{ + cat_col <- input$var_explicatives_kw + num_col <- input$var_expliquees_kw 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)) + 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') @@ -1069,8 +918,7 @@ server <- function(input, output, session) { colnames(kw_table) <-c("Column","Classe","Test","p-value") }) - } - } + return(kw_table) }) @@ -1084,180 +932,16 @@ server <- function(input, output, session) { ) - 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()) }) + 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] @@ -1277,24 +961,25 @@ server <- function(input, output, session) { }) - 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) + 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'}) + } }) }