added check that formula is response ~ predictor; for post hoc tests

ComPlat · Nov 11, 2024 · 3a5d3e1 · 3a5d3e1
1 parent e4e7c08
commit 3a5d3e1
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 2 deletions.
diff --git a/bs/R/statisticalTests.R b/bs/R/statisticalTests.R
@@ -246,6 +246,7 @@ testsServer <- function(id, data, listResults) {
       })
       if (inherits(e, "try-error")) {
         err <- conditionMessage(attr(e, "condition"))
+        err <- paste0(err, "\n", "Could not use Formula")
         output$test_error <- renderText(err)
       }
       if (is.null(err)) {
@@ -255,9 +256,10 @@ testsServer <- function(id, data, listResults) {
               fit <- broom::tidy(aov(formula, data = df))
             },
             kruskal = {
-              fit <- broom::tidy(kruskal.test(formula, data = df))
+              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)
@@ -272,31 +274,37 @@ testsServer <- function(id, data, listResults) {
               )$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
             }
           )
-        })
+        }, silent = TRUE)
         if (inherits(e, "try-error")) {
           err <- conditionMessage(attr(e, "condition"))
+          err <- paste0(err, "\n", "Test did not run successfully")
           output$test_error <- renderText(err)
         } else if (is.null(fit)) {
+          err <- paste0(err, "\n", "Test did not run successfully")
           output$test_error <- renderText("Result is NULL")
         } else {
           fit <- cbind(fit, row.names(fit))

diff --git a/bs/R/utils.R b/bs/R/utils.R
@@ -331,3 +331,15 @@ check_type_res <- function(res) {
     stop(paste0("Found result with unallowed type: ", class(res)))
   }
 }
+
+# Check that formula is of type response ~ predictor
+check_formula <- function(formula) {
+  if (!inherits(formula, "formula")) {
+    stop("Input must be a formula of the type response ~ predictor")
+  }
+  terms <- all.vars(formula)
+  if (length(terms) != 2) {
+    stop("Formula must have exactly two terms: response ~ predictor")
+  }
+  return(TRUE)
+}