tests/testthat/test-shinytest2-tm_g_response_picks.R

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

app_driver_tm_g_response <- function() {
  data <- teal.data::teal_data()
  data <- within(data, {
    require(nestcolor)
    ADSL <- teal.data::rADSL
  })
  teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[names(data)]

  init_teal_app_driver(
    teal::init(
      data = data,
      modules = teal::modules(
        tm_g_response(
          label = "Response Plots",
          response = teal.picks::picks(
            teal.picks::datasets("ADSL", "ADSL"),
            teal.picks::variables(c("BMRKR2", "COUNTRY"), "BMRKR2")
          ),
          x = teal.picks::picks(
            teal.picks::datasets("ADSL", "ADSL"),
            teal.picks::variables(c("SEX", "RACE"), "RACE")
          ),
          ggplot2_args = teal.widgets::ggplot2_args(
            labs = list(subtitle = "Plot generated by Response Module")
          )
        )
      )
    )
  )
}

testthat::test_that("e2e - tm_g_response: module is initialised with the specified defaults.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_g_response()

  app_driver$expect_no_shiny_error()

  testthat::expect_equal(app_driver$get_active_module_input("response-variables-selected"), "BMRKR2")
  testthat::expect_equal(app_driver$get_active_module_input("x-variables-selected"), "RACE")
  testthat::expect_equal(app_driver$get_active_module_input("freq"), "density")
  testthat::expect_true(app_driver$get_active_module_input("count_labels"))
  testthat::expect_false(app_driver$get_active_module_input("coord_flip"))
  testthat::expect_false(app_driver$get_active_module_input("rotate_xaxis_labels"))
  testthat::expect_equal(app_driver$get_active_module_input("ggtheme"), "gray")

  app_driver$stop()
})

testthat::test_that("e2e - tm_g_response: encoding inputs produce output without validation errors.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_g_response()

  set_picks_slot_selected(app_driver, "response", "COUNTRY", "variables")
  app_driver$expect_no_validation_error()

  set_picks_slot_selected(app_driver, "x", "SEX", "variables")
  app_driver$expect_no_validation_error()

  app_driver$set_active_module_input("freq", "frequency")
  app_driver$expect_no_validation_error()

  app_driver$set_active_module_input("count_labels", FALSE)
  app_driver$expect_no_validation_error()

  app_driver$set_active_module_input("coord_flip", TRUE)
  app_driver$expect_no_validation_error()

  app_driver$set_active_module_input("rotate_xaxis_labels", TRUE)
  app_driver$expect_no_validation_error()

  app_driver$set_active_module_input("ggtheme", "light")
  app_driver$expect_no_validation_error()

  app_driver$stop()
})

testthat::test_that("e2e - tm_g_response: deselecting response produces validation error.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_g_response()

  set_picks_slot_selected(app_driver, "response", "", "variables")
  app_driver$expect_validation_error()

  app_driver$stop()
})

testthat::test_that("e2e - tm_g_response: deselecting x produces validation error.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_g_response()

  set_picks_slot_selected(app_driver, "x", c(), "variables")
  app_driver$expect_validation_error()

  app_driver$stop()
})