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

129
app.R
View File

@ -58,7 +58,7 @@ ui <- fluidPage(
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),
uiOutput("Temoins"),
selectInput("type_comp", "Type de comparaison", multiple = FALSE, choices = c("pairwise","trt.vs.ctrl")),
actionButton("emmeans_button", "EMMEANS",class="btn-primary")
)
@ -353,17 +353,7 @@ 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,{
return(input$var_expliquees)
})
@ -743,18 +733,33 @@ server <- function(input, output, session) {
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)
tryCatch({
merged_data <- merged_data_type()
var_expliquee <- input$var_expliquees
var_explicatives <- input$var_explicatives
form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*")))
mod = lm(as.formula(form),data=merged_data)
anova_table <- as.data.frame(Anova(mod))
for (col in names(anova_table)) {
if (is.numeric(anova_table[[col]])) {
anova_table[[col]] <- round(anova_table[[col]], 3)
}
}
}
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,43 +782,69 @@ 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]
)
}
Temoins(temoins)
})
output$Temoins <- renderUI({
temoins <- Temoins()
if (!is.null(temoins) && length(temoins) > 0) {
div(
lapply(names(temoins), function(col) {
temoins[[col]]
})
)
}
})
observe(
if (length(input$emmeans_explicatives) && !is.null(input$emmeans_expliquees)) {
ref_index <- eventReactive(input$emmeans_button,{
tryCatch({
merged_data <- merged_data_type()
var_expliquee <- input$emmeans_expliquees
var_explicatives <- input$emmeans_explicatives
t = ""
for (col in names(Temoins())) {
t <- paste(t,input[[paste0("temoin_", col)]],collapse = " ")
}
print(t)
t <- substr(t,2,nchar(t))
form1 = as.formula(paste0("~",paste(var_explicatives,collapse = "*")))
form = as.formula(paste0(paste0(var_expliquee,"~"),paste(var_explicatives,collapse = "*")))
mod = lm(form,data=merged_data)
emm <- emmeans(mod,form1)
ref = as.data.frame(emm@grid[,-ncol(emm@grid)])
row_concat <- apply(ref, 1, function(row) {
row_concat <- apply(emm@grid[,-ncol(emm@grid)], 1, function(row) {
paste(row, collapse = " ")
})
updateSelectInput(session, "ind_temoin", choices = row_concat)
}
ind <- which(row_concat == t)
return(ind)
},
error = function(e) {
message('An Error Occurred')
cat("Erreur :", conditionMessage(e), "\n")
traceback()
return(NULL)
},
warning = function(w) {
message('A Warning Occured')
print(w)
formula <- formula(paste(num_column, "~", cat))
a <- leveneTest(formula, data = merged_data)
return(a)
})
)
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,{
@ -836,6 +867,7 @@ server <- function(input, output, session) {
emmeans_table[[col]] <- round(emmeans_table[[col]], 3)
}
}
emmeans_table <- na.omit(emmeans_table)
return(emmeans_table)
})
@ -863,6 +895,7 @@ server <- function(input, output, session) {
emmeans_table[[col]] <- round(emmeans_table[[col]], 3)
}
}
emmeans_table <- na.omit(emmeans_table)
return(emmeans_table)
})