tests/testthat/test-shinytest2-tm_g_response.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(
    data = data,
    modules = teal::modules(
      tm_g_response(
        label = "Response Plots",
        response = teal.transform::data_extract_spec(
          dataname = "ADSL",
          select = teal.transform::select_spec(
            label = "Select variable:",
            choices = teal.transform::variable_choices(data[["ADSL"]], c("BMRKR2", "COUNTRY")),
            selected = "BMRKR2",
            multiple = FALSE,
            fixed = FALSE
          )
        ),
        x = teal.transform::data_extract_spec(
          dataname = "ADSL",
          select = teal.transform::select_spec(
            label = "Select variable:",
            choices = teal.transform::variable_choices(data[["ADSL"]], c("SEX", "RACE")),
            selected = "RACE",
            multiple = FALSE,
            fixed = FALSE
          )
        ),
        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-dataset_ADSL_singleextract-select"), "BMRKR2")
  testthat::expect_equal(app_driver$get_active_module_input("x-dataset_ADSL_singleextract-select"), "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()

  app_driver$set_active_module_input("response-dataset_ADSL_singleextract-select", "COUNTRY")
  app_driver$expect_no_validation_error()

  app_driver$set_active_module_input("x-dataset_ADSL_singleextract-select", "SEX")
  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()

  app_driver$set_active_module_input("response-dataset_ADSL_singleextract-select", c())
  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()

  app_driver$set_active_module_input("x-dataset_ADSL_singleextract-select", c())
  app_driver$expect_validation_error()

  app_driver$stop()
})