tests/testthat/test-shinytest2-tm_g_scatterplot.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(
    data = data,
    modules = tm_g_scatterplot(
      label = "Scatterplot Choices",
      x = teal.transform::data_extract_spec(
        dataname = "ADSL",
        select = teal.transform::select_spec(
          label = "Select variable:",
          choices = teal.transform::variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2")),
          selected = "AGE",
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      y = teal.transform::data_extract_spec(
        dataname = "ADSL",
        select = teal.transform::select_spec(
          label = "Select variable:",
          choices = teal.transform::variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2")),
          selected = "BMRKR1",
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      color_by = data_extract_spec(
        dataname = "ADSL",
        select = teal.transform::select_spec(
          label = "Select variable:",
          choices = teal.transform::variable_choices(
            data[["ADSL"]],
            c("AGE", "BMRKR1", "BMRKR2", "RACE", "REGION1")
          ),
          selected = NULL,
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      size_by = data_extract_spec(
        dataname = "ADSL",
        select = teal.transform::select_spec(
          label = "Select variable:",
          choices = teal.transform::variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")),
          selected = "AGE",
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      row_facet = data_extract_spec(
        dataname = "ADSL",
        select = teal.transform::select_spec(
          label = "Select variable:",
          choices = teal.transform::variable_choices(data[["ADSL"]], c("BMRKR2", "RACE", "REGION1")),
          selected = NULL,
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      col_facet = data_extract_spec(
        dataname = "ADSL",
        select = teal.transform::select_spec(
          label = "Select variable:",
          choices = teal.transform::variable_choices(data[["ADSL"]], c("BMRKR2", "RACE", "REGION1")),
          selected = NULL,
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      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 <- app_driver_tm_g_scatterplot()

  app$expect_no_shiny_error()

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

  app$stop()
})

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

  app <- app_driver_tm_g_scatterplot()

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

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

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

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

  app$stop()
})

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

  app <- app_driver_tm_g_scatterplot()

  app$set_active_module_input("x-dataset_ADSL_singleextract-select", "BMRKR2")
  app$set_active_module_input("log_x", TRUE)
  app$expect_validation_error()

  app$set_active_module_input("x-dataset_ADSL_singleextract-select", "BMRKR1")
  app$expect_no_validation_error()

  app$set_active_module_input("y-dataset_ADSL_singleextract-select", "BMRKR2")
  app$set_active_module_input("log_y", TRUE)
  app$expect_validation_error()

  app$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 <- app_driver_tm_g_scatterplot()

  app$set_active_module_input("row_facet-dataset_ADSL_singleextract-select", "RACE")
  app$set_active_module_input("col_facet-dataset_ADSL_singleextract-select", "RACE")
  app$expect_validation_error()

  app$stop()
})

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

  app <- app_driver_tm_g_scatterplot()

  app$set_active_module_input("color_by-dataset_ADSL_singleextract-select", "REGION1")
  app$expect_no_validation_error()

  app$set_active_module_input("size_by-dataset_ADSL_singleextract-select", "BMRKR1")
  app$expect_no_validation_error()

  app$set_active_module_input("row_facet-dataset_ADSL_singleextract-select", "RACE")
  app$expect_no_validation_error()

  app$set_active_module_input("col_facet-dataset_ADSL_singleextract-select", "BMRKR2")
  app$expect_no_validation_error()

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

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

  app$set_active_module_input("size", 8)
  app$expect_no_validation_error()

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

  app$set_active_module_input("rug_plot", TRUE)
  app$expect_no_validation_error()

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

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

  app$stop()
})