Merge branch 'main' into tm_front_page@712_setup-shinytest2@main

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: teal.modules.general
 Title: General Modules for 'teal' Applications
-Version: 0.3.0.9008
-Date: 2024-04-17
+Version: 0.3.0.9009
+Date: 2024-04-18
 Authors@R: c(
     person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre")),
     person("Pawel", "Rucki", , "pawel.rucki@roche.com", role = "aut"),
@@ -70,6 +70,7 @@ Suggests:
     nestcolor (>= 0.1.0),
     rlang (>= 1.0.0),
     rtables (>= 0.6.6),
+    rvest,
     shinytest2,
     sparkline,
     testthat (>= 3.0.4),
@@ -90,8 +91,9 @@ Config/Needs/verdepcheck: haleyjeppson/ggmosaic, tidyverse/ggplot2,
     gridExtra, ramnathv/htmlwidgets, jeroen/jsonlite, yihui/knitr,
     deepayan/lattice, daroczig/logger, MASS,
     insightsengineering/nestcolor, r-lib/rlang,
-    insightsengineering/rtables, sparkline, rstudio/shinytest2,
-    insightsengineering/teal.data, r-lib/testthat, r-lib/withr
+    insightsengineering/rtables, tidyverse/rvest, sparkline,
+    rstudio/shinytest2, insightsengineering/teal.data, r-lib/testthat,
+    r-lib/withr
 Config/Needs/website: insightsengineering/nesttemplate
 Encoding: UTF-8
 Language: en-US

NEWS.md

@@ -1,4 +1,4 @@
-# teal.modules.general 0.3.0.9008
+# teal.modules.general 0.3.0.9009
 
 # teal.modules.general 0.3.0
 

R/tm_variable_browser.R

@@ -705,7 +705,9 @@ plot_var_summary <- function(var,
       }
       var <- if (isTRUE(remove_NA_hist)) as.vector(stats::na.omit(var)) else var
       ggplot(data.frame(var), aes(x = forcats::fct_infreq(as.factor(var)))) +
-        geom_bar(stat = "count", aes(fill = ifelse(is.na(var), "withcolor", "")), show.legend = FALSE) +
+        geom_bar(
+          stat = "count", aes(fill = ifelse(is.na(var), "withcolor", "")), show.legend = FALSE
+        ) +
         scale_fill_manual(values = c("gray50", "tan"))
     }
   } else if (is.numeric(var)) {

tests/testthat/test-shinytest2-tm_variable_browser.R

@@ -0,0 +1,224 @@
+app_driver_tm_variable_browser <- function() {
+  # general data example
+  data <- within(
+    teal.data::teal_data(),
+    {
+      iris <- iris
+      mtcars <- mtcars
+      women <- women
+      faithful <- faithful
+      CO2 <- CO2 # nolint: object_name.
+    }
+  )
+  teal.data::datanames(data) <- c("iris", "mtcars", "women", "faithful", "CO2")
+
+  init_teal_app_driver(
+    data = data,
+    modules = tm_variable_browser(
+      label = "Variable browser (e2e)",
+      parent_dataname = "CO2",
+      ggplot2_args = teal.widgets::ggplot2_args(
+        labs = list(subtitle = "Plot generated by Variable Browser Module")
+      ),
+      pre_output = shiny::tags$div("A pre-output message for tm_variable_browser"),
+      post_output = shiny::tags$div("A post-output message for tm_variable_browser"),
+    )
+  )
+}
+
+testthat::test_that("e2e - tm_variable_browser: content is displayed correctly", {
+  skip_if_too_deep(5)
+
+  app_driver <- app_driver_tm_variable_browser()
+
+  app_driver$expect_no_shiny_error()
+
+  # Test tab name
+  testthat::expect_equal(
+    trimws(app_driver$get_text("#teal-main_ui-root-active_tab > li.active")),
+    "Variable browser (e2e)"
+  )
+
+  # Plot is visible
+  testthat::expect_true(
+    app_driver$is_visible(app_driver$active_module_element("variable_plot-plot_out_main"))
+  )
+
+  # All datanames are available on the left sidebar
+  testthat::expect_setequal(
+    trimws(app_driver$get_text(
+      sprintf("%s .nav li", app_driver$active_module_element("ui_variable_browser"))
+    )),
+    c("iris", "mtcars", "women", "faithful", "CO2")
+  )
+
+  # Numeric types have statistics table in main output
+  testthat::expect_contains(
+    trimws(app_driver$active_module_element_text("variable_summary_table table th")),
+    "Statistic"
+  )
+
+  app_driver$stop()
+})
+
+testthat::test_that("e2e - tm_variable_browser: Selecting 'treat variable as factor' changes the table headers", {
+  skip_if_too_deep(5)
+
+  app_driver <- app_driver_tm_variable_browser()
+
+  # Categorical type have levels table in main output
+  current_var <- trimws(app_driver$get_text(
+    sprintf("%s .nav li.active", app_driver$active_module_element("ui_variable_browser"))
+  ))
+
+  app_driver$set_active_module_input(
+    sprintf("variable_browser_%s_rows_selected", current_var),
+    2,
+    allow_no_input_binding_ = TRUE
+  )
+  app_driver$set_active_module_input(
+    sprintf("variable_browser_%s_last_clicked", current_var),
+    2,
+    allow_no_input_binding_ = TRUE
+  )
+
+  app_driver$set_active_module_input("numeric_as_factor", TRUE)
+
+  ## Test will fail if Level column is not found
+  testthat::expect_contains(
+    trimws(app_driver$active_module_element_text("variable_summary_table table th")),
+    "Level"
+  )
+
+  app_driver$stop()
+})
+
+
+testthat::test_that("e2e - tm_variable_browser: selection of categorical variable has a table with 'level' header", {
+  skip_if_too_deep(5)
+
+  app_driver <- app_driver_tm_variable_browser()
+
+  # Categorical type have levels table in main output
+  current_var <- trimws(app_driver$get_text(
+    sprintf("%s .nav li.active", app_driver$active_module_element("ui_variable_browser"))
+  ))
+
+  categorical_selector <- app_driver$active_module_element(
+    sprintf(
+      "variable_browser_%s table tr td:nth-child(1) i",
+      current_var
+    )
+  )
+
+  ## Using AppDriver to click does not trigger DT callback.
+  ## Find a categorical variable to mock a click
+  categorical_index <- min(
+    c(
+      which(
+        grepl("fa-chart-bar", app_driver$get_attr(categorical_selector, "class")),
+        arr.ind = TRUE
+      ),
+      Inf
+    ),
+    na.rm = TRUE
+  )
+
+  if (!is.infinite(categorical_index)) {
+    app_driver$set_active_module_input(
+      sprintf("variable_browser_%s_rows_selected", current_var),
+      categorical_index,
+      allow_no_input_binding_ = TRUE
+    )
+    app_driver$set_active_module_input(
+      sprintf("variable_browser_%s_last_clicked", current_var),
+      categorical_index,
+      allow_no_input_binding_ = TRUE
+    )
+  } else {
+    testthat::skip("Couldn't find a categorical variable to select")
+  }
+
+  ## Test will fail if Level column is not found
+  testthat::expect_contains(
+    trimws(app_driver$active_module_element_text("variable_summary_table table th")),
+    "Level"
+  )
+
+  app_driver$stop()
+})
+
+
+testthat::test_that("e2e - tm_variable_browser: changing 'display density' encoding doesn't show errors", {
+  skip_if_too_deep(5)
+
+  app_driver <- app_driver_tm_variable_browser()
+
+  # Show density button being clicked on and off
+  app_driver$click(selector = app_driver$active_module_element("display_density"))
+  app_driver$expect_no_shiny_error()
+  app_driver$click(selector = app_driver$active_module_element("display_density"))
+  app_driver$expect_no_shiny_error()
+
+
+  app_driver$stop()
+})
+
+testthat::test_that("e2e - tm_variable_browser: changing 'outlier definition' encoding doesn't show errors", {
+  skip_if_too_deep(5)
+
+  app_driver <- app_driver_tm_variable_browser()
+
+  # Test Enable Remove outliers button
+  testthat::expect_null(
+    app_driver$active_module_element_text("outlier_definition_slider")
+  ) ## Does not exist initially
+
+  app_driver$click(selector = app_driver$active_module_element("remove_outliers"))
+  app_driver$expect_no_shiny_error()
+  testthat::expect_length(
+    app_driver$active_module_element_text("outlier_definition_slider"),
+    1
+  ) ## Added to UI
+
+  app_driver$set_active_module_input("outlier_definition_slider", 2)
+  app_driver$expect_no_shiny_error()
+
+  app_driver$click(selector = app_driver$active_module_element("remove_outliers"))
+  app_driver$expect_no_shiny_error()
+
+
+  app_driver$stop()
+})
+
+testthat::test_that("e2e - tm_variable_browser: changing plot setting encodings doesn't show errors", {
+  skip_if_too_deep(5)
+
+  app_driver <- app_driver_tm_variable_browser()
+
+  # Test changing plot settings
+  testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("ggplot_theme-selectized")))
+
+  app_driver$set_active_module_input("ggplot_theme", "bw")
+  app_driver$expect_no_validation_error()
+  app_driver$set_active_module_input("ggplot_theme", "light")
+  app_driver$expect_no_validation_error()
+  app_driver$set_active_module_input("ggplot_theme", "dark")
+  app_driver$expect_no_validation_error()
+
+  app_driver$set_active_module_input("font_size", "8")
+  app_driver$expect_no_validation_error()
+  app_driver$set_active_module_input("font_size", "20")
+  app_driver$expect_no_validation_error()
+  app_driver$set_active_module_input("font_size", "15")
+  app_driver$expect_no_validation_error()
+
+  app_driver$set_active_module_input("label_rotation", "25")
+  app_driver$expect_no_validation_error()
+  app_driver$set_active_module_input("label_rotation", "0")
+  app_driver$expect_no_validation_error()
+  app_driver$set_active_module_input("label_rotation", "90")
+  app_driver$expect_no_validation_error()
+
+  app_driver$stop()
+})