1035 lines
43 KiB
R
1035 lines
43 KiB
R
library(shinythemes)
|
|
library (DT)
|
|
library(ggplot2)
|
|
library(gridExtra)
|
|
library(emmeans)
|
|
library(readxl)
|
|
library(dplyr)
|
|
library(carData)
|
|
library(car)
|
|
library(factoextra)
|
|
library(shinylogs)
|
|
library(plotly)
|
|
library(auth0)
|
|
library(httr)
|
|
library(shinyjs)
|
|
library(openssl)
|
|
library(urltools)
|
|
library(openssl)
|
|
library(pls)
|
|
library(shinyBS)
|
|
library(multcomp)
|
|
|
|
|
|
|
|
options(shiny.port=8080)
|
|
client_id <- Sys.getenv("CLIENT_ID")
|
|
client_secret <- Sys.getenv("CLIENT_SECRET")
|
|
uri_url <- Sys.getenv("URI_URL")
|
|
authorize_url = Sys.getenv("AUTHORIZE_URL")
|
|
token_url = Sys.getenv("TOKEN_URL")
|
|
userinfo_url = Sys.getenv("USERINFO_URL")
|
|
response_type <- 'code'
|
|
random_bytes <- rand_bytes(16)
|
|
random_state <- toupper(paste0(sprintf("%02x", as.integer(random_bytes)), collapse = ""))
|
|
facet_formula = as.formula('.~.')
|
|
|
|
|
|
comparisonGraph = function(emmeansObj, prefix="hypothèse", groupe=T){
|
|
letterComparison = cld(emmeansObj, Letters = LETTERS)
|
|
var = colnames(letterComparison)[1:which(colnames(letterComparison)=="emmean")-1]
|
|
letterComparison = letterComparison %>% arrange(desc(emmean))
|
|
nom_col = paste(var, collapse = "+")
|
|
|
|
if (length(var) > 1){
|
|
letterComparison["var"] = apply(letterComparison[, var], 1, paste, collapse = "+")
|
|
} else {
|
|
letterComparison["var"] = letterComparison[var]
|
|
}
|
|
|
|
letterComparison$var = factor(letterComparison$var, levels = letterComparison$var, labels = letterComparison$var)
|
|
|
|
# Crée le graphique ggplot
|
|
g = ggplot(letterComparison, aes_string(y = "emmean", x = "var")) +
|
|
geom_bar(stat = "identity") +
|
|
xlab(nom_col) + ylab("Moyenne ajustée") +
|
|
theme(axis.text.x = element_text(angle = 90))
|
|
|
|
if (groupe == T){
|
|
g = g + geom_text(aes(label = .group), position = position_stack(vjust = 0.5), col = "orange")
|
|
}
|
|
|
|
# Conversion du graphique ggplot en graphique Plotly
|
|
graphique_comparaison = ggplotly(g)
|
|
|
|
return(graphique_comparaison)
|
|
}
|
|
|
|
|
|
|
|
ui <- fluidPage(
|
|
useShinyjs(),
|
|
|
|
|
|
# Ici on empêche l'utilisateur de pouvoir rafraîchir la page accidentellement
|
|
tags$script('
|
|
window.onbeforeunload = function() {
|
|
return "Voulez-vous vraiment quitter cette page ?";
|
|
};
|
|
'),
|
|
|
|
|
|
# Ici on a créé une fonction permettant de masquer tous les éléments de la page
|
|
extendShinyjs(text = "
|
|
shinyjs.hideAllElements = function() {
|
|
$('body > *').hide();
|
|
}
|
|
",functions="shinyjs.hideAllElements"),
|
|
|
|
|
|
#theme = shinytheme("readable"),
|
|
navbarPage(
|
|
"Stat Plateform",
|
|
tabPanel("Accueil",
|
|
fluidRow(
|
|
column(4,
|
|
textOutput("welcome"),
|
|
wellPanel(
|
|
fileInput("files", "Sélectionnez les fichiers Excel (xlsx) :", multiple = TRUE),
|
|
selectInput("ignore_columns", "Colonnes à ignorer :", multiple = TRUE, choices = NULL),
|
|
bsTooltip("columnTypes","Choisir les types des colonnes",placement = "right",trigger = "hover"),
|
|
uiOutput("columnTypes"),
|
|
actionButton("applyTypes", "Appliquer les types de données"),
|
|
)
|
|
),
|
|
column(8,
|
|
wellPanel(
|
|
style = 'overflow-x: scroll;height: 950px;',
|
|
DT::dataTableOutput("merged_data_table")
|
|
)
|
|
)
|
|
),
|
|
),
|
|
navbarMenu("Analyse",
|
|
tabPanel("ANOVA",
|
|
fluidRow(
|
|
column(4,
|
|
wellPanel(
|
|
selectInput("var_expliquees","Choisir la variable à expliquer",multiple = FALSE,choices = NULL),
|
|
selectInput("var_explicatives","Choisir les variables explicatives",multiple = TRUE,choices = NULL),
|
|
actionButton("anova_button", "ANOVA",class="btn-primary")
|
|
),
|
|
wellPanel(
|
|
selectInput("emmeans_expliquees","Choisir la variable à expliquer",multiple = FALSE,choices = NULL),
|
|
selectInput("emmeans_explicatives","Choisir les variables explicatives",multiple = TRUE,choices = NULL),
|
|
uiOutput("Temoins"),
|
|
selectInput("type_comp", "Type de comparaison", multiple = FALSE, choices = c("pairwise","trt.vs.ctrl")),
|
|
actionButton("emmeans_button", "EMMEANS",class="btn-primary")
|
|
)
|
|
),
|
|
column(8,
|
|
tabsetPanel(
|
|
tabPanel('Table',
|
|
wellPanel(
|
|
style = 'overflow-x: scroll;height: 650px;',
|
|
DT::dataTableOutput("anova_table"),
|
|
downloadButton("anova_button_download", "Télécharger le tableau",class="btn-primary")
|
|
),
|
|
wellPanel(
|
|
style = 'overflow-x: scroll;height: 650px;',
|
|
DT::dataTableOutput("emmeans_table"),
|
|
downloadButton("emmeans_button_download", "Télécharger le tableau",class="btn-primary"),
|
|
DT::dataTableOutput("contrast_table"),
|
|
downloadButton("contrast_button_download", "Télécharger le tableau",class="btn-primary")
|
|
)
|
|
),
|
|
tabPanel("result",
|
|
h2("Résultat Anova"),
|
|
verbatimTextOutput("anova_result"),
|
|
h2("Résultat Emmeans"),
|
|
verbatimTextOutput("emmeans_result"),
|
|
h2('Moyenne comparée'),
|
|
plotlyOutput('graph_compared_mean')
|
|
)
|
|
)
|
|
)
|
|
)
|
|
),
|
|
tabPanel("Test de Krustal-Wallis",
|
|
fluidRow(
|
|
column(4,
|
|
wellPanel(
|
|
selectInput("var_expliquees_kw","Choisir la variable à expliquer",multiple = FALSE,choices = NULL),
|
|
selectInput("var_explicatives_kw","Choisir la variable explicative",multiple = FALSE,choices = NULL),
|
|
actionButton("kw_button", "KW",class="btn-primary")
|
|
),
|
|
),
|
|
column(8,
|
|
wellPanel(
|
|
style = 'overflow-x: scroll;height: 650px;',
|
|
DT::dataTableOutput("kw_table"),
|
|
downloadButton("kw_button_download", "Télécharger le tableau",class="btn-primary")
|
|
),
|
|
wellPanel(
|
|
"KW Resultat",
|
|
verbatimTextOutput("kw_resultat")
|
|
)
|
|
)
|
|
)
|
|
),
|
|
tabPanel("Khi 2",
|
|
fluidRow(
|
|
column(4,
|
|
wellPanel(
|
|
selectizeInput("khi2_cat","Choisir les variables",multiple = TRUE,choices = NULL),
|
|
actionButton("khi2_button", "KHI2",class="btn-primary")
|
|
)
|
|
),
|
|
column(8,
|
|
wellPanel(
|
|
style = 'overflow-x: scroll;height: 650px;',
|
|
DT::dataTableOutput("khi2_table"),
|
|
downloadButton("khi2_button_download", "Télécharger le tableau",class="btn-primary")
|
|
)
|
|
)
|
|
)
|
|
),
|
|
tabPanel("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,
|
|
wellPanel(
|
|
h2('Analyse Statistique'),
|
|
selectInput("dataset_graph", "dataset_graph à prendre", multiple = FALSE, choices = c("cars","airquality","iris")),
|
|
selectInput("type_graph", "Type de graphique", multiple = FALSE, choices = c("Barplot","Boxplot","Density plot","Geomline","Histograme","Scatterplot")),
|
|
selectInput("graph_x", "X", multiple = FALSE, choices = NULL),
|
|
selectInput("graph_y", "Y", multiple = FALSE, choices = NULL),
|
|
selectInput("graph_fill", "Fill", multiple = FALSE, choices = NULL),
|
|
selectInput("facet_a","Face grid",multiple = FALSE,choices = '.',),
|
|
selectInput("facet_b","Face grid",multiple = FALSE,choices = '.',)
|
|
)
|
|
),
|
|
column(9,
|
|
fluidRow(
|
|
wellPanel(
|
|
plotlyOutput("graph_graph"),
|
|
)
|
|
)
|
|
)
|
|
),
|
|
tabPanel("Instructions",
|
|
fluidRow(
|
|
column(8,
|
|
includeMarkdown("README.md")
|
|
)
|
|
)
|
|
),
|
|
navbarMenu("Régressions",
|
|
tabPanel("ACP",
|
|
column(3,
|
|
wellPanel(
|
|
h2('ACP'),
|
|
selectInput("acp_col", "Numerical Columns", multiple = TRUE, choices = NULL),
|
|
actionButton("acp_button", "ACP",class="btn-primary"),
|
|
),
|
|
),
|
|
column(9,
|
|
fluidRow(
|
|
wellPanel(
|
|
plotlyOutput("plotly_acp_graph")
|
|
)
|
|
)
|
|
)
|
|
),
|
|
tabPanel("PLS",
|
|
column(3,
|
|
wellPanel(
|
|
h2('PLS'),
|
|
selectInput("pls_x", "X", multiple = TRUE, choices = NULL),
|
|
selectInput("pls_y", "Y", multiple = FALSE, choices = NULL),
|
|
sliderInput("pls_slider","Nombre de composante",1,1,1,step = 1),
|
|
actionButton("pls_button", "PLS",class="btn-primary")
|
|
)
|
|
),
|
|
column(9,
|
|
fluidRow(
|
|
wellPanel(
|
|
h2('Résultats'),
|
|
verbatimTextOutput("pls_text"),
|
|
)
|
|
)
|
|
)
|
|
),
|
|
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()
|
|
)
|
|
|
|
# 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
|
|
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 <- na.omit(concatenated_table)
|
|
#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))))
|
|
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))))
|
|
})
|
|
|
|
#On utilise une fonction permettant d'obternir la liste des variables numériques
|
|
num_columns <- eventReactive(input$applyTypes,{
|
|
numeric_integer_columns <- colnames( merged_data_type() %>% select_if(function(x) is.numeric(x) || is.integer(x)))
|
|
return(numeric_integer_columns)
|
|
})
|
|
|
|
#On utilise une fonction permettant d'obternir la liste des variables cat
|
|
cat_col <- eventReactive(input$applyTypes,{
|
|
return(factor_columns <- sapply(merged_data(), is.factor))
|
|
})
|
|
|
|
#On utilise une fonction permettant d'obternir la liste des variables
|
|
columns <- eventReactive(input$applyTypes,{
|
|
a <- colnames(merged_data())
|
|
a <- setdiff(a,input$ignore_columns)
|
|
return(a)
|
|
})
|
|
|
|
|
|
|
|
explicative_col <- eventReactive(input$files,{
|
|
return(input$var_expliquees)
|
|
})
|
|
|
|
kw_explicative_col <- eventReactive(input$kw_button,{
|
|
return(input$var_expliquees_kw)
|
|
})
|
|
|
|
|
|
#On utilise une fonction permettant d'obtenir la liste des différentes sources
|
|
liste_source <- eventReactive(input$cat_id,{
|
|
return(unique(merged_data()[[input$cat_id]]))
|
|
})
|
|
|
|
# Afficher les résultats de la fusion dans une table
|
|
output$merged_data_table <- renderDataTable(merged_data(),
|
|
options = list(
|
|
pageLength = 10,
|
|
autoWidth = TRUE,
|
|
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
|
|
)
|
|
)
|
|
|
|
#=============================================================================
|
|
#Cette partie gère la partie "Graphiques"
|
|
|
|
observe({
|
|
updateSelectInput(session,"dataset_graph",
|
|
choices = c("cars","airquality","iris",input$files$name))
|
|
})
|
|
|
|
|
|
graph_data <- eventReactive(input$dataset_graph,{
|
|
if (input$dataset_graph == 'cars') {
|
|
return(datasets::cars)
|
|
}
|
|
if (input$dataset_graph == "airquality"){
|
|
return(datasets::airquality)
|
|
}
|
|
if (input$dataset_graph == "iris"){
|
|
return(datasets::iris)
|
|
}
|
|
if (input$dataset_graph == input$files$name) {
|
|
return(merged_data_type())
|
|
}
|
|
})
|
|
|
|
observe({
|
|
updateSelectInput(session,"graph_x", choices = colnames(graph_data()))
|
|
updateSelectInput(session,"graph_y", choice = colnames(graph_data()))
|
|
updateSelectInput(session,"graph_fill", choices = c("None",colnames(graph_data())),selected = "None")
|
|
updateSelectInput(session,"facet_a", choices = c(".",colnames(graph_data())),selected = ".")
|
|
updateSelectInput(session,"facet_b", choices = c(".",colnames(graph_data())),selected = ".")
|
|
|
|
})
|
|
|
|
|
|
observe({
|
|
facet_formula = as.formula(paste0(input$facet_a, ' ~ ', input$facet_b))
|
|
print(facet_formula)
|
|
})
|
|
|
|
observe({
|
|
output$graph_graph <- renderPlotly({
|
|
|
|
if (input$type_graph == 'Barplot'){
|
|
if (input$graph_fill == 'None'){
|
|
p <- ggplot(data = graph_data(),aes(x=!!sym(input$graph_x),y=!!sym(input$graph_y))) + geom_bar(stat="identity") + facet_grid(as.formula(paste0(input$facet_a, ' ~ ', input$facet_b))) + labs(x = input$graph_x, y = input$graph_y)
|
|
#p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),type='bar')
|
|
#p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y))
|
|
p <- ggplotly(p)
|
|
} else {
|
|
p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y), fill = !!sym(input$graph_fill))) +
|
|
geom_bar(stat = "identity") +
|
|
facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) +
|
|
labs(x = input$graph_x, y = input$graph_y)
|
|
#p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),color=~get(input$graph_fill),type='bar')
|
|
#p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y))
|
|
p <- ggplotly(p)
|
|
}
|
|
|
|
return(p)
|
|
}
|
|
|
|
if (input$type_graph == 'Geomline'){
|
|
if (input$graph_fill == 'None'){
|
|
p <- ggplot(data = graph_data(),aes(x=!!sym(input$graph_x),y=!!sym(input$graph_y))) + stat_summary(fun = "mean", geom = "line") + facet_grid(as.formula(paste0(input$facet_a, ' ~ ', input$facet_b))) + labs(x = input$graph_x, y = input$graph_y)
|
|
#p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),type='bar')
|
|
#p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y))
|
|
p <- ggplotly(p)
|
|
} else {
|
|
p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y), colour=!!sym(input$graph_fill))) + stat_summary(fun = "mean", geom = "line",aes(group=!!sym(input$graph_fill))) +
|
|
facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) + labs(x = input$graph_x, y = input$graph_y)
|
|
#p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),color=~get(input$graph_fill),type='bar')
|
|
#p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y))
|
|
p <- ggplotly(p)
|
|
}
|
|
|
|
return(p)
|
|
}
|
|
|
|
if (input$type_graph == 'Boxplot'){
|
|
if (input$graph_fill == 'None'){
|
|
p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y))) +
|
|
geom_boxplot() +
|
|
facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) +
|
|
labs(x = input$graph_x, y = input$graph_y)
|
|
p <- ggplotly(p)
|
|
} else {
|
|
p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y), fill = !!sym(input$graph_fill))) +
|
|
geom_boxplot() +
|
|
facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) +
|
|
labs(x = input$graph_x, y = input$graph_y)
|
|
}
|
|
|
|
return(p)
|
|
}
|
|
if (input$type_graph == 'Density plot'){
|
|
p <- ggplot(graph_data(), aes_string(x=input$graph_x)) +
|
|
geom_density() + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b))))
|
|
return(ggplotly(p))
|
|
}
|
|
if (input$type_graph == 'Histograme'){
|
|
if (input$graph_fill == 'None') {
|
|
p <- ggplot(graph_data(), aes_string(x=input$graph_x)) +
|
|
geom_histogram() + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b))))
|
|
} else {
|
|
p <- ggplot(graph_data(), aes_string(x=input$graph_x,color=input$graph_fill)) +
|
|
geom_histogram() + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b))))
|
|
}
|
|
|
|
return(ggplotly(p))
|
|
}
|
|
if (input$type_graph == 'Scatterplot'){
|
|
if (input$graph_fill == 'None') {
|
|
p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y))) +
|
|
geom_point() +
|
|
facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) +
|
|
labs(x = input$graph_x, y = input$graph_y)
|
|
p <- ggplotly(p)
|
|
|
|
} else {
|
|
p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y), fill = !!sym(input$graph_fill))) +
|
|
geom_point() +
|
|
facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b)))) +
|
|
labs(x = input$graph_x, y = input$graph_y)
|
|
}
|
|
|
|
return(p)
|
|
}
|
|
|
|
})
|
|
|
|
})
|
|
|
|
#=============================================================================
|
|
#Cette partie gère l'analyse des données
|
|
|
|
|
|
|
|
shapiro_table <- eventReactive(input$files,{
|
|
num_col <- num_columns()
|
|
shapiro <- data.frame()
|
|
merged_data <- merged_data()
|
|
|
|
|
|
for (col in num_col){
|
|
tryCatch({
|
|
a <- shapiro.test(as.numeric(merged_data[[col]]))
|
|
shapiro <- rbind(shapiro,c(col,"","Shapiro",a$p.value))
|
|
colnames(shapiro) <- c("Column","Classe","Test","p-value")
|
|
},
|
|
error=function(e) {
|
|
print(co)
|
|
message('An Error Occurred')
|
|
cat("Erreur :", conditionMessage(e), "\n")
|
|
traceback()
|
|
},
|
|
warning=function(w) {
|
|
message('A Warning Occured')
|
|
print(w)
|
|
return(NA)
|
|
})
|
|
|
|
}
|
|
|
|
return(shapiro)
|
|
})
|
|
|
|
|
|
output$shapiro_table <- renderDataTable(shapiro_table(),
|
|
options = list(
|
|
pageLength = 10,
|
|
autoWidth = TRUE,
|
|
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
|
|
)
|
|
)
|
|
|
|
|
|
|
|
anova_table <- eventReactive(input$anova_button,{
|
|
tryCatch({
|
|
merged_data <- merged_data_type()
|
|
var_expliquee <- input$var_expliquees
|
|
var_explicatives <- input$var_explicatives
|
|
form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*")))
|
|
mod = lm(as.formula(form),data=merged_data)
|
|
anova_table <- as.data.frame(Anova(mod))
|
|
for (col in names(anova_table)) {
|
|
if (is.numeric(anova_table[[col]])) {
|
|
anova_table[[col]] <- round(anova_table[[col]], 3)
|
|
}
|
|
}
|
|
output$anova_result <- renderPrint({return(Anova(mod))})
|
|
return(anova_table)
|
|
},
|
|
error = function(e) {
|
|
message('An Error Occurred')
|
|
cat("Erreur :", conditionMessage(e), "\n")
|
|
traceback()
|
|
return(NULL)
|
|
},
|
|
warning = function(w) {
|
|
message('A Warning Occured')
|
|
print(w)
|
|
formula <- formula(paste(num_column, "~", cat))
|
|
a <- leveneTest(formula, data = merged_data)
|
|
return(a)
|
|
})
|
|
|
|
})
|
|
|
|
|
|
|
|
output$anova_table <- renderDataTable(anova_table(),
|
|
extensions = "Buttons",
|
|
options = list(
|
|
pageLength = 10,
|
|
autoWidth = TRUE,
|
|
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
|
|
)
|
|
)
|
|
|
|
output$anova_button_download <- downloadHandler(
|
|
filename = function(){"anova_results.csv"},
|
|
content = function(fname){
|
|
write.csv(anova_table(), fname)
|
|
}
|
|
)
|
|
|
|
|
|
Temoins <- reactiveVal(list())
|
|
|
|
observe({
|
|
temoins <- list()
|
|
for (col in input$emmeans_explicatives) {
|
|
temoins[[col]] <- selectInput(
|
|
inputId = paste0("temoin_", col),
|
|
label = col,
|
|
choices = unique(merged_data()[[col]]),
|
|
selected = unique(merged_data()[[col]])[1]
|
|
)
|
|
}
|
|
Temoins(temoins)
|
|
})
|
|
|
|
output$Temoins <- renderUI({
|
|
temoins <- Temoins()
|
|
if (!is.null(temoins) && length(temoins) > 0) {
|
|
div(
|
|
lapply(names(temoins), function(col) {
|
|
temoins[[col]]
|
|
})
|
|
)
|
|
}
|
|
})
|
|
|
|
|
|
ref_index <- eventReactive(input$emmeans_button,{
|
|
tryCatch({
|
|
merged_data <- merged_data_type()
|
|
var_expliquee <- input$emmeans_expliquees
|
|
var_explicatives <- input$emmeans_explicatives
|
|
t = ""
|
|
for (col in names(Temoins())) {
|
|
t <- paste(t,input[[paste0("temoin_", col)]],collapse = " ")
|
|
}
|
|
print(t)
|
|
t <- substr(t,2,nchar(t))
|
|
form1 = as.formula(paste0("~",paste(var_explicatives,collapse = "*")))
|
|
form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*")))
|
|
mod = lm(form,data=merged_data)
|
|
emm <- emmeans(mod,form1)
|
|
row_concat <- apply(emm@grid[,-ncol(emm@grid)], 1, function(row) {
|
|
paste(row, collapse = " ")
|
|
})
|
|
ind <- which(row_concat == t)
|
|
return(ind)
|
|
},
|
|
error = function(e) {
|
|
message('An Error Occurred')
|
|
cat("Erreur :", conditionMessage(e), "\n")
|
|
traceback()
|
|
return(NULL)
|
|
},
|
|
warning = function(w) {
|
|
message('A Warning Occured')
|
|
print(w)
|
|
formula <- formula(paste(num_column, "~", cat))
|
|
a <- leveneTest(formula, data = merged_data)
|
|
return(a)
|
|
})
|
|
|
|
})
|
|
|
|
emmeans_table <- eventReactive(input$emmeans_button,{
|
|
merged_data <- merged_data_type()
|
|
var_expliquee <- input$emmeans_expliquees
|
|
var_explicatives <- input$emmeans_explicatives
|
|
type_comp <- input$type_comp
|
|
print(type_comp)
|
|
if (type_comp == 'trt.vs.ctrl') {
|
|
form1 = as.formula(paste0("trt.vs.ctrl~",paste(var_explicatives,collapse = "*")))
|
|
} else {
|
|
form1 = as.formula(paste0("pairwise~",paste(var_explicatives,collapse = "*")))
|
|
}
|
|
|
|
form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*")))
|
|
mod = lm(as.formula(form),data=merged_data)
|
|
output$emmeans_result <- renderPrint({
|
|
return(emmeans(mod,form1))
|
|
})
|
|
output$graph_compared_mean <- renderPlotly({
|
|
return(comparisonGraph(emmeansObj = emmeans(mod,form1)))
|
|
})
|
|
emmeans_table <- as.data.frame(emmeans(mod,form1)$emmeans)
|
|
for (col in names(emmeans_table)) {
|
|
if (is.numeric(emmeans_table[[col]])) {
|
|
emmeans_table[[col]] <- round(emmeans_table[[col]], 3)
|
|
}
|
|
}
|
|
emmeans_table <- na.omit(emmeans_table)
|
|
return(emmeans_table)
|
|
|
|
})
|
|
|
|
|
|
|
|
|
|
contrasts_table <- eventReactive(input$emmeans_button,{
|
|
merged_data <- merged_data_type()
|
|
var_expliquee <- input$emmeans_expliquees
|
|
var_explicatives <- input$emmeans_explicatives
|
|
type_comp <- input$type_comp
|
|
|
|
form1 = as.formula(paste0("~",paste(var_explicatives,collapse = "*")))
|
|
form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*")))
|
|
mod = lm(form,data=merged_data)
|
|
print(form)
|
|
print(form1)
|
|
emm <- emmeans(mod,form1)
|
|
print(as.data.frame(ref_grid(mod)@grid))
|
|
contr <- contrast(emm,type_comp,ref=ref_index())
|
|
emmeans_table <- as.data.frame(contr)
|
|
for (col in names(emmeans_table)) {
|
|
if (is.numeric(emmeans_table[[col]])) {
|
|
emmeans_table[[col]] <- round(emmeans_table[[col]], 3)
|
|
}
|
|
}
|
|
emmeans_table <- na.omit(emmeans_table)
|
|
return(emmeans_table)
|
|
|
|
})
|
|
|
|
|
|
|
|
output$emmeans_table <- renderDataTable(datatable(emmeans_table(),
|
|
options = list(
|
|
pageLength = 10,
|
|
autoWidth = TRUE,
|
|
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
|
|
),
|
|
caption = "Moyennes ajustées",
|
|
)
|
|
)
|
|
|
|
|
|
output$emmeans_button_download <- downloadHandler(
|
|
filename = function(){"emmeans_results.csv"},
|
|
content = function(fname){
|
|
write.csv(emmeans_table(), fname,row.names = FALSE)
|
|
}
|
|
)
|
|
|
|
output$contrast_table <- renderDataTable(datatable(contrasts_table(),
|
|
options = list(
|
|
pageLength = 10,
|
|
autoWidth = TRUE,
|
|
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
|
|
),
|
|
caption = "Contrasts",
|
|
)
|
|
)
|
|
|
|
output$contrast_button_download <- downloadHandler(
|
|
filename = function(){"contrast_results.csv"},
|
|
content = function(fname){
|
|
write.csv(contrasts_table(), fname,row.names = FALSE)
|
|
}
|
|
)
|
|
|
|
kw_table <- eventReactive(input$kw_button,{
|
|
cat_col <- input$var_explicatives_kw
|
|
num_col <- input$var_expliquees_kw
|
|
kw_table = data.frame()
|
|
|
|
tryCatch({
|
|
krustal_formule <- as.formula(paste0(num_col,'~',cat_col))
|
|
print(krustal_formule)
|
|
kruskal_test <- kruskal.test(krustal_formule,data=merged_data())
|
|
kw_table <- rbind(kw_table,c(num_col,cat_col,"KW",kruskal_test$p.value))
|
|
colnames(kw_table) <-c("Column","Classe","Test","p-value")
|
|
output$kw_resultat <- renderPrint({
|
|
return(kruskal_test)
|
|
})
|
|
},
|
|
error=function(e) {
|
|
message('An Error Occurred')
|
|
cat("Erreur :", conditionMessage(e), "\n")
|
|
traceback()
|
|
},
|
|
warning=function(w) {
|
|
message('A Warning Occured')
|
|
print(w)
|
|
kruskal_test <- kruskal.test(merged_data()[[col]]~interaction(merged_data()[[cat]], merged_data()[[cat_id()]]))
|
|
kw_table <- rbind(kw_table,c(col,cat,"KW",kruskal_test$p.value))
|
|
colnames(kw_table) <-c("Column","Classe","Test","p-value")
|
|
})
|
|
|
|
|
|
return(kw_table)
|
|
|
|
})
|
|
|
|
output$kw_table <- renderDataTable(kw_table(),
|
|
options = list(
|
|
pageLength = 10,
|
|
autoWidth = TRUE,
|
|
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
|
|
)
|
|
)
|
|
|
|
|
|
|
|
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({
|
|
updateSelectInput(session, "acp_col", choices = num_columns())
|
|
})
|
|
|
|
observe({
|
|
updateSliderInput(session,"pls_slider",max = length(input$pls_x))
|
|
})
|
|
|
|
observeEvent(input$acp_button,{
|
|
output$plotly_acp_graph <- renderPlotly({
|
|
acp_data <- merged_data()[, input$acp_col]
|
|
res.pca <- prcomp(acp_data, scale = TRUE)
|
|
pl <- fviz_pca_ind(
|
|
res.pca,
|
|
col.ind = merged_data()[["Source"]], # Color by the quality of representation
|
|
repel = TRUE, # Avoid text overlapping
|
|
label = "None"
|
|
) + scale_color_discrete()
|
|
|
|
# Convertir le graphique ggplot2 en graphique plotly
|
|
pl <- ggplotly(pl)
|
|
|
|
return(pl)
|
|
})
|
|
|
|
})
|
|
|
|
observe({
|
|
updateSelectInput(session, "pls_x", choices = num_columns())
|
|
updateSelectInput(session, "pls_y", choices = num_columns())
|
|
})
|
|
|
|
|
|
observeEvent(input$pls_button,{
|
|
output$pls_text <- renderPrint({
|
|
pls_formula <- as.formula(paste0(input$pls_y,'~',paste(input$pls_x,collapse='*')))
|
|
pls.result <- plsr(pls_formula,data=merged_data_type(),scale=TRUE, validation="CV")
|
|
pls_sum <- summary(pls.result)
|
|
return(pls_sum)
|
|
})
|
|
|
|
})
|
|
|
|
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) |