Actualiser app.R

This commit is contained in:
aslane 2024-01-30 14:40:19 +00:00
parent 806e5d391f
commit 0bdc2abdda
1 changed files with 81 additions and 48 deletions

99
app.R
View File

@ -58,7 +58,7 @@ ui <- fluidPage(
wellPanel( wellPanel(
selectInput("emmeans_expliquees","Choisir la variable à expliquer",multiple = FALSE,choices = NULL), selectInput("emmeans_expliquees","Choisir la variable à expliquer",multiple = FALSE,choices = NULL),
selectInput("emmeans_explicatives","Choisir les variables explicatives",multiple = TRUE,choices = NULL), selectInput("emmeans_explicatives","Choisir les variables explicatives",multiple = TRUE,choices = NULL),
selectInput("ind_temoin","Choisir le témoin",multiple = FALSE,choices = NULL), uiOutput("Temoins"),
selectInput("type_comp", "Type de comparaison", multiple = FALSE, choices = c("pairwise","trt.vs.ctrl")), selectInput("type_comp", "Type de comparaison", multiple = FALSE, choices = c("pairwise","trt.vs.ctrl")),
actionButton("emmeans_button", "EMMEANS",class="btn-primary") actionButton("emmeans_button", "EMMEANS",class="btn-primary")
) )
@ -353,16 +353,6 @@ 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)
})
explicative_col <- eventReactive(input$files,{ explicative_col <- eventReactive(input$files,{
return(input$var_expliquees) return(input$var_expliquees)
@ -743,6 +733,7 @@ server <- function(input, output, session) {
anova_table <- eventReactive(input$anova_button,{ anova_table <- eventReactive(input$anova_button,{
tryCatch({
merged_data <- merged_data_type() merged_data <- merged_data_type()
var_expliquee <- input$var_expliquees var_expliquee <- input$var_expliquees
var_explicatives <- input$var_explicatives var_explicatives <- input$var_explicatives
@ -755,6 +746,20 @@ server <- function(input, output, session) {
} }
} }
return(anova_table) return(anova_table)
},
error = function(e) {
message('An Error Occurred')
cat("Erreur :", conditionMessage(e), "\n")
traceback()
return(NULL)
},
warning = function(w) {
message('A Warning Occured')
print(w)
formula <- formula(paste(num_column, "~", cat))
a <- leveneTest(formula, data = merged_data)
return(a)
})
}) })
@ -777,34 +782,45 @@ server <- function(input, output, session) {
) )
Temoins <- reactiveVal(list())
observe({
observe( data <- merged_data()
if (length(input$emmeans_explicatives) && !is.null(input$emmeans_expliquees)) { temoins <- list()
merged_data <- merged_data_type() for (col in input$emmeans_explicatives) {
var_expliquee <- input$emmeans_expliquees temoins[[col]] <- selectInput(
var_explicatives <- input$emmeans_explicatives inputId = paste0("temoin_", col),
form1 = as.formula(paste0("~",paste(var_explicatives,collapse = "*"))) label = col,
form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*"))) choices = unique(data[[col]]),
mod = lm(form,data=merged_data) selected = unique(data[[col]])[1]
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)
}
) )
}
Temoins(temoins)
})
output$Temoins <- renderUI({
temoins <- Temoins()
if (!is.null(temoins) && length(temoins) > 0) {
div(
lapply(names(temoins), function(col) {
temoins[[col]]
})
)
}
})
ref_index <- eventReactive(input$emmeans_button,{
tryCatch({
ref_index <- eventReactive(input$ind_temoin,{
merged_data <- merged_data_type() merged_data <- merged_data_type()
var_expliquee <- input$emmeans_expliquees var_expliquee <- input$emmeans_expliquees
var_explicatives <- input$emmeans_explicatives var_explicatives <- input$emmeans_explicatives
ind_temoin <- input$ind_temoin t = ""
for (col in names(Temoins())) {
t <- paste(t,input[[paste0("temoin_", col)]],collapse = " ")
}
print(t)
t <- substr(t,2,nchar(t))
form1 = as.formula(paste0("~",paste(var_explicatives,collapse = "*"))) form1 = as.formula(paste0("~",paste(var_explicatives,collapse = "*")))
form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*"))) form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*")))
mod = lm(form,data=merged_data) mod = lm(form,data=merged_data)
@ -812,8 +828,23 @@ server <- function(input, output, session) {
row_concat <- apply(emm@grid[,-ncol(emm@grid)], 1, function(row) { row_concat <- apply(emm@grid[,-ncol(emm@grid)], 1, function(row) {
paste(row, collapse = " ") paste(row, collapse = " ")
}) })
ind <- which(row_concat == ind_temoin) ind <- which(row_concat == t)
return(ind) return(ind)
},
error = function(e) {
message('An Error Occurred')
cat("Erreur :", conditionMessage(e), "\n")
traceback()
return(NULL)
},
warning = function(w) {
message('A Warning Occured')
print(w)
formula <- formula(paste(num_column, "~", cat))
a <- leveneTest(formula, data = merged_data)
return(a)
})
}) })
emmeans_table <- eventReactive(input$emmeans_button,{ emmeans_table <- eventReactive(input$emmeans_button,{
@ -836,6 +867,7 @@ server <- function(input, output, session) {
emmeans_table[[col]] <- round(emmeans_table[[col]], 3) emmeans_table[[col]] <- round(emmeans_table[[col]], 3)
} }
} }
emmeans_table <- na.omit(emmeans_table)
return(emmeans_table) return(emmeans_table)
}) })
@ -863,6 +895,7 @@ server <- function(input, output, session) {
emmeans_table[[col]] <- round(emmeans_table[[col]], 3) emmeans_table[[col]] <- round(emmeans_table[[col]], 3)
} }
} }
emmeans_table <- na.omit(emmeans_table)
return(emmeans_table) return(emmeans_table)
}) })