tests/testthat/test-shinytest2-tm_g_bivariate_picks.R

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

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

  init_teal_app_driver(
    teal::init(
      data = data,
      modules = tm_g_bivariate(
        x = teal.picks::picks(
          teal.picks::datasets("CO2", "CO2"),
          suppressWarnings(teal.picks::variables(selected = "conc"), classes = "pick_delayed")
        ),
        y = teal.picks::picks(
          teal.picks::datasets("CO2", "CO2"),
          suppressWarnings(teal.picks::variables(selected = "uptake"), classes = "pick_delayed")
        ),
        row_facet = teal.picks::picks(
          teal.picks::datasets("CO2", "CO2"),
          suppressWarnings(teal.picks::variables(selected = "Type"), classes = "pick_delayed")
        ),
        col_facet = teal.picks::picks(
          teal.picks::datasets("CO2", "CO2"),
          suppressWarnings(teal.picks::variables(selected = "Treatment"), classes = "pick_delayed")
        ),
        color = teal.picks::picks(
          teal.picks::datasets("CO2", "CO2"),
          teal.picks::variables(c("Plant", "Type", "Treatment"), "Treatment")
        ),
        fill = teal.picks::picks(
          teal.picks::datasets("CO2", "CO2"),
          teal.picks::variables(c("Plant", "Type", "Treatment"), "Treatment")
        ),
        size = teal.picks::picks(
          teal.picks::datasets("CO2", "CO2"),
          teal.picks::variables(c("Plant", "Type", "Treatment"), "Treatment")
        ),
        color_settings = TRUE,
        free_x_scales = FALSE,
        free_y_scales = TRUE,
        ggplot2_args = teal.widgets::ggplot2_args(
          labs = list(subtitle = "Plot generated by Bivariate Module")
        ),
        ggtheme = "classic",
        swap_axes = TRUE
      )
    )
  )
}

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

  app_driver <- app_driver_tm_g_bivariate()

  app_driver$expect_no_shiny_error()

  testthat::expect_equal(app_driver$get_active_module_input("x-variables-selected"), "conc")
  testthat::expect_equal(app_driver$get_active_module_input("y-variables-selected"), "uptake")
  testthat::expect_true(app_driver$get_active_module_input("facetting"))
  testthat::expect_equal(app_driver$get_active_module_input("row_facet-variables-selected"), "Type")
  testthat::expect_equal(app_driver$get_active_module_input("col_facet-variables-selected"), "Treatment")
  testthat::expect_true(app_driver$get_active_module_input("coloring"))
  testthat::expect_equal(app_driver$get_active_module_input("color-variables-selected"), "Treatment")
  testthat::expect_equal(app_driver$get_active_module_input("size-variables-selected"), "Treatment")
  testthat::expect_equal(app_driver$get_active_module_input("fill-variables-selected"), "Treatment")
  testthat::expect_false(app_driver$get_active_module_input("free_x_scales"))
  testthat::expect_true(app_driver$get_active_module_input("free_y_scales"))
  testthat::expect_false(app_driver$get_active_module_input("rotate_xaxis_labels"))
  testthat::expect_true(app_driver$get_active_module_input("swap_axes"))
  testthat::expect_equal(app_driver$get_active_module_input("ggtheme"), "classic")
  testthat::expect_equal(app_driver$get_active_module_input("alpha"), 0.5)
  testthat::expect_equal(app_driver$get_active_module_input("fixed_size"), 2)
  testthat::expect_false(app_driver$get_active_module_input("add_lines"))

  app_driver$stop()
})

testthat::test_that("e2e - tm_g_bivariate: Coloring options are hidden when coloring is toggled off.", {
  skip_if_too_deep(5)
  app_driver <- app_driver_tm_g_bivariate()

  app_driver$expect_visible(app_driver$namespaces(TRUE)$module("color-summary"))
  app_driver$expect_visible(app_driver$namespaces(TRUE)$module("size-summary"))
  app_driver$expect_visible(app_driver$namespaces(TRUE)$module("fill-summary"))

  app_driver$set_active_module_input("coloring", FALSE)

  app_driver$expect_hidden(app_driver$namespaces(TRUE)$module("color-summary"))
  app_driver$expect_hidden(app_driver$namespaces(TRUE)$module("size-summary"))
  app_driver$expect_hidden(app_driver$namespaces(TRUE)$module("fill-summary"))

  app_driver$stop()
})

testthat::test_that("e2e - tm_g_bivariate: Facetting options are hidden when facet is toggled off.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_g_bivariate()

  app_driver$expect_visible(app_driver$namespaces(TRUE)$module("row_facet-summary"))
  app_driver$expect_visible(app_driver$namespaces(TRUE)$module("col_facet-summary"))
  app_driver$expect_visible(app_driver$namespaces(TRUE)$module("free_x_scales"))
  app_driver$expect_visible(app_driver$namespaces(TRUE)$module("free_y_scales"))

  app_driver$set_active_module_input("facetting", FALSE)

  app_driver$expect_hidden(app_driver$namespaces(TRUE)$module("row_facet-summary"))
  app_driver$expect_hidden(app_driver$namespaces(TRUE)$module("col_facet-summary"))
  app_driver$expect_hidden(app_driver$namespaces(TRUE)$module("free_x_scales"))
  app_driver$expect_hidden(app_driver$namespaces(TRUE)$module("free_y_scales"))

  app_driver$stop()
})

testthat::test_that("e2e - tm_g_bivariate: Setting encoding inputs produces outputs without validation errors.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_g_bivariate()

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

  app_driver$set_active_module_input("fixed_size", 6)
  app_driver$expect_no_validation_error()

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

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

  set_picks_slot_selected(app_driver, "y", "conc")
  app_driver$expect_no_validation_error()

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

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

  set_picks_slot_selected(app_driver, "color", "Type")
  app_driver$expect_no_validation_error()

  set_picks_slot_selected(app_driver, "size", "Type")
  app_driver$expect_no_validation_error()

  set_picks_slot_selected(app_driver, "fill", "Plant")
  app_driver$expect_no_validation_error()

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

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

  app_driver$set_active_module_input("rotate_xaxis_labels", TRUE)

  app_driver$set_active_module_input("swap_axes", TRUE)

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

  app_driver$stop()
})