Actualiser app.R
This commit is contained in:
parent
cea99f323b
commit
806e5d391f
458
app.R
458
app.R
|
|
@ -20,22 +20,19 @@ ui <- fluidPage(
|
|||
fluidRow(
|
||||
column(4,
|
||||
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),
|
||||
uiOutput("columnTypes"),
|
||||
actionButton("applyTypes", "Appliquer les types de données"),
|
||||
)
|
||||
),
|
||||
column(8,
|
||||
wellPanel(
|
||||
style = 'overflow-x: scroll;height: 450px;',
|
||||
style = 'overflow-x: scroll;height: 950px;',
|
||||
DT::dataTableOutput("merged_data_table")
|
||||
)
|
||||
)
|
||||
),
|
||||
wellPanel(
|
||||
selectInput("ignore_columns", "Colonnes à ignorer :", multiple = TRUE, choices = NULL),
|
||||
selectInput("cat_columns", "Colonnes catégorielles :", multiple = TRUE, choices = NULL),
|
||||
selectInput("cat_id", "Colonne permettant d'identifier les populations :", multiple = FALSE, choices = NULL,selected = "Source"),
|
||||
actionButton("analyze_button", "Analyse statistique",class="btn-primary"),
|
||||
)
|
||||
),
|
||||
navbarMenu("Analyse",
|
||||
tabPanel("Test de Shapiro",
|
||||
|
|
@ -54,15 +51,31 @@ ui <- fluidPage(
|
|||
fluidRow(
|
||||
column(4,
|
||||
wellPanel(
|
||||
selectInput("var_expliquees","Choisir les variables à expliquer",multiple = TRUE,choices = NULL),
|
||||
selectInput("var_explicatives","Choisir les variables explicative",multiple = TRUE,choices = NULL),
|
||||
actionButton("anova_button", "ANOVA",class="btn-primary"),
|
||||
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),
|
||||
selectInput("ind_temoin","Choisir le témoin",multiple = FALSE,choices = NULL),
|
||||
selectInput("type_comp", "Type de comparaison", multiple = FALSE, choices = c("pairwise","trt.vs.ctrl")),
|
||||
actionButton("emmeans_button", "EMMEANS",class="btn-primary")
|
||||
)
|
||||
),
|
||||
column(8,
|
||||
wellPanel(
|
||||
style = 'overflow-x: scroll;height: 450px;',
|
||||
DT::dataTableOutput("anova_table")
|
||||
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")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
|
@ -80,7 +93,22 @@ ui <- fluidPage(
|
|||
DT::dataTableOutput("barlett_table")
|
||||
),
|
||||
tabPanel("Khi 2",
|
||||
DT::dataTableOutput("khi2_table")
|
||||
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("Tous les tests",
|
||||
DT::dataTableOutput("test_table")
|
||||
|
|
@ -125,14 +153,25 @@ ui <- fluidPage(
|
|||
)
|
||||
)
|
||||
),
|
||||
navbarMenu("Modèles",
|
||||
tabPanel("Modèles classiques",
|
||||
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),
|
||||
|
|
@ -142,19 +181,16 @@ ui <- fluidPage(
|
|||
),
|
||||
column(9,
|
||||
fluidRow(
|
||||
wellPanel(
|
||||
plotlyOutput("plotly_acp_graph")
|
||||
),
|
||||
wellPanel(
|
||||
plotlyOutput("pls_acp_graph°")
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
tabPanel("Régression logistique"),
|
||||
tabPanel("Modèle Mixte"),
|
||||
|
||||
),
|
||||
|
||||
|
||||
)
|
||||
)
|
||||
|
||||
|
|
@ -165,31 +201,102 @@ server <- function(input, output, session) {
|
|||
)
|
||||
|
||||
|
||||
convertToFactor <- function(data, columns) {
|
||||
for (col in columns) {
|
||||
data[[col]] <- as.factor(data[[col]])
|
||||
}
|
||||
return(data)
|
||||
}
|
||||
|
||||
# Partie permettant de fusionner les fichiers
|
||||
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) {
|
||||
data <- read_excel(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)-5)
|
||||
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 <- concatenated_table[,colSums(is.na(concatenated_table))==0]
|
||||
|
||||
concatenated_table <- bind_rows(tables)
|
||||
#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({
|
||||
|
|
@ -199,30 +306,47 @@ server <- function(input, output, session) {
|
|||
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, "cat_columns",
|
||||
choices = setdiff(colnames(merged_data()),input$ignore_columns), selected = "Source")
|
||||
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, "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))))
|
||||
})
|
||||
|
||||
#On utilise une fonction permettant d'obternir la liste des variables numériques
|
||||
num_columns <- eventReactive(input$cat_columns,{
|
||||
a <- colnames(merged_data())
|
||||
a <- setdiff(a,input$ignore_columns)
|
||||
a <- setdiff(a,input$cat_columns)
|
||||
return(a)
|
||||
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$cat_columns,{
|
||||
return(input$cat_columns)
|
||||
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$analyze_button,{
|
||||
columns <- eventReactive(input$applyTypes,{
|
||||
a <- colnames(merged_data())
|
||||
a <- setdiff(a,input$ignore_columns)
|
||||
return(a)
|
||||
|
|
@ -232,16 +356,14 @@ server <- function(input, output, session) {
|
|||
observe({
|
||||
updateSelectInput(session, "cat_id",
|
||||
choices = cat_col(), selected = "Source")
|
||||
|
||||
updateSelectInput(session,"var_expliquees",choices=columns(),selected = "")
|
||||
})
|
||||
|
||||
cat_id <- eventReactive(input$cat_id,{
|
||||
return(input$cat_id)
|
||||
})
|
||||
|
||||
observe({
|
||||
updateSelectInput(session,"var_expliquees",choices=colnames(merged_data()))
|
||||
})
|
||||
|
||||
explicative_col <- eventReactive(input$files,{
|
||||
return(input$var_expliquees)
|
||||
})
|
||||
|
|
@ -264,15 +386,12 @@ server <- function(input, output, session) {
|
|||
#Cette partie gère la partie "Graphiques"
|
||||
|
||||
observe({
|
||||
if (!is.null(cat_id())){
|
||||
updateSelectInput(session,"dataset_graph",
|
||||
choices = c("cars","airquality","iris","All data"))
|
||||
}
|
||||
})
|
||||
|
||||
|
||||
data <- eventReactive(input$dataset_graph,{
|
||||
cat_id <- cat_id()
|
||||
if (input$dataset_graph == 'cars') {
|
||||
return(datasets::cars)
|
||||
}
|
||||
|
|
@ -282,19 +401,15 @@ server <- function(input, output, session) {
|
|||
if (input$dataset_graph == "iris"){
|
||||
return(datasets::iris)
|
||||
}
|
||||
if (input$dataset_graph %in% liste_source()){
|
||||
return(as.data.frame(merged_data()[merged_data()[[cat_id]]==input$dataset_graph,columns()]))
|
||||
}
|
||||
if (input$dataset_graph == 'All data') {
|
||||
|
||||
return(merged_data())
|
||||
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(colnames(data())))
|
||||
updateSelectInput(session,"graph_fill", choices = c("None",colnames(data())),selected = "None")
|
||||
|
||||
})
|
||||
|
||||
|
|
@ -303,14 +418,25 @@ server <- function(input, output, session) {
|
|||
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))
|
||||
} 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),legend=list(title=list(text=input$graph_fill)))
|
||||
p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y))
|
||||
}
|
||||
|
||||
return(p)
|
||||
return(ggplotly(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))
|
||||
} 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))
|
||||
}
|
||||
|
||||
return(p)
|
||||
}
|
||||
if (input$type_graph == 'Density plot'){
|
||||
|
|
@ -319,13 +445,25 @@ server <- function(input, output, session) {
|
|||
return(ggplotly(p))
|
||||
}
|
||||
if (input$type_graph == 'Histograme'){
|
||||
if (input$graph_fill == 'None') {
|
||||
p <- ggplot(data(), aes_string(x=input$graph_x)) +
|
||||
geom_histogram()
|
||||
} else {
|
||||
p <- ggplot(data(), aes_string(x=input$graph_x,color=input$graph_fill)) +
|
||||
geom_histogram()
|
||||
}
|
||||
|
||||
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))
|
||||
} 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)))
|
||||
}
|
||||
|
||||
return(p)
|
||||
}
|
||||
|
||||
|
|
@ -604,46 +742,26 @@ server <- function(input, output, session) {
|
|||
|
||||
|
||||
|
||||
anova_table <- eventReactive(input$analyze_button,{
|
||||
cat_col <- input$cat_columns
|
||||
num_col <- num_columns()
|
||||
anova_table = data.frame()
|
||||
merged_data <- merged_data()
|
||||
cat_id <- input$cat_id
|
||||
|
||||
for (cat in cat_col) {
|
||||
for (col in num_col) {
|
||||
tryCatch({
|
||||
formula <- formula(paste(col, "~", cat, "*",cat_id()))
|
||||
model <- lm(formula, data = na.omit(merged_data))
|
||||
anova_result <- Anova(model)
|
||||
anova_result <- as.data.frame(cbind(rownames(anova_result),anova_result))
|
||||
anova_result["Col"] <- col
|
||||
anova_result["Cat"] <- cat
|
||||
anova_table <- rbind(anova_table,anova_result)
|
||||
|
||||
},
|
||||
error=function(e) {
|
||||
message('An Error Occurred')
|
||||
cat("Erreur :", conditionMessage(e), "\n")
|
||||
traceback()
|
||||
},
|
||||
warning=function(w) {
|
||||
message('A Warning Occured')
|
||||
print(w)
|
||||
return(NA)
|
||||
})
|
||||
|
||||
|
||||
anova_table <- eventReactive(input$anova_button,{
|
||||
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)
|
||||
}
|
||||
}
|
||||
colnames(anova_table) <- c("Nom colonne","Sum Sq","Degré Df","F-value","Pr(>F)","Colonne","Catégorie")
|
||||
rownames(anova_table) <- c(1:nrow(anova_table))
|
||||
return(anova_table)
|
||||
|
||||
})
|
||||
|
||||
|
||||
|
||||
output$anova_table <- renderDataTable(anova_table(),
|
||||
extensions = "Buttons",
|
||||
options = list(
|
||||
pageLength = 10,
|
||||
autoWidth = TRUE,
|
||||
|
|
@ -651,8 +769,142 @@ server <- function(input, output, session) {
|
|||
)
|
||||
)
|
||||
|
||||
output$anova_button_download <- downloadHandler(
|
||||
filename = function(){"anova_results.csv"},
|
||||
content = function(fname){
|
||||
write.csv(anova_table(), fname)
|
||||
}
|
||||
)
|
||||
|
||||
kw_table <- eventReactive(input$analyze_button,{
|
||||
|
||||
|
||||
|
||||
observe(
|
||||
if (length(input$emmeans_explicatives) && !is.null(input$emmeans_expliquees)) {
|
||||
merged_data <- merged_data_type()
|
||||
var_expliquee <- input$emmeans_expliquees
|
||||
var_explicatives <- input$emmeans_explicatives
|
||||
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)
|
||||
ref = as.data.frame(emm@grid[,-ncol(emm@grid)])
|
||||
row_concat <- apply(ref, 1, function(row) {
|
||||
paste(row, collapse = " ")
|
||||
})
|
||||
updateSelectInput(session, "ind_temoin", choices = row_concat)
|
||||
}
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
ref_index <- eventReactive(input$ind_temoin,{
|
||||
merged_data <- merged_data_type()
|
||||
var_expliquee <- input$emmeans_expliquees
|
||||
var_explicatives <- input$emmeans_explicatives
|
||||
ind_temoin <- input$ind_temoin
|
||||
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 == ind_temoin)
|
||||
return(ind)
|
||||
})
|
||||
|
||||
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)
|
||||
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)
|
||||
}
|
||||
}
|
||||
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)
|
||||
}
|
||||
}
|
||||
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$applyTypes,{
|
||||
cat_col <- input$cat_columns
|
||||
num_col <- num_columns()
|
||||
kw_table = data.frame()
|
||||
|
|
@ -693,21 +945,19 @@ server <- function(input, output, session) {
|
|||
)
|
||||
|
||||
|
||||
khi2_table <- eventReactive(input$files,{
|
||||
cat_col <- input$cat_columns
|
||||
num_col <- num_columns()
|
||||
khi2_table <- eventReactive(input$khi2_button,{
|
||||
cat_col <- input$khi2_cat
|
||||
num_col <- input$khi2_num
|
||||
khi2_table = data.frame()
|
||||
merged_data <- merged_data()
|
||||
cat_id <- input$cat_id
|
||||
|
||||
liste_source <- liste_source()
|
||||
for (i in 1:(length(cat_col)-1)){
|
||||
for (j in (i+1):length(cat_col)){
|
||||
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)
|
||||
})
|
||||
|
|
@ -720,6 +970,12 @@ server <- function(input, output, session) {
|
|||
)
|
||||
)
|
||||
|
||||
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,{
|
||||
|
|
@ -739,7 +995,7 @@ server <- function(input, output, session) {
|
|||
|
||||
|
||||
#On gère ici la partie contrasts du test d'emmeans
|
||||
contrasts_result <- eventReactive(input$analyze_button, {
|
||||
contrasts_result <- eventReactive(input$applyTypes, {
|
||||
cat_col <- input$cat_columns
|
||||
num_col <- num_columns()
|
||||
result_contrasts <- data.frame()
|
||||
|
|
@ -765,7 +1021,7 @@ server <- function(input, output, session) {
|
|||
|
||||
|
||||
#On gère ici l'autre partie du test d'emmeans
|
||||
emmeans_result <- eventReactive(input$analyze_button,{
|
||||
emmeans_result <- eventReactive(input$applyTypes,{
|
||||
cat_col <- input$cat_columns
|
||||
num_col <- num_columns()
|
||||
result_emmeans = data.frame()
|
||||
|
|
|
|||
Loading…
Reference in New Issue