tests/testthat/test-shinytest2-tm_g_scatterplot_picks.R

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

app_driver_tm_g_scatterplot <- 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 = tm_g_scatterplot(
        label = "Scatterplot Choices",
        x = teal.picks::picks(
          teal.picks::datasets("ADSL", "ADSL"),
          teal.picks::variables(c("AGE", "BMRKR1", "BMRKR2"), "AGE")
        ),
        y = teal.picks::picks(
          teal.picks::datasets("ADSL", "ADSL"),
          teal.picks::variables(c("AGE", "BMRKR1", "BMRKR2"), "BMRKR1")
        ),
        color_by = teal.picks::picks(
          teal.picks::datasets("ADSL", "ADSL"),
          teal.picks::variables(c("AGE", "BMRKR1", "BMRKR2", "RACE", "REGION1"), NULL)
        ),
        size_by = teal.picks::picks(
          teal.picks::datasets("ADSL", "ADSL"),
          teal.picks::variables(c("AGE", "BMRKR1"), "AGE")
        ),
        row_facet = teal.picks::picks(
          teal.picks::datasets("ADSL", "ADSL"),
          teal.picks::variables(c("BMRKR2", "RACE", "REGION1"), NULL)
        ),
        col_facet = teal.picks::picks(
          teal.picks::datasets("ADSL", "ADSL"),
          teal.picks::variables(c("BMRKR2", "RACE", "REGION1"), NULL)
        ),
        ggplot2_args = teal.widgets::ggplot2_args(
          labs = list(subtitle = "Plot generated by Scatterplot Module")
        ),
        rotate_xaxis_labels = TRUE,
        ggtheme = "classic",
        max_deg = 6
      )
    )
  )
}

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

  app_driver <- app_driver_tm_g_scatterplot()

  app_driver$expect_no_shiny_error()

  testthat::expect_equal(app_driver$get_active_module_input("x-variables-selected"), "AGE")
  testthat::expect_equal(app_driver$get_active_module_input("y-variables-selected"), "BMRKR1")
  testthat::expect_false(app_driver$get_active_module_input("log_x"))
  testthat::expect_false(app_driver$get_active_module_input("log_y"))
  testthat::expect_equal(app_driver$get_active_module_input("color_by-variables-selected"), "")
  testthat::expect_equal(app_driver$get_active_module_input("size_by-variables-selected"), "AGE")
  testthat::expect_equal(app_driver$get_active_module_input("row_facet-variables-selected"), "")
  testthat::expect_equal(app_driver$get_active_module_input("col_facet-variables-selected"), "")
  testthat::expect_equal(app_driver$get_active_module_input("alpha"), 1)
  testthat::expect_equal(app_driver$get_active_module_input("shape"), "circle")
  testthat::expect_equal(app_driver$get_active_module_input("color"), "#000000")
  testthat::expect_equal(app_driver$get_active_module_input("size"), 5)
  testthat::expect_true(app_driver$get_active_module_input("rotate_xaxis_labels"))
  testthat::expect_null(app_driver$get_active_module_input("smoothing_degree"))
  testthat::expect_equal(app_driver$get_active_module_input("ggtheme"), "classic")

  app_driver$stop()
})

testthat::test_that("e2e - tm_g_scatterplot: Base for the log transformation can be applied.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_g_scatterplot()

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

  app_driver$set_active_module_input("log_x_base", "log2")
  app_driver$expect_no_validation_error()

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

  app_driver$set_active_module_input("log_y_base", "log10")
  app_driver$expect_no_validation_error()

  app_driver$stop()
})

testthat::test_that("e2e - tm_g_scatterplot: The log transform is only possible for positive numeric vars.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_g_scatterplot()

  set_picks_slot_selected(app_driver, "x", "BMRKR2")
  app_driver$set_active_module_input("log_x", TRUE)
  app_driver$expect_validation_error()

  set_picks_slot_selected(app_driver, "x", "BMRKR1")
  app_driver$expect_no_validation_error()

  set_picks_slot_selected(app_driver, "y", "BMRKR2")
  app_driver$set_active_module_input("log_y", TRUE)
  app_driver$expect_validation_error()

  app_driver$stop()
})

testthat::test_that("e2e - tm_g_scatterplot: Get validation error when facetting with the same row & col variable.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_g_scatterplot()

  set_picks_slot_selected(app_driver, "row_facet", "RACE")
  set_picks_slot_selected(app_driver, "col_facet", "RACE")
  app_driver$expect_validation_error()

  app_driver$stop()
})

testthat::test_that("e2e - tm_g_scatterplot: The encoding inputs are set without validation errors.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_g_scatterplot()

  set_picks_slot_selected(app_driver, "color_by", "REGION1")
  app_driver$expect_no_validation_error()

  set_picks_slot_selected(app_driver, "size_by", "BMRKR1")
  app_driver$expect_no_validation_error()

  set_picks_slot_selected(app_driver, "row_facet", "RACE")
  app_driver$expect_no_validation_error()

  set_picks_slot_selected(app_driver, "col_facet", "BMRKR2")
  app_driver$expect_no_validation_error()

  app_driver$set_active_module_input("alpha", 0.5)
  app_driver$expect_no_validation_error()

  app_driver$set_active_module_input("shape", "square")
  app_driver$expect_no_validation_error()

  app_driver$set_active_module_input("size", 8)
  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("rug_plot", TRUE)
  app_driver$expect_no_validation_error()

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

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

  app_driver$stop()
})