Actualiser app.R
This commit is contained in:
parent
8229e4628c
commit
5e9f071a7f
160
app.R
160
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_y","Choisir une autre variable",multiple = FALSE,choices = NULL),
|
||||
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"),
|
||||
verbatimTextOutput("khi2_result")
|
||||
#downloadButton("khi2_button_download", "Télécharger le tableau",class="btn-primary")
|
||||
style = 'overflow-x: scroll;height: 650px;',
|
||||
DT::dataTableOutput("khi2_table"),
|
||||
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,6 +291,24 @@ 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"),
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
),
|
||||
)
|
||||
)
|
||||
|
|
@ -245,15 +318,10 @@ 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,9 +1009,26 @@ 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'})
|
||||
|
||||
|
||||
})
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue