Private_Personal_Projects
/
PlatStat
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Téléverser les fichiers vers "/"

This commit is contained in:
aslane 2024-03-20 14:01:27 +00:00
parent 587f6857b7
commit 1df543badc
2 changed files with 206 additions and 510 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
Dockerfile
View File

@ -1,9 +1,5 @@
FROM rocker/r-ver 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 \ RUN apt-get update \
&& apt-get install -y --no-install-recommends \ && apt-get install -y --no-install-recommends \
pandoc \ pandoc \
@ -16,14 +12,26 @@ RUN apt-get update \
libicu-dev \ libicu-dev \
wget 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 # Create a directory for your Shiny app
RUN mkdir -p /srv/shiny && \ RUN mkdir -p /srv/shiny
chown shiny:shiny /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 the Shiny app to the container
COPY app.R /srv/shiny/app.R COPY app.R /srv/shiny/app.R
@ -35,9 +43,12 @@ COPY .Renviron /srv/shiny/.Renviron
# Expose the port Shiny app runs on # Expose the port Shiny app runs on
EXPOSE 8080 EXPOSE 8080
# Use the created shiny user
USER shiny
# Command to run the Shiny app # 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)"] CMD ["R", "-e", "shiny::runApp('/srv/shiny', host='0.0.0.0', port=8080, launch.browser = FALSE)"]

679
app.R
View File

@ -5,7 +5,7 @@ library(gridExtra)
library(emmeans) library(emmeans)
library(readxl) library(readxl)
library(dplyr) library(dplyr)
library(officer) library(carData)
library(car) library(car)
library(factoextra) library(factoextra)
library(shinylogs) library(shinylogs)
@ -15,8 +15,14 @@ library(httr)
library(shinyjs) library(shinyjs)
library(openssl) library(openssl)
library(urltools) library(urltools)
library(openssl)
library(pls)
library(shinyBS)
library(multcomp)
options(shiny.port=8080)
client_id <- Sys.getenv("CLIENT_ID") client_id <- Sys.getenv("CLIENT_ID")
client_secret <- Sys.getenv("CLIENT_SECRET") client_secret <- Sys.getenv("CLIENT_SECRET")
uri_url <- Sys.getenv("URI_URL") uri_url <- Sys.getenv("URI_URL")
@ -24,6 +30,41 @@ authorize_url = Sys.getenv("AUTHORIZE_URL")
token_url = Sys.getenv("TOKEN_URL") token_url = Sys.getenv("TOKEN_URL")
userinfo_url = Sys.getenv("USERINFO_URL") userinfo_url = Sys.getenv("USERINFO_URL")
response_type <- 'code' 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( ui <- fluidPage(
@ -46,7 +87,7 @@ ui <- fluidPage(
",functions="shinyjs.hideAllElements"), ",functions="shinyjs.hideAllElements"),
theme = shinytheme("readable"), #theme = shinytheme("readable"),
navbarPage( navbarPage(
"Stat Plateform", "Stat Plateform",
tabPanel("Accueil", tabPanel("Accueil",
@ -56,6 +97,7 @@ ui <- fluidPage(
wellPanel( wellPanel(
fileInput("files", "Sélectionnez les fichiers Excel (xlsx) :", multiple = TRUE), fileInput("files", "Sélectionnez les fichiers Excel (xlsx) :", multiple = TRUE),
selectInput("ignore_columns", "Colonnes à ignorer :", multiple = TRUE, choices = NULL), selectInput("ignore_columns", "Colonnes à ignorer :", multiple = TRUE, choices = NULL),
bsTooltip("columnTypes","Choisir les types des colonnes",placement = "right",trigger = "hover"),
uiOutput("columnTypes"), uiOutput("columnTypes"),
actionButton("applyTypes", "Appliquer les types de données"), actionButton("applyTypes", "Appliquer les types de données"),
) )
@ -69,18 +111,6 @@ ui <- fluidPage(
), ),
), ),
navbarMenu("Analyse", 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", tabPanel("ANOVA",
fluidRow( fluidRow(
column(4, column(4,
@ -98,6 +128,8 @@ ui <- fluidPage(
) )
), ),
column(8, column(8,
tabsetPanel(
tabPanel('Table',
wellPanel( wellPanel(
style = 'overflow-x: scroll;height: 650px;', style = 'overflow-x: scroll;height: 650px;',
DT::dataTableOutput("anova_table"), DT::dataTableOutput("anova_table"),
@ -110,6 +142,16 @@ ui <- fluidPage(
DT::dataTableOutput("contrast_table"), DT::dataTableOutput("contrast_table"),
downloadButton("contrast_button_download", "Télécharger le tableau",class="btn-primary") 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, column(4,
wellPanel( wellPanel(
selectInput("var_expliquees_kw","Choisir la variable à expliquer",multiple = FALSE,choices = NULL), selectInput("var_expliquees_kw","Choisir la variable à expliquer",multiple = FALSE,choices = NULL),
selectInput("var_explicatives_kw","Choisir les variables explicatives",multiple = TRUE,choices = NULL), selectInput("var_explicatives_kw","Choisir la variable explicative",multiple = FALSE,choices = NULL),
actionButton("kw_button", "ANOVA",class="btn-primary") actionButton("kw_button", "KW",class="btn-primary")
), ),
), ),
column(8, column(8,
@ -128,18 +170,13 @@ ui <- fluidPage(
DT::dataTableOutput("kw_table"), DT::dataTableOutput("kw_table"),
downloadButton("kw_button_download", "Télécharger le tableau",class="btn-primary") 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", tabPanel("Khi 2",
fluidRow( fluidRow(
column(4, 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", tabPanel("Graphique",
@ -179,10 +200,12 @@ ui <- fluidPage(
wellPanel( wellPanel(
h2('Analyse Statistique'), h2('Analyse Statistique'),
selectInput("dataset_graph", "dataset_graph à prendre", multiple = FALSE, choices = c("cars","airquality","iris")), 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_x", "X", multiple = FALSE, choices = NULL),
selectInput("graph_y", "Y", multiple = FALSE, choices = NULL), selectInput("graph_y", "Y", multiple = FALSE, choices = NULL),
selectInput("graph_fill", "Fill", 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, column(9,
@ -223,13 +246,15 @@ ui <- fluidPage(
h2('PLS'), h2('PLS'),
selectInput("pls_x", "X", multiple = TRUE, choices = NULL), selectInput("pls_x", "X", multiple = TRUE, choices = NULL),
selectInput("pls_y", "Y", multiple = FALSE, 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") actionButton("pls_button", "PLS",class="btn-primary")
) )
), ),
column(9, column(9,
fluidRow( fluidRow(
wellPanel( wellPanel(
plotlyOutput("pls_acp_graph°") h2('Résultats'),
verbatimTextOutput("pls_text"),
) )
) )
) )
@ -243,7 +268,6 @@ server <- function(input, output, session) {
track_usage( track_usage(
storage_mode = store_null() storage_mode = store_null()
) )
observe({ observe({
if(is.null(session$userData$authorize)) { if(is.null(session$userData$authorize)) {
session$userData$authorize <- 0 session$userData$authorize <- 0
@ -253,7 +277,7 @@ server <- function(input, output, session) {
observe({ observe({
# Vérifier si aucun paramètre n'est présent dans l'URL # Vérifier si aucun paramètre n'est présent dans l'URL
if (!grepl("^[?&].*", session$clientData$url_search)) { if (!grepl("^[?&].*", session$clientData$url_search)) {
random_bytes <- rand_bytes(16)
random_state <- toupper(paste0(sprintf("%02x", as.integer(random_bytes)), collapse = "")) random_state <- toupper(paste0(sprintf("%02x", as.integer(random_bytes)), collapse = ""))
scope <- "openid profile" scope <- "openid profile"
auth_url <- sprintf("%s?client_id=%s&scope=%s&redirect_uri=%s&response_type=%s&state=%s", 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) return(input$var_expliquees)
}) })
kw_explicative_col <- eventReactive(input$files,{ kw_explicative_col <- eventReactive(input$kw_button,{
return(input$var_expliquees_kw) return(input$var_expliquees_kw)
}) })
@ -483,11 +507,11 @@ server <- function(input, output, session) {
observe({ observe({
updateSelectInput(session,"dataset_graph", 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') { if (input$dataset_graph == 'cars') {
return(datasets::cars) return(datasets::cars)
} }
@ -497,68 +521,111 @@ server <- function(input, output, session) {
if (input$dataset_graph == "iris"){ if (input$dataset_graph == "iris"){
return(datasets::iris) return(datasets::iris)
} }
if (input$dataset_graph == 'All data') { if (input$dataset_graph == input$files$name) {
return(merged_data_type()) return(merged_data_type())
} }
}) })
observe({ observe({
updateSelectInput(session,"graph_x", choices = colnames(data())) updateSelectInput(session,"graph_x", choices = colnames(graph_data()))
updateSelectInput(session,"graph_y", choice = colnames(data())) updateSelectInput(session,"graph_y", choice = colnames(graph_data()))
updateSelectInput(session,"graph_fill", choices = c("None",colnames(data())),selected = "None") 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({ output$graph_graph <- renderPlotly({
if (input$type_graph == 'Barplot'){ if (input$type_graph == 'Barplot'){
if (input$graph_fill == 'None'){ if (input$graph_fill == 'None'){
p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),type='bar') 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 <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=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 { } else {
p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),color=~get(input$graph_fill),type='bar') 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))) +
p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y)) 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) return(p)
} }
if (input$type_graph == 'Boxplot'){ if (input$type_graph == 'Boxplot'){
if (input$graph_fill == 'None'){ if (input$graph_fill == 'None'){
p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),type='box') p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y))) +
p <- p %>% layout(boxmode = "group", xaxis=list(title=input$graph_x),yaxis=list(title=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 { } else {
p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),color=~get(input$graph_fill),type='box') p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y), fill = !!sym(input$graph_fill))) +
p <- p %>% layout(boxmode = "group", xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y),coloraxis=list(title=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) return(p)
} }
if (input$type_graph == 'Density plot'){ if (input$type_graph == 'Density plot'){
p <- ggplot(data(), aes_string(x=input$graph_x)) + p <- ggplot(graph_data(), aes_string(x=input$graph_x)) +
geom_density() geom_density() + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b))))
return(ggplotly(p)) return(ggplotly(p))
} }
if (input$type_graph == 'Histograme'){ if (input$type_graph == 'Histograme'){
if (input$graph_fill == 'None') { if (input$graph_fill == 'None') {
p <- ggplot(data(), aes_string(x=input$graph_x)) + p <- ggplot(graph_data(), aes_string(x=input$graph_x)) +
geom_histogram() geom_histogram() + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b))))
} else { } else {
p <- ggplot(data(), aes_string(x=input$graph_x,color=input$graph_fill)) + p <- ggplot(graph_data(), aes_string(x=input$graph_x,color=input$graph_fill)) +
geom_histogram() geom_histogram() + facet_grid((as.formula(paste0(input$facet_a, ' ~ ', input$facet_b))))
} }
return(ggplotly(p)) return(ggplotly(p))
} }
if (input$type_graph == 'Scatterplot'){ if (input$type_graph == 'Scatterplot'){
if (input$graph_fill == 'None') { if (input$graph_fill == 'None') {
p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),type='scatter') p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y))) +
p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=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 { } else {
p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),color=~get(input$graph_fill),type='scatter') p <- ggplot(data = graph_data(), aes(x = !!sym(input$graph_x), y = !!sym(input$graph_y), fill = !!sym(input$graph_fill))) +
p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y),legend=list(title=list(text=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) 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,{ anova_table <- eventReactive(input$anova_button,{
tryCatch({ tryCatch({
@ -851,6 +692,7 @@ server <- function(input, output, session) {
anova_table[[col]] <- round(anova_table[[col]], 3) anova_table[[col]] <- round(anova_table[[col]], 3)
} }
} }
output$anova_result <- renderPrint({return(Anova(mod))})
return(anova_table) return(anova_table)
}, },
error = function(e) { error = function(e) {
@ -891,14 +733,13 @@ server <- function(input, output, session) {
Temoins <- reactiveVal(list()) Temoins <- reactiveVal(list())
observe({ observe({
data <- merged_data()
temoins <- list() temoins <- list()
for (col in input$emmeans_explicatives) { for (col in input$emmeans_explicatives) {
temoins[[col]] <- selectInput( temoins[[col]] <- selectInput(
inputId = paste0("temoin_", col), inputId = paste0("temoin_", col),
label = col, label = col,
choices = unique(data[[col]]), choices = unique(merged_data()[[col]]),
selected = unique(data[[col]])[1] selected = unique(merged_data()[[col]])[1]
) )
} }
Temoins(temoins) Temoins(temoins)
@ -967,6 +808,12 @@ server <- function(input, output, session) {
form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*"))) form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*")))
mod = lm(as.formula(form),data=merged_data) 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) emmeans_table <- as.data.frame(emmeans(mod,form1)$emmeans)
for (col in names(emmeans_table)) { for (col in names(emmeans_table)) {
if (is.numeric(emmeans_table[[col]])) { if (is.numeric(emmeans_table[[col]])) {
@ -1043,18 +890,20 @@ server <- function(input, output, session) {
} }
) )
kw_table <- eventReactive(input$applyTypes,{ kw_table <- eventReactive(input$kw_button,{
cat_col <- input$cat_columns cat_col <- input$var_explicatives_kw
num_col <- num_columns() num_col <- input$var_expliquees_kw
kw_table = data.frame() kw_table = data.frame()
cat_id <- input$cat_id
for (cat in cat_col) {
for (col in num_col) {
tryCatch({ tryCatch({
kruskal_test <- kruskal.test(merged_data()[[col]]~interaction(merged_data()[[cat]], merged_data()[[cat_id()]])) krustal_formule <- as.formula(paste0(num_col,'~',cat_col))
kw_table <- rbind(kw_table,c(col,cat,"KW",kruskal_test$p.value)) 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") colnames(kw_table) <-c("Column","Classe","Test","p-value")
output$kw_resultat <- renderPrint({
return(kruskal_test)
})
}, },
error=function(e) { error=function(e) {
message('An Error Occurred') message('An Error Occurred')
@ -1069,8 +918,7 @@ server <- function(input, output, session) {
colnames(kw_table) <-c("Column","Classe","Test","p-value") colnames(kw_table) <-c("Column","Classe","Test","p-value")
}) })
}
}
return(kw_table) 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" #Cette partie gère la partie "Modèles classiques"
observe({ observe({
updateSelectInput(session, "acp_col", choices = num_columns()) 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,{ observeEvent(input$acp_button,{
output$plotly_acp_graph <- renderPlotly({ output$plotly_acp_graph <- renderPlotly({
acp_data <- merged_data()[, input$acp_col] acp_data <- merged_data()[, input$acp_col]
@ -1277,24 +961,25 @@ server <- function(input, output, session) {
}) })
observeEvent(input$pls_button,{ observe({
output$plotly_acp_graph <- renderPlotly({ updateSelectInput(session, "pls_x", choices = num_columns())
acp_data <- merged_data()[, input$acp_col] updateSelectInput(session, "pls_y", choices = num_columns())
res.pca <- prcomp(acp_data, scale = TRUE) })
pl <- fviz_pca_ind(
res.pca,
col.ind = merged_data()[["Source"]], # Color by the quality of representation observeEvent(input$pls_button,{
repel = TRUE, # Avoid text overlapping output$pls_text <- renderPrint({
label = "None" pls_formula <- as.formula(paste0(input$pls_y,'~',paste(input$pls_x,collapse='*')))
) + scale_color_discrete() pls.result <- plsr(pls_formula,data=merged_data_type(),scale=TRUE, validation="CV")
pls_sum <- summary(pls.result)
# Convertir le graphique ggplot2 en graphique plotly return(pls_sum)
pl <- ggplotly(pl)
return(pl)
}) })
}) })
#output$pls_text <- renderText({'print'})
} }
}) })
} }