Téléverser les fichiers vers "/"
This commit is contained in:
parent
587f6857b7
commit
1df543badc
37
Dockerfile
37
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)"]
|
||||
|
|
|
|||
679
app.R
679
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'})
|
||||
|
||||
}
|
||||
})
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue