712 - {shinytest2} for tm_missing_data

R/tm_missing_data.R

@@ -730,7 +730,11 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par
               values = c("grey90", c(getOption("ggplot2.discrete.colour")[2], "#ff2951ff")[1]),
               labels = c("Present", "Missing")
             ) +
-            scale_y_continuous(labels = scales::percent_format(), breaks = seq(0, 1, by = 0.1), expand = c(0, 0)) +
+            scale_y_continuous(
+              labels = scales::percent_format(),
+              breaks = seq(0, 1, by = 0.1),
+              expand = c(0, 0)
+            ) +
             geom_text(
               aes(label = ifelse(isna == TRUE, sprintf("%d [%.02f%%]", n, n_pct), ""), y = 1),
               hjust = 1,
@@ -803,7 +807,11 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par
                 fill = ~isna
               ) +
               geom_bar(alpha = 1, stat = "identity", position = "fill") +
-              scale_y_continuous(labels = scales::percent_format(), breaks = seq(0, 1, by = 0.1), expand = c(0, 0)) +
+              scale_y_continuous(
+                labels = scales::percent_format(),
+                breaks = seq(0, 1, by = 0.1),
+                expand = c(0, 0)
+              ) +
               scale_fill_manual(
                 name = "",
                 values = c("grey90", c(getOption("ggplot2.discrete.colour")[2], "#ff2951ff")[1]),
@@ -972,7 +980,11 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par
               dplyr::distinct() %>%
               ggplot(aes(x = id, y = n)) +
               geom_bar(stat = "identity", fill = c(getOption("ggplot2.discrete.colour")[2], "#ff2951ff")[1]) +
-              geom_text(aes(label = n), position = position_dodge(width = 0.9), vjust = -0.25) +
+              geom_text(
+                aes(label = n),
+                position = position_dodge(width = 0.9),
+                vjust = -0.25
+              ) +
               ylim(c(0, max(data_combination_plot_cutoff$n) * 1.5)) +
               labs1 +
               ggthemes1 +

tests/testthat/test-shinytest2-tm_misssing_data.R

@@ -0,0 +1,165 @@
+app_driver_tm_missing_data <- function() {
+  data <- within(simple_teal_data(), {
+    require(nestcolor)
+
+    add_nas <- function(x) {
+      x[sample(seq_along(x), floor(length(x) * runif(1, .05, .17)))] <- NA
+      x
+    }
+
+    iris[] <- lapply(iris, add_nas)
+    mtcars[] <- lapply(mtcars, add_nas)
+    mtcars[["cyl"]] <- as.factor(mtcars[["cyl"]])
+    mtcars[["gear"]] <- as.factor(mtcars[["gear"]])
+  })
+
+  init_teal_app_driver(
+    data = data,
+    modules = tm_missing_data(
+      label = "Missing data",
+      plot_height = c(600, 400, 5000),
+      plot_width = NULL,
+      parent_dataname = "",
+      ggtheme = "gray",
+      ggplot2_args = list(
+        "Combinations Hist" = teal.widgets::ggplot2_args(
+          labs = list(subtitle = "Plot produced by Missing Data Module", caption = NULL)
+        ),
+        "Combinations Main" = teal.widgets::ggplot2_args(labs = list(title = NULL))
+      ),
+      pre_output = NULL,
+      post_output = NULL
+    ),
+    timeout = 3000,
+    seed = 1
+  )
+}
+
+test_that("e2e - tm_missing_data: Initializes without errors", {
+  skip_if_too_deep(5)
+  app_driver <- app_driver_tm_missing_data()
+
+  app_driver$expect_no_shiny_error()
+
+  testthat::expect_equal(
+    app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"),
+    "Missing data"
+  )
+
+  encoding_dataset <- app_driver$get_text(
+    app_driver$active_module_element("dataset_encodings .help-block")
+  )
+
+  testthat::expect_match(encoding_dataset, "Datasets.*iris.*mtcars", all = FALSE)
+
+
+  app_driver$stop()
+})
+
+test_that("e2e - tm_missing_data: Default settings and visibility of the summary graph", {
+  skip_if_too_deep(5)
+  app_driver <- app_driver_tm_missing_data()
+  # default summary tab
+  testthat::expect_equal(
+    app_driver$get_active_module_input("iris-summary_type"),
+    "Summary"
+  )
+
+  testthat::expect_setequal(
+    app_driver$get_active_module_input("iris-variables_select"),
+    c("Petal.Length", "Sepal.Length", "Petal.Width", "Species", "Sepal.Width")
+  )
+
+  app_driver$click(selector = app_driver$active_module_element("iris-filter_na"))
+  app_driver$expect_no_validation_error()
+
+  app_driver$click(selector = app_driver$active_module_element("iris-any_na"))
+  app_driver$expect_no_validation_error()
+
+  testthat::expect_true(
+    app_driver$is_visible(
+      app_driver$active_module_element("iris-summary_plot-plot_out_main")
+    )
+  )
+
+  app_driver$stop()
+})
+
+test_that("e2e - tm_missing_data: Check default settings and visibility of the combinations graph and encodings", {
+  skip_if_too_deep(5)
+  app_driver <- app_driver_tm_missing_data()
+
+  app_driver$expect_no_shiny_error()
+
+  # combination graph
+
+  app_driver$set_active_module_input("iris-summary_type", "Combinations")
+  app_driver$expect_no_validation_error()
+  testthat::expect_true(
+    app_driver$is_visible(
+      app_driver$active_module_element("iris-combination_plot-plot_out_main")
+    )
+  )
+
+  # combination encoding
+
+  testthat::expect_true(
+    app_driver$is_visible(
+      app_driver$active_module_element("iris-cutoff")
+    )
+  )
+
+  testthat::expect_equal(app_driver$get_active_module_input("iris-combination_cutoff"), 2L)
+  app_driver$set_active_module_input("iris-combination_cutoff", 10L)
+  app_driver$expect_no_validation_error()
+
+  app_driver$stop()
+})
+
+test_that("e2e - tm_missing_data: Validate functionality and UI response for 'By Variable Levels'", {
+  skip_if_too_deep(5)
+  app_driver <- app_driver_tm_missing_data()
+  # By variable levels
+  app_driver$set_active_module_input("iris-summary_type", "By Variable Levels")
+  app_driver$expect_no_validation_error()
+
+
+  testthat::expect_equal(
+    app_driver$get_active_module_input("iris-group_by_var"),
+    "Species"
+  )
+  testthat::expect_setequal(
+    app_driver$get_active_module_input("iris-group_by_vals"),
+    c("NA", "setosa", "versicolor", "virginica")
+  )
+
+  app_driver$set_active_module_input("iris-group_by_vals", c("versicolor", "virginica"))
+  app_driver$expect_no_validation_error()
+
+  testthat::expect_equal(
+    app_driver$get_active_module_input("iris-count_type"),
+    "counts"
+  )
+  app_driver$set_active_module_input("iris-count_type", "proportions")
+  testthat::expect_true(app_driver$is_visible(app_driver$active_module_element("iris-levels_table")))
+
+  app_driver$stop()
+})
+
+test_that("e2e - tm_missing_data: Validate 'By Variable Levels' table values", {
+  skip_if_too_deep(5)
+  app_driver <- app_driver_tm_missing_data()
+
+  app_driver$set_active_module_input("iris-summary_type", "By Variable Levels")
+  levels_table <- app_driver$active_module_element("iris-levels_table") %>%
+    app_driver$get_html_rvest() %>%
+    rvest::html_table(fill = TRUE) %>%
+    .[[1]]
+
+  testthat::expect_setequal(
+    levels_table$Variable,
+    c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
+  )
+
+  app_driver$stop()
+})