From aedca65e23f9be10d6391047e0c25e0ead281bc7 Mon Sep 17 00:00:00 2001 From: Konrad1991 Date: Thu, 12 Dec 2024 16:27:42 +0100 Subject: [PATCH] refactored the split dataframe by column and evoke formula editor. The UI and the server code is now handled in MainApp.R and not in each individual tab --- bs/R/DoseResponse.R | 86 ----------- bs/R/MainApp.R | 307 ++++++++++++++++++++++------------------ bs/R/assumption.R | 221 ++++++++++------------------- bs/R/correlation.R | 91 ------------ bs/R/statisticalTests.R | 227 ++++++++++------------------- bs/R/visualisation.R | 58 +------- 6 files changed, 316 insertions(+), 674 deletions(-) diff --git a/bs/R/DoseResponse.R b/bs/R/DoseResponse.R index 5a13019..41765e3 100644 --- a/bs/R/DoseResponse.R +++ b/bs/R/DoseResponse.R @@ -4,13 +4,6 @@ DoseResponseSidebarUI <- function(id) { div( style = "position: relative;", br(), - div( - class = "boxed-output", - uiOutput(NS(id, "open_split_by_group")), - uiOutput(NS(id, "data_splitted")), - verbatimTextOutput(NS(id, "applied_filter")) - ), - br(), uiOutput(NS(id, "substanceNamesUI")), checkboxInput( NS(id, "xTransform"), @@ -90,85 +83,6 @@ DoseResponseServer <- function(id, data, listResults) { ) }) - # Render split by group - output[["open_split_by_group"]] <- renderUI({ - actionButton(NS(id, "open_split_by_group"), - "Open the split by group functionality", - title = "Open the split by group helper window", - disabled = is.null(data$df) || !is.data.frame(data$df) || !is.null(data$backup_df) - ) - }) - - observeEvent(input[["open_split_by_group"]], { - showModal(modalDialog( - title = "SplitByGroup", - SplitByGroupUI("SG"), - easyClose = TRUE, - size = "l", - footer = NULL - )) - }) - - # check if data is splitted - output$data_splitted <- renderUI({ - actionButton(NS(id, "remove_filter"), - "Remove the filter from the dataset", - title = "remove the filter of the dataset", - disabled = is.null(data$backup_df) || !is.data.frame(data$backup_df) - ) - }) - - observe({ - output$applied_filter <- renderText(NULL) - req(!is.null(data$filter_col)) - req(!is.null(data$filter_group)) - output$applied_filter <- renderText({ - paste( - "The dataset is splitted by the variable(s): [", - paste(data$filter_col, collapse = ", "), - "] group(s) are set to: [", - paste(data$filter_group, collapse = ", "), - "]" - ) - }) - }) - - # Remove filter - observeEvent(input[["remove_filter"]], { - data$df <- data$backup_df - data$backup_df <- NULL - data$filter_col <- NULL - data$filter_group <- NULL - }) - - output$open_formula_editor_corr <- renderUI({ - actionButton(NS(id, "open_formula_editor"), - "Open formula editor", - title = "Open the formula editor to create or modify a formula", - disabled = is.null(data$df) || !is.data.frame(data$df) - ) - }) - - observeEvent(input[["open_formula_editor"]], { - showModal(modalDialog( - title = "FormulaEditor", - FormulaEditorUI("FO"), - easyClose = TRUE, - size = "l", - footer = tagList( - modalButton("Close") - ) - )) - }) - - # display current formula - observe({ - req(!is.null(data$formula)) - output$formula <- renderText({ - deparse(data$formula) - }) - }) - reset_dr <- function() { r_vals$plots <- NULL r_vals$names <- NULL diff --git a/bs/R/MainApp.R b/bs/R/MainApp.R index cad450e..0878a8c 100644 --- a/bs/R/MainApp.R +++ b/bs/R/MainApp.R @@ -10,94 +10,48 @@ app <- function() { sidebarLayout( sidebarPanel( div( - class = "boxed-output", - uiOutput("open_formula_editor_corr"), - verbatimTextOutput("formula") + style = "position: relative", + actionButton( + "docu", + label = NULL, + icon = icon("question-circle") + ) ), + uiOutput("open_formula_editor_main"), + verbatimTextOutput("formula"), + br(), + uiOutput("open_split_by_group"), + uiOutput("data_splitted"), + verbatimTextOutput("applied_filter"), + br(), div( conditionalPanel( condition = "input.conditionedPanels == 'Data'", - div( - style = "position: relative", - actionButton( - "data_docu", - label = NULL, - icon = icon("question-circle") - ) - ), uiOutput("conditional_data_ui"), tags$hr() ), conditionalPanel( condition = "input.conditionedPanels == 'DataWrangling'", - div( - style = "position: relative", - actionButton( - "datawrangling_docu", - label = NULL, - icon = icon("question-circle") - ) - ), OperatorEditorSidebar("OP") ), conditionalPanel( condition = "input.conditionedPanels == 'Visualisation'", - div( - style = "position: relative;", - actionButton( - "visualization_docu", - label = NULL, - icon = icon("question-circle") - ) - ), visSidebarUI("VIS") ), conditionalPanel( condition = "input.conditionedPanels == 'Assumption'", - div( - style = "position: relative", - actionButton( - "ass_docu", - label = NULL, - icon = icon("question-circle") - ) - ), assSidebarUI("ASS") ), conditionalPanel( condition = "input.conditionedPanels == 'Correlation'", - div( - style = "position: relative", - actionButton( - "corr_docu", - label = NULL, - icon = icon("question-circle") - ) - ), corrSidebarUI("CORR") ), conditionalPanel( condition = "input.conditionedPanels == 'Tests'", - div( - style = "position: relative", - actionButton( - "test_docu", - label = NULL, - icon = icon("question-circle") - ) - ), testsSidebarUI("TESTS") ), conditionalPanel( condition = "input.conditionedPanels == 'Dose Response analysis'", - div( - style = "position: relative;", - actionButton( - "doseresponse_docu", - label = NULL, - icon = icon("question-circle") - ) - ), DoseResponseSidebarUI("DOSERESPONSE") ) ) @@ -151,84 +105,80 @@ app <- function() { counter = 0 ) - # docu data - observeEvent(input[["data_docu"]], { - showModal(modalDialog( - title = "Example Dataframe", - includeHTML(system.file("www/data.html", package = "bs")), - easyClose = TRUE, - footer = NULL - )) - }) - observeEvent(input[["datawrangling_docu"]], { - showModal(modalDialog( - title = "Data wrangling", - includeHTML(system.file("www/operations.html", package = "bs")), - easyClose = TRUE, - footer = NULL - )) - }) - observeEvent(input[["corr_docu"]], { - showModal(modalDialog( - title = "Correlation", - includeHTML(system.file("www/data.html", package = "bs")), - easyClose = TRUE, - footer = NULL - )) - }) - observeEvent(input[["ass_docu"]], { - showModal(modalDialog( - title = "Testing assumptions", - includeHTML(system.file("www/assumptions.html", package = "bs")), - easyClose = TRUE, - footer = NULL - )) - }) - observeEvent(input[["test_docu"]], { - showModal(modalDialog( - title = "Statistical tests", - includeHTML(system.file("www/tests.html", package = "bs")), - easyClose = TRUE, - footer = NULL - )) - }) - # docu dose response - observeEvent(input[["doseresponse_docu"]], { - showModal(modalDialog( - title = "Doseresponse analysis", - includeHTML(system.file("www/doseresponse.html", package = "bs")), - easyClose = TRUE, - footer = NULL - )) - }) - # docu visualisation - observeEvent(input[["visualization_docu"]], { - showModal(modalDialog( - title = "Visualization", - includeHTML(system.file("www/visualization1.html", package = "bs")), - br(), - renderImage( - { - list( - src = system.file("www/DocuPlot.jpg", package = "bs"), - contentType = "image/jpg", - width = 650, - height = 500, - alt = "Basic Plot" - ) - }, - deleteFile = FALSE - ), - br(), - br(), - br(), - br(), - br(), - includeHTML(system.file("www/visualization2.html", package = "bs")), - easyClose = TRUE, - footer = NULL, - size = "l" - )) + # docu + observeEvent(input[["docu"]], { + if (input$conditionedPanels == "Data") { + showModal(modalDialog( + title = "Example Dataframe", + includeHTML(system.file("www/data.html", package = "bs")), + easyClose = TRUE, + footer = NULL + )) + } else if (input$conditionedPanels == "DataWrangling") { + showModal(modalDialog( + title = "Data wrangling", + includeHTML(system.file("www/operations.html", package = "bs")), + easyClose = TRUE, + footer = NULL + )) + }else if (input$conditionedPanels == "Visualisation") { + showModal(modalDialog( + title = "Visualization", + includeHTML(system.file("www/visualization1.html", package = "bs")), + br(), + renderImage( + { + list( + src = system.file("www/DocuPlot.jpg", package = "bs"), + contentType = "image/jpg", + width = 650, + height = 500, + alt = "Basic Plot" + ) + }, + deleteFile = FALSE + ), + br(), + br(), + br(), + br(), + br(), + includeHTML(system.file("www/visualization2.html", package = "bs")), + easyClose = TRUE, + footer = NULL, + size = "l" + )) + + }else if (input$conditionedPanels == "Assumption") { + showModal(modalDialog( + title = "Testing assumptions", + includeHTML(system.file("www/assumptions.html", package = "bs")), + easyClose = TRUE, + footer = NULL + )) + }else if (input$conditionedPanels == "Correlation") { + showModal(modalDialog( + title = "Correlation", + includeHTML(system.file("www/data.html", package = "bs")), + easyClose = TRUE, + footer = NULL + )) + }else if (input$conditionedPanels == "Tests") { + showModal(modalDialog( + title = "Statistical tests", + includeHTML(system.file("www/tests.html", package = "bs")), + easyClose = TRUE, + footer = NULL + )) + }else if (input$conditionedPanels == "Dose Response analysis") { + + showModal(modalDialog( + title = "Doseresponse analysis", + includeHTML(system.file("www/doseresponse.html", package = "bs")), + easyClose = TRUE, + footer = NULL + )) + } }) # docu formula editor observeEvent(input[["FO-formula_docu"]], { @@ -443,6 +393,89 @@ app <- function() { }) }) + # Observe open formula editor + output$open_formula_editor_main <- renderUI({ + if (input$conditionedPanels == "DataWrangling" || + input$conditionedPanels == "Visualisation") { + return() + } + div( + class = "boxed-output", + actionButton("open_formula_editor", + "Open formula editor", + title = "Open the formula editor to create or modify a formula", + disabled = is.null(dataSet$df) || !is.data.frame(dataSet$df) + )) + }) + observeEvent(input[["open_formula_editor"]], { + showModal(modalDialog( + title = "FormulaEditor", + FormulaEditorUI("FO"), + easyClose = TRUE, + size = "l", + footer = tagList( + modalButton("Close") + ) + )) + }) + # display current formula + observe({ + req(!is.null(dataSet$formula)) + output$formula <- renderText({ + deparse(dataSet$formula) + }) + }) + + # Render split by group + output[["open_split_by_group"]] <- renderUI({ + if (input$conditionedPanels == "DataWrangling") return() + div( + class = "boxed-output", + actionButton("open_split_by_group", + "Open the split by group functionality", + title = "Open the split by group helper window", + disabled = is.null(dataSet$df) || + !is.data.frame(dataSet$df) || + !is.null(dataSet$backup_df) + ), + actionButton("remove_filter", + "Remove the filter from the dataset", + title = "remove the filter of the dataset", + disabled = is.null(dataSet$backup_df) || !is.data.frame(dataSet$backup_df) + ) + ) + }) + observeEvent(input[["open_split_by_group"]], { + showModal(modalDialog( + title = "SplitByGroup", + SplitByGroupUI("SG"), + easyClose = TRUE, + size = "l", + footer = NULL + )) + }) + observe({ + output$applied_filter <- renderText(NULL) + req(!is.null(dataSet$filter_col)) + req(!is.null(dataSet$filter_group)) + output$applied_filter <- renderText({ + paste( + "The dataset is splitted by the variable(s): [", + paste(dataSet$filter_col, collapse = ", "), + "] group(s) are set to: [", + paste(dataSet$filter_group, collapse = ", "), + "]" + ) + }) + }) + # Remove filter + observeEvent(input[["remove_filter"]], { + dataSet$df <-dataSet$backup_df + dataSet$backup_df <- NULL + dataSet$filter_col <- NULL + dataSet$filter_group <- NULL + }) + observeEvent(input$download, { print_req(is_valid_filename(input$user_filename), "Defined filename is not valid") print_req(length(listResults$all_data) > 0, "No results to save") diff --git a/bs/R/assumption.R b/bs/R/assumption.R index 8ba2bfe..b4049f5 100644 --- a/bs/R/assumption.R +++ b/bs/R/assumption.R @@ -2,18 +2,6 @@ assSidebarUI <- function(id) { tabPanel( "Assumption", tags$hr(), - div( - class = "boxed-output", - uiOutput(NS(id, "open_formula_editor_corr")), - verbatimTextOutput(NS(id, "formula")) - ), - div( - class = "boxed-output", - uiOutput(NS(id, "open_split_by_group")), - uiOutput(NS(id, "data_splitted")), - verbatimTextOutput(NS(id, "applied_filter")) - ), - tags$hr(), tags$div( class = "header", checked = NA, tags$h4( @@ -23,12 +11,13 @@ assSidebarUI <- function(id) { ), actionButton(NS(id, "shapiro"), "Shapiro test for individual groups", - title = - "Use this test if you have a formula like 'response ~ pred1 * pred2' (two-way ANOVA) to check normality of residuals within each group."), + title = + "Use this test if you have a formula like 'response ~ pred1 * pred2' (two-way ANOVA) to check normality of residuals within each group." + ), tags$hr(), actionButton(NS(id, "shapiroResiduals"), "Shapiro test for residuals of linear model", - title = - "Use this test if you have a formula like 'response ~ predictor1' to check normality of the residuals of the linear model." + title = + "Use this test if you have a formula like 'response ~ predictor1' to check normality of the residuals of the linear model." ), tags$hr(), tags$div( @@ -61,83 +50,6 @@ assUI <- function(id) { assServer <- function(id, data, listResults) { moduleServer(id, function(input, output, session) { - # Render split by group - output[["open_split_by_group"]] <- renderUI({ - actionButton(NS(id, "open_split_by_group"), - "Open the split by group functionality", - title = "Open the split by group helper window", - disabled = is.null(data$df) || !is.data.frame(data$df) || !is.null(data$backup_df) - ) - }) - - observeEvent(input[["open_split_by_group"]], { - showModal(modalDialog( - title = "SplitByGroup", - SplitByGroupUI("SG"), - easyClose = TRUE, - size = "l", - footer = NULL - )) - }) - - # check if data is splitted - output$data_splitted <- renderUI({ - actionButton(NS(id, "remove_filter"), - "Remove the filter from the dataset", - title = "remove the filter of the dataset", - disabled = is.null(data$backup_df) || !is.data.frame(data$backup_df) - ) - }) - - observe({ - output$applied_filter <- renderText(NULL) - req(!is.null(data$filter_col)) - req(!is.null(data$filter_group)) - output$applied_filter <- renderText({ - paste( - "The dataset is splitted by the variable(s): [", - paste(data$filter_col, collapse = ", "), - "] group(s) are set to: [", - paste(data$filter_group, collapse = ", "), - "]" - ) - }) - }) - - # Remove filter - observeEvent(input[["remove_filter"]], { - data$df <- data$backup_df - data$backup_df <- NULL - data$filter_col <- NULL - data$filter_group <- NULL - }) - - output$open_formula_editor_corr <- renderUI({ - actionButton(NS(id, "open_formula_editor"), - "Open formula editor", - title = "Open the formula editor to create or modify a formula", - disabled = is.null(data$df) || !is.data.frame(data$df) - ) - }) - - observeEvent(input[["open_formula_editor"]], { - showModal(modalDialog( - title = "FormulaEditor", - FormulaEditorUI("FO"), - easyClose = TRUE, - size = "l", - footer = tagList( - modalButton("Close") - ) - )) - }) - - # display current formula - observe({ - req(!is.null(data$formula)) - output$formula <- renderText({deparse(data$formula)}) - }) - runShapiro <- function() { df <- data$df print_req(is.data.frame(df), "The dataset is missing") @@ -149,29 +61,33 @@ assServer <- function(id, data, listResults) { err <- NULL if (isTRUE(check)) { res <- list() - e <- try({ - res <- withCallingHandlers({ - dat <- splitData(df, formula) - for (i in unique(dat[, 2])) { - tempDat <- dat[dat[, 2] == i, ] - temp <- broom::tidy(shapiro.test(tempDat[, 1])) - if (!is.null(temp)) { - temp$variable <- i - temp$`Normal distributed` <- temp$p.value > 0.05 - res[[length(res) + 1]] <- temp + e <- try( + { + res <- withCallingHandlers( + { + dat <- splitData(df, formula) + for (i in unique(dat[, 2])) { + tempDat <- dat[dat[, 2] == i, ] + temp <- broom::tidy(shapiro.test(tempDat[, 1])) + if (!is.null(temp)) { + temp$variable <- i + temp$`Normal distributed` <- temp$p.value > 0.05 + res[[length(res) + 1]] <- temp + } + } + res <- do.call(rbind, res) + }, + warning = function(warn) { + print_warn(warn$message) + invokeRestart("muffleWarning") } - } - res <- do.call(rbind, res) + ) }, - warning = function(warn) { - print_warn(warn$message) - invokeRestart("muffleWarning") - } - ) - }, silent = TRUE) + silent = TRUE + ) if (!inherits(e, "try-error")) { exportTestValues( - assumption_res = res + assumption_res = res ) listResults$counter <- listResults$counter + 1 new_name <- paste0( @@ -194,22 +110,26 @@ assServer <- function(id, data, listResults) { print_form(data$formula) formula <- data$formula res <- NULL - e <- try({ - withCallingHandlers({ - fit <- lm(formula, data = df) - r <- resid(fit) - res <- broom::tidy(shapiro.test(r)) - res$`Residuals normal distributed` <- res$p.value > 0.05 + e <- try( + { + withCallingHandlers( + { + fit <- lm(formula, data = df) + r <- resid(fit) + res <- broom::tidy(shapiro.test(r)) + res$`Residuals normal distributed` <- res$p.value > 0.05 + }, + warning = function(warn) { + print_warn(warn$message) + invokeRestart("muffleWarning") + } + ) }, - warning = function(warn) { - print_warn(warn$message) - invokeRestart("muffleWarning") - } - ) - }, silent = TRUE) + silent = TRUE + ) if (!inherits(e, "try-error")) { exportTestValues( - assumption_res = res + assumption_res = res ) listResults$counter <- listResults$counter + 1 new_name <- paste0( @@ -231,23 +151,27 @@ assServer <- function(id, data, listResults) { print_form(data$formula) formula <- data$formula fit <- NULL - e <- try({ - withCallingHandlers({ - fit <- broom::tidy(car::leveneTest(formula, data = df, center = input$center)) - fit$`Variance homogenity` <- fit$p.value > 0.05 + e <- try( + { + withCallingHandlers( + { + fit <- broom::tidy(car::leveneTest(formula, data = df, center = input$center)) + fit$`Variance homogenity` <- fit$p.value > 0.05 + }, + warning = function(warn) { + print_warn(warn$message) + invokeRestart("muffleWarning") + } + ) }, - warning = function(warn) { - print_warn(warn$message) - invokeRestart("muffleWarning") - } - ) - }, silent = TRUE) + silent = TRUE + ) if (inherits(e, "try-error")) { err <- conditionMessage(attr(e, "condition")) print_err(err) } else { exportTestValues( - assumption_res = fit + assumption_res = fit ) listResults$counter <- listResults$counter + 1 new_name <- paste0( @@ -266,22 +190,26 @@ assServer <- function(id, data, listResults) { print_form(data$formula) formula <- data$formula p <- NULL - e <- try({ - withCallingHandlers({ - p <- diagnosticPlots(df, formula) + e <- try( + { + withCallingHandlers( + { + p <- diagnosticPlots(df, formula) + }, + warning = function(warn) { + print_warn(warn$message) + invokeRestart("muffleWarning") + } + ) }, - warning = function(warn) { - print_warn(warn$message) - invokeRestart("muffleWarning") - } - ) - }, silent = TRUE) + silent = TRUE + ) if (inherits(e, "try-error")) { err <- conditionMessage(attr(e, "condition")) print_err(err) } else { exportTestValues( - assumption_res = p + assumption_res = p ) listResults$counter <- listResults$counter + 1 new_result_name <- paste0("DiagnosticPlotNr", listResults$counter) @@ -293,7 +221,6 @@ assServer <- function(id, data, listResults) { observeEvent(input$DiagnosticPlot, { runDiagnosticPlot() }) - }) return(listResults) diff --git a/bs/R/correlation.R b/bs/R/correlation.R index 7b43d91..e989077 100644 --- a/bs/R/correlation.R +++ b/bs/R/correlation.R @@ -1,18 +1,6 @@ corrSidebarUI <- function(id) { tabPanel( "Correlation", - div( - class = "boxed-output", - uiOutput(NS(id, "open_formula_editor_corr")), - verbatimTextOutput(NS(id, "formula")) - ), - br(), - div( - class = "boxed-output", - uiOutput(NS(id, "open_split_by_group")), - uiOutput(NS(id, "data_splitted")), - verbatimTextOutput(NS(id, "applied_filter")) - ), br(), sliderInput(NS(id, "conflevel"), "Confidence level of the interval", min = 0, max = 1, value = 0.95 @@ -46,85 +34,6 @@ corrUI <- function(id) { corrServer <- function(id, data, listResults) { moduleServer(id, function(input, output, session) { - # Render split by group - output[["open_split_by_group"]] <- renderUI({ - actionButton(NS(id, "open_split_by_group"), - "Open the split by group functionality", - title = "Open the split by group helper window", - disabled = is.null(data$df) || !is.data.frame(data$df) || !is.null(data$backup_df) - ) - }) - - observeEvent(input[["open_split_by_group"]], { - showModal(modalDialog( - title = "SplitByGroup", - SplitByGroupUI("SG"), - easyClose = TRUE, - size = "l", - footer = NULL - )) - }) - - # check if data is splitted - output$data_splitted <- renderUI({ - actionButton(NS(id, "remove_filter"), - "Remove the filter from the dataset", - title = "remove the filter of the dataset", - disabled = is.null(data$backup_df) || !is.data.frame(data$backup_df) - ) - }) - - observe({ - output$applied_filter <- renderText(NULL) - req(!is.null(data$filter_col)) - req(!is.null(data$filter_group)) - output$applied_filter <- renderText({ - paste( - "The dataset is splitted by the variable(s): [", - paste(data$filter_col, collapse = ", "), - "] group(s) are set to: [", - paste(data$filter_group, collapse = ", "), - "]" - ) - }) - }) - - # Remove filter - observeEvent(input[["remove_filter"]], { - data$df <- data$backup_df - data$backup_df <- NULL - data$filter_col <- NULL - data$filter_group <- NULL - }) - - # render formula button - output$open_formula_editor_corr <- renderUI({ - actionButton(NS(id, "open_formula_editor"), - "Open formula editor", - title = "Open the formula editor to create or modify a formula", - disabled = is.null(data$df) || !is.data.frame(data$df) - ) - }) - - observeEvent(input[["open_formula_editor"]], { - showModal(modalDialog( - title = "FormulaEditor", - FormulaEditorUI("FO"), - easyClose = TRUE, - size = "l", - footer = tagList( - modalButton("Close") - ) - )) - }) - - # display current formula - observe({ - req(!is.null(data$formula)) - output$formula <- renderText({ - deparse(data$formula) - }) - }) corr_fct <- function(method) { print_req(is.data.frame(data$df), "The dataset is missing") diff --git a/bs/R/statisticalTests.R b/bs/R/statisticalTests.R index c2f8393..d5b3529 100644 --- a/bs/R/statisticalTests.R +++ b/bs/R/statisticalTests.R @@ -1,18 +1,7 @@ testsSidebarUI <- function(id) { tabPanel( "Tests", - div( - class = "boxed-output", - uiOutput(NS(id, "open_formula_editor_corr")), - verbatimTextOutput(NS(id, "formula")) - ), br(), - div( - class = "boxed-output", - uiOutput(NS(id, "open_split_by_group")), - uiOutput(NS(id, "data_splitted")), - verbatimTextOutput(NS(id, "applied_filter")) - ), conditionalPanel( condition = "input.TestsConditionedPanels == 'Two groups'", sliderInput(NS(id, "confLevel"), "Confidence level of the interval", @@ -111,85 +100,6 @@ testsServer <- function(id, data, listResults) { } }) - # Render split by group - output[["open_split_by_group"]] <- renderUI({ - actionButton(NS(id, "open_split_by_group"), - "Open the split by group functionality", - title = "Open the split by group helper window", - disabled = is.null(data$df) || !is.data.frame(data$df) || !is.null(data$backup_df) - ) - }) - - observeEvent(input[["open_split_by_group"]], { - showModal(modalDialog( - title = "SplitByGroup", - SplitByGroupUI("SG"), - easyClose = TRUE, - size = "l", - footer = NULL - )) - }) - - # check if data is splitted - output$data_splitted <- renderUI({ - actionButton(NS(id, "remove_filter"), - "Remove the filter from the dataset", - title = "remove the filter of the dataset", - disabled = is.null(data$backup_df) || !is.data.frame(data$backup_df) - ) - }) - - observe({ - output$applied_filter <- renderText(NULL) - req(!is.null(data$filter_col)) - req(!is.null(data$filter_group)) - output$applied_filter <- renderText({ - paste( - "The dataset is splitted by the variable(s): [", - paste(data$filter_col, collapse = ", "), - "] group(s) are set to: [", - paste(data$filter_group, collapse = ", "), - "]" - ) - }) - }) - - # Remove filter - observeEvent(input[["remove_filter"]], { - data$df <- data$backup_df - data$backup_df <- NULL - data$filter_col <- NULL - data$filter_group <- NULL - }) - - output$open_formula_editor_corr <- renderUI({ - actionButton(NS(id, "open_formula_editor"), - "Open formula editor", - title = "Open the formula editor to create or modify a formula", - disabled = is.null(data$df) || !is.data.frame(data$df) - ) - }) - - observeEvent(input[["open_formula_editor"]], { - showModal(modalDialog( - title = "FormulaEditor", - FormulaEditorUI("FO"), - easyClose = TRUE, - size = "l", - footer = tagList( - modalButton("Close") - ) - )) - }) - - # display current formula - observe({ - req(!is.null(data$formula)) - output$formula <- renderText({ - deparse(data$formula) - }) - }) - tTest <- function() { print_req(is.data.frame(data$df), "The dataset is missing") print_form(data$formula) @@ -197,16 +107,17 @@ testsServer <- function(id, data, listResults) { formula <- data$formula fit <- NULL e <- try({ - withCallingHandlers({ - eq <- TRUE - if (input$varEq == "noeq") { - eq <- FALSE - } - fit <- broom::tidy(t.test(formula, - data = df, conf.level = input$confLevel, - alternative = input$altHyp, var.equal = eq - )) - }, + withCallingHandlers( + { + eq <- TRUE + if (input$varEq == "noeq") { + eq <- FALSE + } + fit <- broom::tidy(t.test(formula, + data = df, conf.level = input$confLevel, + alternative = input$altHyp, var.equal = eq + )) + }, warning = function(warn) { print_warn(warn$message) invokeRestart("muffleWarning") @@ -252,63 +163,67 @@ testsServer <- function(id, data, listResults) { if (is.null(err)) { e <- try( { - withCallingHandlers({ - switch(method, - aov = { - fit <- broom::tidy(aov( - formula, data = df) - ) - }, - kruskal = { - fit <- broom::tidy( - kruskal.test(formula, data = df) - ) # Keep here the restriction for respone ~ predictor - }, - HSD = { - check_formula(formula) - aov_res <- aov(formula, data = df) - bal <- input$design - req(bal) - if (bal == "Balanced") { - bal <- TRUE - } else { - bal <- FALSE + withCallingHandlers( + { + switch(method, + aov = { + fit <- broom::tidy(aov( + formula, + data = df + )) + }, + kruskal = { + fit <- broom::tidy( + kruskal.test(formula, data = df) + ) # Keep here the restriction for respone ~ predictor + }, + HSD = { + check_formula(formula) + aov_res <- aov(formula, data = df) + bal <- input$design + req(bal) + if (bal == "Balanced") { + bal <- TRUE + } else { + bal <- FALSE + } + fit <- agricolae::HSD.test(aov_res, + trt = indep, + alpha = input$pval, group = TRUE, unbalanced = bal + )$groups + }, + kruskalTest = { + check_formula(formula) + fit <- with(df, kruskal(df[, dep], df[, indep]), + alpha = input$pval, p.adj = input$padj, group = TRUE + )$groups + }, + LSD = { + check_formula(formula) + aov_res <- aov(formula, data = df) + fit <- agricolae::LSD.test(aov_res, + trt = indep, + alpha = input$pval, p.adj = input$padj, group = TRUE + )$groups + }, + scheffe = { + check_formula(formula) + aov_res <- aov(formula, data = df) + fit <- agricolae::scheffe.test( + aov_res, + trt = indep, alpha = input$pval, group = TRUE + )$groups + }, + REGW = { + check_formula(formula) + aov_res <- aov(formula, data = df) + fit <- agricolae::REGW.test( + aov_res, + trt = indep, alpha = input$pval, group = TRUE + )$groups } - fit <- agricolae::HSD.test(aov_res, - trt = indep, - alpha = input$pval, group = TRUE, unbalanced = bal - )$groups - }, - kruskalTest = { - check_formula(formula) - fit <- with(df, kruskal(df[, dep], df[, indep]), - alpha = input$pval, p.adj = input$padj, group = TRUE - )$groups - }, - LSD = { - check_formula(formula) - aov_res <- aov(formula, data = df) - fit <- agricolae::LSD.test(aov_res, - trt = indep, - alpha = input$pval, p.adj = input$padj, group = TRUE - )$groups - }, - scheffe = { - check_formula(formula) - aov_res <- aov(formula, data = df) - fit <- agricolae::scheffe.test( - aov_res, trt = indep, alpha = input$pval, group = TRUE - )$groups - }, - REGW = { - check_formula(formula) - aov_res <- aov(formula, data = df) - fit <- agricolae::REGW.test( - aov_res, trt = indep, alpha = input$pval, group = TRUE - )$groups - } - ) - }, + ) + }, warning = function(warn) { print_warn(warn$message) invokeRestart("muffleWarning") diff --git a/bs/R/visualisation.R b/bs/R/visualisation.R index 52f3071..4a1a561 100644 --- a/bs/R/visualisation.R +++ b/bs/R/visualisation.R @@ -1,12 +1,7 @@ visSidebarUI <- function(id) { tabPanel( "Visualisation", - div( - class = "boxed-output", - uiOutput(NS(id, "open_split_by_group")), - uiOutput(NS(id, "data_splitted")), - verbatimTextOutput(NS(id, "applied_filter")) - ), + br(), div( class = "boxed-output", uiOutput(NS(id, "yVarUI")), @@ -312,57 +307,6 @@ visServer <- function(id, data, listResults) { ) }) - # Render split by group - output[["open_split_by_group"]] <- renderUI({ - actionButton(NS(id, "open_split_by_group"), - "Open the split by group functionality", - title = "Open the split by group helper window", - disabled = is.null(data$df) || !is.data.frame(data$df) || !is.null(data$backup_df) - ) - }) - - observeEvent(input[["open_split_by_group"]], { - showModal(modalDialog( - title = "SplitByGroup", - SplitByGroupUI("SG"), - easyClose = TRUE, - size = "l", - footer = NULL - )) - }) - - # check if data is splitted - output$data_splitted <- renderUI({ - actionButton(NS(id, "remove_filter"), - "Remove the filter from the dataset", - title = "remove the filter of the dataset", - disabled = is.null(data$backup_df) || !is.data.frame(data$backup_df) - ) - }) - - observe({ - output$applied_filter <- renderText(NULL) - req(!is.null(data$filter_col)) - req(!is.null(data$filter_group)) - output$applied_filter <- renderText({ - paste( - "The dataset is splitted by the variable(s): [", - paste(data$filter_col, collapse = ", "), - "] group(s) are set to: [", - paste(data$filter_group, collapse = ", "), - "]" - ) - }) - }) - - # Remove filter - observeEvent(input[["remove_filter"]], { - data$df <- data$backup_df - data$backup_df <- NULL - data$filter_col <- NULL - data$filter_group <- NULL - }) - # Plot stuff plotFct <- function(method) { print_req(is.data.frame(data$df), "The dataset is missing")