Actualiser app.R

app.R

@@ -69,9 +69,27 @@ comparisonGraph = function(emmeansObj, prefix="hypothèse", groupe=T){
 
 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(
-    "StatPlat",
+    "Stat Plateform",
     tabPanel("Accueil",
              fluidRow(
                column(4,
@@ -163,21 +181,51 @@ ui <- fluidPage(
                         fluidRow(
                           column(4,
                                  wellPanel(
-              selectizeInput("khi2_x","Choisir une variable",multiple = FALSE,choices = NULL),
+                                   selectizeInput("khi2_cat","Choisir les variables",multiple = TRUE,choices = NULL),
-              selectizeInput("khi2_y","Choisir une autre variable",multiple = FALSE,choices = NULL),
                                    actionButton("khi2_button", "KHI2",class="btn-primary")
                                  )
                           ),
                           column(8,
                                  wellPanel(
-              #style = 'overflow-x: scroll;height: 650px;',
+                                   style = 'overflow-x: scroll;height: 650px;',
-              #DT::dataTableOutput("khi2_table"),
+                                   DT::dataTableOutput("khi2_table"),
-              verbatimTextOutput("khi2_result")
+                                   downloadButton("khi2_button_download", "Télécharger le tableau",class="btn-primary")
-              #downloadButton("khi2_button_download", "Télécharger le tableau",class="btn-primary")
                                  )
                           )
                         )
+               ), 
+              tabPanel("Test de Pearson",
+                       fluidRow(
+                         column(4,
+                                wellPanel(
+                                  selectizeInput("pearson_num","Choisir la variable quantitative",multiple = FALSE,choices = NULL),
+                                  selectizeInput("pearson_cat","Choisir la variable catégorielle",multiple = FALSE,choices = NULL),
+                                  actionButton("pearson_button", "Pearson",class="btn-primary")
+                                ),
+                        ),
+                          column(8,
+                                 wellPanel("Pearson Resultat",
+                                   verbatimTextOutput("pearson_result")
                                  )
+                        )
+                      )
+            ),
+            tabPanel("Test de Wilcoxon",
+                     fluidRow(
+                       column(4,
+                              wellPanel(
+                                selectizeInput("wilcox_num","Choisir la variable quantitative",multiple = FALSE,choices = NULL),
+                                selectizeInput("wilcox_cat","Choisir la variable catégorielle",multiple = FALSE,choices = NULL),
+                                actionButton("wilcox_button", "Wilcoxon",class="btn-primary")
+                              ),
+                       ),
+                       column(8,
+                              wellPanel("Wilcoxon Resultat",
+                                        verbatimTextOutput("wilcox_result")
+                              )
+                       )
+                     )
+            ),
     ),
     tabPanel("Graphique",
              column(3,
@@ -200,6 +248,13 @@ ui <- fluidPage(
                     )
              )
     ),
+    tabPanel("Instructions", 
+             fluidRow(
+               column(8,
+                      includeMarkdown("README.md")
+               )
+             )
+    ), 
     navbarMenu("Régressions",
                tabPanel("ACP",
                         column(3,
@@ -236,24 +291,37 @@ ui <- fluidPage(
                                )
                         )
                ),
+               tabPanel("Linéaire",
+                        column(6,
+                               wellPanel(
+                                 h2('Régression Linéaire'),
+                                 selectInput("lm_x", "X", multiple = FALSE, choices = NULL),
+                                 selectInput("lm_y", "Y", multiple = TRUE, choices = NULL),
+                                 actionButton("lm_button", "Régression",class="btn-primary")
+                               )
+                        ), 
+                        column(6,
+                               fluidRow(
+                                 wellPanel( 
+                                   h2('Résultats'),
+                                   verbatimTextOutput("lm_text"),
+                                 )
+                               )
+                        )
+               ),
     ),
   )
-  )
+)
 
 
 server <- function(input, output, session) {
   track_usage(
     storage_mode = store_null()
   )
-  observe({
-    if(is.null(session$userData$authorize)) {
-      session$userData$authorize <- 0
-    }
-  })
-  
 
   # Partie permettant de fusionner les fichiers
   observe({
+
       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
@@ -276,6 +344,7 @@ server <- function(input, output, session) {
         
         
         concatenated_table <- bind_rows(tables)
+        concatenated_table <- na.omit(concatenated_table)
         #concatenated_table <- concatenated_table[,colSums(is.na(concatenated_table))==0]
         return(concatenated_table)
       })
@@ -383,9 +452,17 @@ server <- function(input, output, session) {
                           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_x", 
+        updateSelectInput(session, "khi2_cat", 
                           choices = colnames( merged_data_type() %>% select_if(function(x) is.factor(x))))
-      updateSelectInput(session, "khi2_y", 
+        updateSelectInput(session, "khi2_num", 
+                          choices = colnames( merged_data_type() %>% select_if(function(x) is.numeric(x) || is.integer(x))))
+        updateSelectInput(session, "pearson_num", 
+                          choices = colnames( merged_data_type() %>% select_if(function(x) is.numeric(x) || is.integer(x))))
+        updateSelectInput(session, "pearson_cat", 
+                          choices = colnames( merged_data_type() %>% select_if(function(x) is.factor(x))))
+        updateSelectInput(session, "wilcox_num", 
+                          choices = colnames( merged_data_type() %>% select_if(function(x) is.numeric(x) || is.integer(x))))
+        updateSelectInput(session, "wilcox_cat", 
                           choices = colnames( merged_data_type() %>% select_if(function(x) is.factor(x))))
       })
       
@@ -608,17 +685,6 @@ server <- function(input, output, session) {
       )
       
       
-    khi2_table_calc <- eventReactive(input$khi2_button,{
-      x <- input$khi2_x
-      y <- input$khi2_y
-      merged_data <- merged_data_type()
-      khi2_table <- table(merged_data[,x],merged_data[,y])
-      res <- chisq.test(khi2_table)
-      return(res)
-    })
-    
-    output$khi2_result <- renderPrint(khi2_table_calc())
-    
       
       anova_table <- eventReactive(input$anova_button,{
         tryCatch({
@@ -873,6 +939,31 @@ server <- function(input, output, session) {
       )
       
       
+      
+     pearson_result <- eventReactive(input$pearson_button,{
+        X_level = unique(merged_data()[[input$pearson_cat]])[1]
+        Y_level = unique(merged_data()[[input$pearson_cat]])[2]
+        X = merged_data()[merged_data()[,input$pearson_cat]==X_level,input$pearson_num]
+        Y = merged_data()[merged_data()[,input$pearson_cat]==Y_level,input$pearson_num]
+        x = pull(X,1)
+        y = pull(Y,1)
+        print(cor.test(x,y, method = "pearson"))
+        })
+      
+     output$pearson_result <- renderPrint(pearson_result())
+     
+     
+     wilcox_result <- eventReactive(input$wilcox_button,{
+       X_level = unique(merged_data()[[input$wilcox_cat]])[1]
+       Y_level = unique(merged_data()[[input$wilcox_cat]])[2]
+       X = merged_data()[merged_data()[,input$wilcox_cat]==X_level,input$wilcox_num]
+       Y = merged_data()[merged_data()[,input$wilcox_cat]==Y_level,input$wilcox_num]
+       x = pull(X,1)
+       y = pull(Y,1)
+       print(wilcox.test(x,y, paired=TRUE))
+     })
+     
+     output$wilcox_result <- renderPrint(wilcox_result())
       #=============================================================================
       #Cette partie gère la partie "Modèles classiques"
       observe({
@@ -918,10 +1009,27 @@ server <- function(input, output, session) {
         
       })
       
+      observe({
+        updateSelectInput(session, "lm_x", choices = num_columns())
+        updateSelectInput(session, "lm_y", choices = colnames( merged_data_type() %>% select_if(function(x) is.factor(x))))
+      })
+      
+      
+      observeEvent(input$lm_button,{
+        output$lm_text <-  renderPrint({
+          merged_data <- merged_data_type()
+          lm_formula <- as.formula(paste0(input$lm_x,'~',paste(input$lm_y,collapse='*')))
+          lm_result <- lm(lm_formula,data = merged_data)
+          return(summary(lm_result))
+        })
+        
+      })
+      
       
       #output$pls_text <-  renderText({'print'})
       
+    
   })
-  }
+}
 
 shinyApp(ui, server)