Actualiser app.R
This commit is contained in:
parent
806e5d391f
commit
0bdc2abdda
129
app.R
129
app.R
|
@ -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)
|
||||
|
||||
})
|
||||
|
|
Loading…
Reference in New Issue