added missing ui tests

bs/R/DoseResponse.R

@@ -1,5 +1,3 @@
-# TODO: add everywhere the ? documentation.
-# In an analogous way to the DoseResponse tab
 DoseResponseSidebarUI <- function(id) {
   tabPanel(
     "Dose Response analysis",
@@ -18,9 +16,9 @@ DoseResponseSidebarUI <- function(id) {
         verbatimTextOutput(NS(id, "applied_filter"))
       ),
       br(),
-      uiOutput(NS(id, "substanceNames")),
-      uiOutput(NS(id, "negIdentifier")),
-      uiOutput(NS(id, "posIdentifier")),
+      uiOutput(NS(id, "substanceNamesUI")),
+      uiOutput(NS(id, "negIdentifierUI")),
+      uiOutput(NS(id, "posIdentifierUI")),
       actionButton(NS(id, "ic50"), "Conduct analysis")
     )
   )
@@ -53,7 +51,6 @@ DoseResponseUI <- function(id) {
 
 DoseResponseServer <- function(id, data, listResults) {
   moduleServer(id, function(input, output, session) {
-
     r_vals <- reactiveValues(
       plots = NULL,
       names = NULL, # For dropdown_plots
@@ -63,7 +60,7 @@ DoseResponseServer <- function(id, data, listResults) {
     )
 
     # Render names, conc and abs column
-    output[["substanceNames"]] <- renderUI({
+    output[["substanceNamesUI"]] <- renderUI({
       req(!is.null(data$df))
       req(is.data.frame(data$df))
       colnames <- names(data$df)
@@ -84,7 +81,7 @@ DoseResponseServer <- function(id, data, listResults) {
       )
     })
 
-    output[["negIdentifier"]] <- renderUI({
+    output[["negIdentifierUI"]] <- renderUI({
       req(!is.null(data$df))
       req(is.data.frame(data$df))
       req(input$`substanceNames`)
@@ -101,13 +98,13 @@ DoseResponseServer <- function(id, data, listResults) {
         selectInput(
           inputId = paste0("DOSERESPONSE-negIdentifier"),
           label = "Name of the negative control",
-          choices = choices[1:length( choices)],
+          choices = choices[1:length(choices)],
           selected = NULL
         )
       )
     })
 
-    output[["posIdentifier"]] <- renderUI({
+    output[["posIdentifierUI"]] <- renderUI({
       req(!is.null(data$df))
       req(is.data.frame(data$df))
       req(input$`substanceNames`)
@@ -124,7 +121,7 @@ DoseResponseServer <- function(id, data, listResults) {
         selectInput(
           inputId = paste0("DOSERESPONSE-posIdentifier"),
           label = "Name of the positive control",
-          choices = choices[1:length( choices)],
+          choices = choices[1:length(choices)],
           selected = NULL
         )
       )
@@ -195,14 +192,18 @@ DoseResponseServer <- function(id, data, listResults) {
         FormulaEditorUI("FO"),
         easyClose = TRUE,
         size = "l",
-        footer = NULL
+        footer = tagList(
+          modalButton("Close")
+        )
       ))
     })
 
     # display current formula
     observe({
       req(!is.null(data$formula))
-      output$formula <- renderText({deparse(data$formula)})
+      output$formula <- renderText({
+        deparse(data$formula)
+      })
     })
 
     drFct <- function() {
@@ -266,6 +267,10 @@ DoseResponseServer <- function(id, data, listResults) {
         listResults$counter <- listResults$counter + 1
         new_result_name <- paste0("DoseResponseNr", listResults$counter)
         listResults$all_data[[new_result_name]] <- new("doseResponse", df = resDF, p = resPlot)
+
+        exportTestValues(
+          doseresponse_res = listResults$curr_data
+        )
       }
     }
 
@@ -347,7 +352,6 @@ DoseResponseServer <- function(id, data, listResults) {
         r_vals$currentPageOverview <- r_vals$currentPageOverview - 1
       }
     })
-
   })
 
   return(listResults)

bs/R/statisticalTests.R

@@ -64,7 +64,7 @@ testsSidebarUI <- function(id) {
           "Unbalanced" = "ub"
         )
       ),
-      uiOutput(NS(id, "padj"))
+      uiOutput(NS(id, "padjUI"))
     )
   )
 }
@@ -91,9 +91,8 @@ testsUI <- function(id) {
 
 testsServer <- function(id, data, listResults) {
   moduleServer(id, function(input, output, session) {
-
     # Render p adjustment methods
-    output[["padj"]] <- renderUI({
+    output[["padjUI"]] <- renderUI({
       if (input$PostHocTests == "kruskalTest" || input$PostHocTests == "LSD") {
         return(
           selectInput(NS(id, "padj"), "Adjusted p method",
@@ -246,55 +245,58 @@ testsServer <- function(id, data, listResults) {
         output$test_error <- renderText(err)
       }
       if (is.null(err)) {
-        e <- try({
-          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
+        e <- try(
+          {
+            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
-            }
-          )
-        }, silent = TRUE)
+            )
+          },
+          silent = TRUE
+        )
         if (inherits(e, "try-error")) {
           err <- conditionMessage(attr(e, "condition"))
           err <- paste0(err, "\n", "Test did not run successfully")
@@ -328,7 +330,6 @@ testsServer <- function(id, data, listResults) {
     observeEvent(input$PostHocTest, {
       conductTests(input$PostHocTests)
     })
-
   })
 
   return(listResults)

bs/R/utils.R

@@ -496,6 +496,9 @@ check_filename_for_serverless <- function(filename) {
 # Split list of plots into panels of 9 plots
 create_plot_pages <- function(plotList) {
   n_full_pages <- floor(length(plotList) / 9)
+  if (n_full_pages == 0) {
+    return(list(cowplot::plot_grid(plotlist = plotList)))
+  }
   n_plots_last_page <- length(plotList) %% 9
   res <- list()
   i <- 1
@@ -507,7 +510,7 @@ create_plot_pages <- function(plotList) {
     }
   }
   res[[i + 1]] <- plotList[(n_full_pages * 9 + 1):
-    (n_full_pages * 9 + n_plots_last_page)]
+  (n_full_pages * 9 + n_plots_last_page)]
   lapply(res, function(x) {
     cowplot::plot_grid(plotlist = x)
   })

bs/inst/tinytest/Assumptions.R

@@ -3,18 +3,29 @@ library(tinytest)
 app <- bs::app()
 app <- shiny::shinyApp(app$ui, app$server)
 app <- AppDriver$new(app)
+app$wait_for_idle()
 app$upload_file(
   file = system.file("/test_data/CO2.csv", package = "bs")
 )
+app$wait_for_idle()
 app$set_inputs(conditionedPanels = "Assumption")
+app$wait_for_idle()
 app$set_window_size(width = 2259, height = 1326)
+app$wait_for_idle()
 app$click("ASS-open_formula_editor")
+app$wait_for_idle()
 app$set_inputs(`FO-colnames-dropdown_0` = "uptake")
+app$wait_for_idle()
 app$click("FO-colnames_Treatment_0")
+app$wait_for_idle()
 app$click("FO-create_formula")
+app$wait_for_idle()
 app$run_js("$('.modal-footer button:contains(\"Close\")').click();")
+app$wait_for_idle()
 app$click("ASS-shapiro")
+app$wait_for_idle()
 res <- app$get_values()$export
+app$wait_for_idle()
 expected <- rbind(
   broom::tidy(shapiro.test(CO2[CO2$Treatment == "nonchilled", "uptake"])),
   broom::tidy(shapiro.test(CO2[CO2$Treatment == "chilled", "uptake"]))
@@ -26,7 +37,9 @@ tinytest::expect_equal(res[[1]], expected)
 
 # Update output value
 app$click("ASS-shapiroResiduals")
+app$wait_for_idle()
 res <- app$get_values()$export
+app$wait_for_idle()
 fit <- lm(uptake ~ Treatment, data = CO2)
 r <- resid(fit)
 expected <- broom::tidy(shapiro.test(r))
@@ -35,16 +48,22 @@ tinytest::expect_equal(res[[1]], expected)
 
 # Update output value
 app$click("ASS-levene")
+app$wait_for_idle()
 res <- app$get_values()$export
+app$wait_for_idle()
 expected <- broom::tidy(car::leveneTest(uptake ~ Treatment,
-  data = CO2, center = "mean"))
+  data = CO2, center = "mean"
+))
 expected$`Variance homogenity` <- expected$p.value > 0.05
 tinytest::expect_equal(res[[1]], expected)
 
 # Update output value
 app$click("ASS-DiagnosticPlot")
+app$wait_for_idle()
 res <- app$get_values()$export
+app$wait_for_idle()
 tinytest::expect_equal(inherits(res[[1]], "ggplot"), TRUE)
 # TODO: add internal backend test for diagnostic plot functions
 
+app$wait_for_idle()
 app$stop()