712 - {shinytest2} for tm_a_regression

R/tm_a_regression.R

@@ -479,7 +479,7 @@ srv_a_regression <- function(id,
           selected = restoreInput(ns("label_var"), selected)
         )
 
-        data <- fortify(stats::lm(form, data = ANL))
+        data <- ggplot2::fortify(stats::lm(form, data = ANL))
         cooksd <- data$.cooksd[!is.nan(data$.cooksd)]
         max_outlier <- max(ceiling(max(cooksd) / mean(cooksd)), 2)
         cur_outlier <- isolate(input$outlier)
@@ -564,12 +564,12 @@ srv_a_regression <- function(id,
               size = size,
               alpha = alpha
             ),
-            expr = ggplot(
+            expr = ggplot2::ggplot(
               fit$model[, 2:1],
-              aes_string(regressor, response)
+              ggplot2::aes_string(regressor, response)
             ) +
-              geom_point(size = size, alpha = alpha) +
-              stat_smooth(
+              ggplot2::geom_point(size = size, alpha = alpha) +
+              ggplot2::stat_smooth(
                 method = "lm",
                 formula = y ~ x,
                 se = FALSE
@@ -585,8 +585,8 @@ srv_a_regression <- function(id,
           shinyjs::hide("size")
           shinyjs::hide("alpha")
           plot <- substitute(
-            expr = ggplot(fit$model[, 2:1], aes_string(regressor, response)) +
-              geom_boxplot(),
+            expr = ggplot2::ggplot(fit$model[, 2:1], ggplot2::aes_string(regressor, response)) +
+              ggplot2::geom_boxplot(),
             env = list(regressor = regression_var()$regressor, response = regression_var()$response)
           )
           if (show_outlier) {
@@ -615,7 +615,7 @@ srv_a_regression <- function(id,
           substitute(
             expr = {
               class(fit$residuals) <- NULL
-              data <- fortify(fit)
+              data <- ggplot2::fortify(fit)
               g <- plot
               print(g)
             },
@@ -650,10 +650,10 @@ srv_a_regression <- function(id,
         shinyjs::show("size")
         shinyjs::show("alpha")
         plot <- substitute(
-          expr = ggplot(data = data, aes(.fitted, .resid)) +
-            geom_point(size = size, alpha = alpha) +
-            geom_hline(yintercept = 0, linetype = "dashed", size = 1) +
-            geom_line(data = smoothy, mapping = smoothy_aes),
+          expr = ggplot2::ggplot(data = data, ggplot2::aes(.fitted, .resid)) +
+            ggplot2::geom_point(size = size, alpha = alpha) +
+            ggplot2::geom_hline(yintercept = 0, linetype = "dashed", size = 1) +
+            ggplot2::geom_line(data = smoothy, mapping = smoothy_aes),
           env = list(size = size, alpha = alpha)
         )
         if (show_outlier) {
@@ -694,15 +694,15 @@ srv_a_regression <- function(id,
         shinyjs::show("size")
         shinyjs::show("alpha")
         plot <- substitute(
-          expr = ggplot(data = data, aes(sample = .stdresid)) +
-            stat_qq(size = size, alpha = alpha) +
-            geom_abline(linetype = "dashed"),
+          expr = ggplot2::ggplot(data = data, ggplot2::aes(sample = .stdresid)) +
+            ggplot2::stat_qq(size = size, alpha = alpha) +
+            ggplot2::geom_abline(linetype = "dashed"),
           env = list(size = size, alpha = alpha)
         )
         if (show_outlier) {
           plot <- substitute(
             expr = plot +
-              stat_qq(
+              ggplot2::stat_qq(
                 geom = ggrepel::GeomTextRepel,
                 label = label_col %>%
                   data.frame(label = .) %>%
@@ -753,9 +753,9 @@ srv_a_regression <- function(id,
         shinyjs::show("size")
         shinyjs::show("alpha")
         plot <- substitute(
-          expr = ggplot(data = data, aes(.fitted, sqrt(abs(.stdresid)))) +
-            geom_point(size = size, alpha = alpha) +
-            geom_line(data = smoothy, mapping = smoothy_aes),
+          expr = ggplot2::ggplot(data = data, ggplot2::aes(.fitted, sqrt(abs(.stdresid)))) +
+            ggplot2::geom_point(size = size, alpha = alpha) +
+            ggplot2::geom_line(data = smoothy, mapping = smoothy_aes),
           env = list(size = size, alpha = alpha)
         )
         if (show_outlier) {
@@ -796,23 +796,23 @@ srv_a_regression <- function(id,
         shinyjs::hide("size")
         shinyjs::show("alpha")
         plot <- substitute(
-          expr = ggplot(data = data, aes(seq_along(.cooksd), .cooksd)) +
-            geom_col(alpha = alpha),
+          expr = ggplot2::ggplot(data = data, ggplot2::aes(seq_along(.cooksd), .cooksd)) +
+            ggplot2::geom_col(alpha = alpha),
           env = list(alpha = alpha)
         )
         if (show_outlier) {
           plot <- substitute(
             expr = plot +
-              geom_hline(
+              ggplot2::geom_hline(
                 yintercept = c(
                   outlier * mean(data$.cooksd, na.rm = TRUE),
                   mean(data$.cooksd, na.rm = TRUE)
                 ),
                 color = "red",
                 linetype = "dashed"
               ) +
-              geom_text(
-                aes(
+              ggplot2::geom_text(
+                ggplot2::aes(
                   x = 0,
                   y = mean(data$.cooksd, na.rm = TRUE),
                   label = paste("mu", "=", round(mean(data$.cooksd, na.rm = TRUE), 4)),
@@ -863,21 +863,21 @@ srv_a_regression <- function(id,
         shinyjs::show("size")
         shinyjs::show("alpha")
         plot <- substitute(
-          expr = ggplot(data = data, aes(.hat, .stdresid)) +
-            geom_vline(
+          expr = ggplot2::ggplot(data = data, ggplot2::aes(.hat, .stdresid)) +
+            ggplot2::geom_vline(
               size = 1,
               colour = "black",
               linetype = "dashed",
               xintercept = 0
             ) +
-            geom_hline(
+            ggplot2::geom_hline(
               size = 1,
               colour = "black",
               linetype = "dashed",
               yintercept = 0
             ) +
-            geom_point(size = size, alpha = alpha) +
-            geom_line(data = smoothy, mapping = smoothy_aes),
+            ggplot2::geom_point(size = size, alpha = alpha) +
+            ggplot2::geom_line(data = smoothy, mapping = smoothy_aes),
           env = list(size = size, alpha = alpha)
         )
         if (show_outlier) {
@@ -918,16 +918,16 @@ srv_a_regression <- function(id,
         shinyjs::show("size")
         shinyjs::show("alpha")
         plot <- substitute(
-          expr = ggplot(data = data, aes(.hat, .cooksd)) +
-            geom_vline(xintercept = 0, colour = NA) +
-            geom_abline(
+          expr = ggplot2::ggplot(data = data, ggplot2::aes(.hat, .cooksd)) +
+            ggplot2::geom_vline(xintercept = 0, colour = NA) +
+            ggplot2::geom_abline(
               slope = seq(0, 3, by = 0.5),
               colour = "black",
               linetype = "dashed",
               size = 1
             ) +
-            geom_line(data = smoothy, mapping = smoothy_aes) +
-            geom_point(size = size, alpha = alpha),
+            ggplot2::geom_line(data = smoothy, mapping = smoothy_aes) +
+            ggplot2::geom_point(size = size, alpha = alpha),
           env = list(size = size, alpha = alpha)
         )
         if (show_outlier) {

tests/testthat/helper-TealAppDriver.R

@@ -50,3 +50,43 @@ simple_cdisc_data <- function(datasets = c("ADSL", "ADRS", "ADTTE")) {
   teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[datasets]
   data
 }
+
+app_driver_tm_a_regression <- function() {
+  data <- within(teal.data::teal_data(), {
+    require(nestcolor)
+    require(ggplot2)
+    CO2 <- CO2 # nolint: object_name.
+  })
+  teal.data::datanames(data) <- c("CO2")
+
+  TealAppDriver$new(
+    data = data,
+    modules = tm_a_regression(
+      label = "Regression",
+      default_plot_type = 3,
+      response = teal.transform::data_extract_spec(
+        dataname = "CO2",
+        select = teal.transform::select_spec(
+          label = "Select variable:",
+          choices = "uptake",
+          selected = "uptake",
+          multiple = FALSE,
+          fixed = TRUE
+        )
+      ),
+      regressor = teal.transform::data_extract_spec(
+        dataname = "CO2",
+        select = teal.transform::select_spec(
+          label = "Select variables:",
+          choices = teal.transform::variable_choices(data[["CO2"]], c("conc", "Treatment")),
+          selected = "conc",
+          multiple = TRUE,
+          fixed = FALSE
+        )
+      ),
+      ggplot2_args = teal.widgets::ggplot2_args(
+        labs = list(subtitle = "Plot generated by Regression Module")
+      )
+    )
+  )
+}

tests/testthat/test-shinytest2-tm_a_regression.R

@@ -0,0 +1,135 @@
+testthat::test_that("e2e - tm_a_regerssion: data parameter and module label is passed properly", {
+  skip_if_too_deep(5)
+
+  app_driver <- app_driver_tm_a_regression()
+  app_driver$expect_no_shiny_error()
+
+  testthat::expect_equal(
+    app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"),
+    "Regression"
+  )
+
+  encoding_dataset <- app_driver$get_text("#teal-main_ui-root-regression .help-block")
+  testthat::expect_match(encoding_dataset, "Dataset:[\n ]*CO2", all = FALSE)
+
+  app_driver$stop()
+})
+
+testthat::test_that("e2e - tm_a_regerssion:
+  data extract spec elements are initialized with the default values specified by response and regressor arg", {
+  skip_if_too_deep(5)
+
+  app_driver <- app_driver_tm_a_regression()
+  app_driver$expect_no_shiny_error()
+
+  testthat::expect_identical(
+    app_driver$active_module_element_text("response-dataset_CO2_singleextract-select_selected_text"),
+    "uptake"
+  )
+
+  testthat::expect_identical(
+    app_driver$get_active_module_input("regressor-dataset_CO2_singleextract-select"),
+    "conc"
+  )
+  app_driver$set_active_module_input("regressor-dataset_CO2_singleextract-select", "Treatment")
+  app_driver$stop()
+})
+
+testthat::test_that("e2e - tm_a_regerssion: plot_type is set properly", {
+  skip_if_too_deep(5)
+
+  app_driver <- app_driver_tm_a_regression()
+  app_driver$expect_no_shiny_error()
+
+  testthat::expect_identical(
+    app_driver$get_active_module_input("plot_type"),
+    "Normal Q-Q"
+  )
+  app_driver$stop()
+})
+
+testthat::test_that("e2e - tm_a_regerssion:
+  plot type has 7 specific choices & changing choices does not throw errors", {
+  skip_if_too_deep(5)
+
+  app_driver <- app_driver_tm_a_regression()
+  app_driver$expect_no_shiny_error()
+
+  plot_types <- app_driver$active_module_element_text("plot_type > div")
+
+  possible_choices <-
+    c(
+      "Response vs Regressor", "Scale-Location", "Residuals vs Leverage",
+      "Residuals vs Fitted", "Normal Q-Q", "Cook's distance", "Cook's dist vs Leverage"
+    )
+
+  invisible(
+    lapply(
+      possible_choices,
+      function(choice) {
+        expect_match(plot_types, choice, fixed = TRUE)
+        app_driver$set_active_module_input("plot_type", choice)
+        app_driver$expect_no_validation_error()
+      }
+    )
+  )
+
+  app_driver$stop()
+})
+
+testthat::test_that("e2e - tm_a_regerssion: outlier definition and label are visible by default", {
+  skip_if_too_deep(5)
+
+  app_driver <- app_driver_tm_a_regression()
+  app_driver$expect_no_shiny_error()
+
+  testthat::expect_true(app_driver$get_active_module_input("show_outlier"))
+  testthat::expect_true(app_driver$is_visible(app_driver$active_module_element("outlier-label")))
+  testthat::expect_true(app_driver$is_visible(app_driver$active_module_element("label_var_input")))
+
+  app_driver$stop()
+})
+
+testthat::test_that("e2e - tm_a_regerssion: outlier definition and label have default values and label text", {
+  skip_if_too_deep(5)
+
+  app_driver <- app_driver_tm_a_regression()
+  app_driver$expect_no_shiny_error()
+
+  testthat::expect_match(
+    app_driver$active_module_element_text("label_var_input"),
+    "Outlier label",
+    fixed = TRUE
+  )
+  outlier_label <- app_driver$active_module_element_text("outlier-label")
+  testthat::expect_match(
+    outlier_label,
+    "Outlier definition:",
+    fixed = TRUE
+  )
+  testthat::expect_match(
+    outlier_label,
+    "distance greater than the value on the slider times the mean of the Cook",
+    fixed = TRUE
+  )
+
+  testthat::expect_identical(app_driver$get_active_module_input("label_var"), "uptake")
+  testthat::expect_identical(app_driver$get_active_module_input("outlier"), 9L)
+
+  app_driver$stop()
+})
+
+testthat::test_that("e2e - tm_a_regerssion: unchecking display outlier hides outlier label and definition", {
+  skip_if_too_deep(5)
+
+  app_driver <- app_driver_tm_a_regression()
+  app_driver$expect_no_shiny_error()
+
+  app_driver$set_active_module_input("show_outlier", FALSE)
+  testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("outlier-label")))
+  testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("label_var_input")))
+
+  app_driver$expect_no_validation_error()
+
+  app_driver$stop()
+})