tests/testthat/test-shinytest2-tm_a_regression_picks.R

In teal.modules.general: General Modules for 'teal' Applications

app_driver_tm_a_regression <- function() {
  data <- within(teal.data::teal_data(), {
    require(nestcolor)
    CO2 <- CO2 # nolint: object_name.
  })

  init_teal_app_driver(
    teal::init(
      data = data,
      modules = tm_a_regression(
        label = "Regression",
        response = teal.picks::picks(
          teal.picks::datasets("CO2", "CO2"),
          teal.picks::variables("uptake", "uptake")
        ),
        regressor = teal.picks::picks(
          teal.picks::datasets("CO2", "CO2"),
          teal.picks::variables(c("conc", "Treatment"), c("conc"), multiple = TRUE)
        ),
        plot_height = c(600, 200, 2000),
        plot_width = NULL,
        alpha = c(1, 0, 1),
        size = c(2, 1, 8),
        ggtheme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"),
        pre_output = NULL,
        post_output = NULL,
        default_plot_type = 3,
        outlier = teal.picks::picks(
          teal.picks::datasets("CO2", "CO2"),
          teal.picks::variables("Plant", "Plant")
        ),
        label_segment_threshold = c(0.5, 0, 10),
        ggplot2_args = teal.widgets::ggplot2_args(
          labs = list(subtitle = "Plot generated by Regression Module")
        )
      )
    )
  )
}

testthat::test_that("e2e - tm_a_regression: 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-modules-tree .active"), "Regression")

  encoding_dataset <- trimws(app_driver$get_text(
    app_driver$namespaces(TRUE)$module("regressor-inputs-summary_badge")
  ))
  testthat::expect_match(encoding_dataset, "CO2[[:space:]]+conc", all = FALSE)

  app_driver$stop()
})

testthat::test_that("e2e - tm_a_regression:
  picks 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()

  testthat::expect_match(
    trimws(app_driver$get_text(
      app_driver$namespaces(TRUE)$module("response-inputs-fixed_badge")
    )),
    "[[:space:]]uptake$"
  )

  testthat::expect_match(
    trimws(app_driver$get_text(
      app_driver$namespaces(TRUE)$module("regressor-inputs-summary_badge")
    )),
    "[[:space:]]conc$"
  )
  app_driver$set_active_module_input("regressor-dataset_CO2_singleextract-select", "Treatment")

  app_driver$stop()
})

testthat::test_that("e2e - tm_a_regression: Plot type is set properly.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_a_regression()

  testthat::expect_identical(
    app_driver$get_active_module_input("plot_type"),
    "Normal Q-Q"
  )
  app_driver$stop()
})

testthat::test_that("e2e - tm_a_regression:
  Plot type has 7 specific choices & changing choices does not throw errors.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_a_regression()

  plot_types <- app_driver$get_text(app_driver$namespaces(TRUE)$module("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_regression: Outlier definition and label are visible by default.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_a_regression()

  testthat::expect_true(app_driver$get_active_module_input("show_outlier"))
  app_driver$expect_visible(app_driver$namespaces(TRUE)$module("outlier-label"))
  app_driver$expect_visible(app_driver$namespaces(TRUE)$module("outlier-inputs-fixed_badge"))

  app_driver$stop()
})

testthat::test_that("e2e - tm_a_regression: Outlier definition and label have default values and label text.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_a_regression()

  testthat::expect_match(
    app_driver$get_text(app_driver$namespaces(TRUE)$module("outlier-label")),
    "Outlier label",
    fixed = TRUE
  )
  outlier_label <- app_driver$get_text(app_driver$namespaces(TRUE)$module("outlier_cutoff-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_values()$export[[app_driver$namespaces()$module("response-picks_resolved")]]$variables$selected,
    "uptake"
  )
  testthat::expect_identical(app_driver$get_active_module_input("outlier_cutoff"), 9L)

  app_driver$stop()
})

testthat::test_that("e2e - tm_a_regression: Unchecking display outlier hides outlier label and definition.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_a_regression()

  app_driver$set_active_module_input("show_outlier", FALSE)
  checkmate::expect_string(app_driver$get_text(app_driver$namespaces(TRUE)$module("outlier-label")))
  checkmate::expect_string(app_driver$get_text(app_driver$namespaces(TRUE)$module("outlier-inputs-fixed_badge")))
  app_driver$expect_hidden(app_driver$namespaces(TRUE)$module("outlier-label"))
  app_driver$expect_hidden(app_driver$namespaces(TRUE)$module("outlier-inputs-fixed_badge"))

  app_driver$expect_no_validation_error()

  app_driver$stop()
})