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)
@@ -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)
             },

tests/testthat/test-shinytest2-tm_a_regression.R

@@ -0,0 +1,136 @@
+testthat::test_that("e2e - tm_a_regerssion: ", {
+  skip_if_too_deep(5)
+
+  # needed untill this is merged https://github.com/insightsengineering/teal/pull/1198
+  require(shinytest2)
+
+  data <- within(teal.data::teal_data(), {
+    require(nestcolor)
+    require(ggplot2)
+    CO2 <- CO2 # nolint: object_name.
+  })
+  datanames(data) <- c("CO2")
+
+  app <- 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")
+      )
+    )
+  )
+
+  app$expect_no_shiny_error()
+  #app$open_url()
+
+  testthat::expect_equal(
+    app$get_text("#teal-main_ui-root-active_tab > li.active > a"),
+    "Regression"
+  )
+
+  # Check MAIN encoding panel
+  # DO WE NEED any function for checking top of the encoding panel part?
+  encoding_dataset <- app$get_text("#teal-main_ui-root-regression > div > div.col-md-3 > div.well > div > span")
+  testthat::expect_match(encoding_dataset, 'Dataset', fixed = TRUE)
+  testthat::expect_match(encoding_dataset, 'CO2', fixed = TRUE)
+
+  # Check plot settings
+  testthat::expect_identical(
+    app$get_active_module_input("plot_type"),
+    "Normal Q-Q"
+  )
+
+  plot_types <- app$active_module_element_text("plot_type > div")
+  testthat::expect_match(plot_types, 'Response vs Regressor', fixed = TRUE)
+  testthat::expect_match(plot_types, 'Scale-Location', fixed = TRUE)
+  testthat::expect_match(plot_types, 'Residuals vs Leverage', fixed = TRUE)
+
+  app$set_module_input("plot_type", "Residuals vs Fitted")
+  app$expect_no_validation_error()
+  app$set_module_input("plot_type", "Normal Q-Q")
+  app$expect_no_validation_error()
+
+  # NO OUTLIER DEFINITION
+  app$set_module_input("show_outlier", FALSE)
+  testthat::expect_false(app$is_visible(app$active_module_element("outlier-label")))
+
+  # BRING BACK OUTLIER DEFINITION
+  app$set_module_input("show_outlier", TRUE)
+  testthat::expect_true(app$is_visible(app$active_module_element("outlier-label")))
+
+
+  # Plot settings are not visible
+  testthat::expect_false(app$is_visible(app$active_module_element("size-label")))
+  # After click they are visible
+  app$click("#_div > div.panel-heading.collapsed")
+  testthat::expect_true(app$is_visible(app$active_module_element("outlier-label")))
+  app$set_module_input("size-label", 3)
+  app$expect_no_validation_error()
+
+
+  # QUESTION - SHOULD BELOW THIS BE CHECKED HERE OR IN teal.widgets::plot_with_settings ? ? ?
+  # Module buttons
+
+  # Check if there are three buttons above the table.
+
+  plot_buttons_selector <- app$active_module_element("myplot-plot-with-settings > div.plot-settings-buttons")
+  plot_buttons <-
+    app$get_html_rvest(plot_buttons_selector) %>%
+    rvest::html_elements("button")
+  testthat::expect_length(plot_buttons, 3)
+  # Check is the first one is a toggle button.
+  testthat::expect_equal(
+    plot_buttons[[1]] %>%
+      rvest::html_attr("data-toggle"),
+    "dropdown"
+  )
+
+  # First button has specific font-awesome icon.
+  dwnl_button <- app$active_module_element("myplot-downbutton-downl")
+  testthat::expect_equal(
+    app$get_html_rvest(dwnl_button) %>%
+      rvest::html_element("i") %>%
+      rvest::html_attr("class"),
+    "fas fa-download"
+  )
+  # Click the first button.
+  app$click(selector = dwnl_button)
+
+  # Review the content of the toggle.
+  testthat::expect_equal(
+    #app$get_text(
+    app$active_module_element_text("myplot-downbutton-file_format-label"),
+    "File type"
+  )
+
+  file_format_text <- app$active_module_element_text("myplot-downbutton-file_format > div")
+  testthat::expect_match(file_format_text, "png\n", fixed = TRUE)
+  testthat::expect_match(file_format_text, "svg\n", fixed = TRUE)
+  testthat::expect_match(file_format_text, "pdf\n", fixed = TRUE)
+
+
+  app$stop()
+
+})