tests/testthat/test-shinytest2-tm_outliers.R

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

app_driver_tm_outlier <- function() {
  data <- teal.data::teal_data()
  data <- within(data, {
    CO2 <- CO2 # nolint: object_name
    CO2[["primary_key"]] <- seq_len(nrow(CO2)) # nolint: object_name
  })
  teal.data::join_keys(data) <- teal.data::join_keys(join_key("CO2", "CO2", "primary_key"))

  vars <- teal.transform::choices_selected(
    teal.transform::variable_choices(
      data[["CO2"]],
      c("Plant", "Type", "Treatment")
    )
  )

  init_teal_app_driver(
    data = data,
    modules = tm_outliers(
      outlier_var = list(
        teal.transform::data_extract_spec(
          dataname = "CO2",
          select = teal.transform::select_spec(
            label = "Select variable:",
            choices = teal.transform::variable_choices(data[["CO2"]], c("conc", "uptake")),
            selected = "uptake",
            multiple = FALSE,
            fixed = FALSE
          )
        )
      ),
      categorical_var = list(
        teal.transform::data_extract_spec(
          dataname = "CO2",
          filter = teal.transform::filter_spec(
            vars = vars,
            choices = teal.transform::value_choices(data[["CO2"]], vars$selected),
            selected = teal.transform::value_choices(data[["CO2"]], vars$selected),
            multiple = TRUE
          )
        )
      ),
      ggplot2_args = list(
        teal.widgets::ggplot2_args(
          labs = list(subtitle = "Plot generated by Outliers Module")
        )
      )
    )
  )
}

testthat::test_that("e2e - tm_outliers: Data parameter and module label is passed properly.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_outlier()
  app_driver$expect_no_shiny_error()

  testthat::expect_equal(
    app_driver$get_text("#teal-teal_modules-active_tab > li.active > a"),
    "Outliers Module"
  )

  encoding_dataset <- app_driver$get_text("#teal-teal_modules-outliers_module .help-block")
  testthat::expect_match(encoding_dataset, "Dataset:[\n ]*CO2", all = FALSE)
  testthat::expect_match(encoding_dataset, "Outlier data points", all = FALSE)

  app_driver$stop()
})

testthat::test_that("e2e - tm_outliers:
  Data extract spec elements are initialized with the default values
  specified by outlier_var and categorical_var argument.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_outlier()
  app_driver$expect_no_shiny_error()

  testthat::expect_identical(
    app_driver$get_active_module_input("outlier_var-dataset_CO2_singleextract-select"),
    "uptake"
  )
  app_driver$set_active_module_input("outlier_var-dataset_CO2_singleextract-select", "conc")
  app_driver$expect_no_validation_error()

  testthat::expect_identical(
    app_driver$get_active_module_input("categorical_var-dataset_CO2_singleextract-filter1-col"),
    "Plant"
  )

  testthat::expect_identical(
    app_driver$get_active_module_input("categorical_var-dataset_CO2_singleextract-filter1-vals"),
    c(
      "Qn1", "Qn2", "Qn3", "Qc1", "Qc2", "Qc3", "Mn1", "Mn2", "Mn3",
      "Mc1", "Mc2", "Mc3"
    )
    # THIS WILL HAVE DIFFERENT ORDER ONCE THIS IS FIXED
    # https://github.com/insightsengineering/teal.modules.general/issues/735
  )
  app_driver$set_active_module_input("categorical_var-dataset_CO2_singleextract-filter1-col", c("Qn1", "Qn2", "Qn3"))
  app_driver$expect_no_shiny_error()

  app_driver$set_active_module_input("categorical_var-dataset_CO2_singleextract-filter1-col", "Type")
  app_driver$expect_no_shiny_error()

  app_driver$stop()
})

testthat::test_that("e2e - tm_outliers: Plot type is correctly set by default and has appropriate possible options.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_outlier()
  app_driver$expect_no_shiny_error()

  testthat::expect_identical(app_driver$get_active_module_input("boxplot_alts"), "Box plot")

  plot_choices <- app_driver$active_module_element_text("boxplot_alts")
  testthat::expect_match(plot_choices, "Violin plot", fixed = TRUE)

  app_driver$set_active_module_input("boxplot_alts", "Violin plot")
  app_driver$expect_no_shiny_error()

  app_driver$stop()
})

testthat::test_that("e2e - tm_outliers: Module is divided into 3 tabs.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_outlier()
  app_driver$expect_no_shiny_error()

  testthat::expect_identical(app_driver$get_active_module_input("tabs"), "Boxplot")
  testthat::expect_match(
    app_driver$active_module_element_text("tabs"),
    "Boxplot.*Density Plot.*Cumulative Distribution Plot",
    fixed = FALSE
  )
  app_driver$stop()
})

testthat::test_that("e2e - tm_outliers: Plot type is hidden when Boxplot tab is not selected.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_outlier()
  app_driver$expect_no_shiny_error()

  testthat::expect_true(app_driver$is_visible(app_driver$active_module_element("boxplot_alts")))

  app_driver$set_active_module_input("tabs", "Density Plot")
  testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("boxplot_alts")))

  app_driver$set_active_module_input("tabs", "Cumulative Distribution Plot")
  testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("boxplot_alts")))

  app_driver$stop()
})

testthat::test_that("e2e - tm_outliers: Default radio buttons are set properly.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_outlier()
  app_driver$expect_no_shiny_error()

  testthat::expect_false(app_driver$get_active_module_input("split_outliers"))
  testthat::expect_false(app_driver$get_active_module_input("order_by_outlier"))

  app_driver$set_active_module_input("split_outliers", TRUE)
  app_driver$set_active_module_input("order_by_outlier", TRUE)
  app_driver$expect_no_shiny_error()

  app_driver$stop()
})

testthat::test_that("e2e - tm_outliers: Method parameters are set properly.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_outlier()
  app_driver$expect_no_shiny_error()

  testthat::expect_identical(app_driver$get_active_module_input("method"), "IQR")
  method_choices <- app_driver$active_module_element_text("method")
  testthat::expect_match(method_choices, "Z-score", fixed = TRUE)
  testthat::expect_match(method_choices, "Percentile", fixed = TRUE)

  app_driver$stop()
})

testthat::test_that("e2e - tm_outliers:
  Outlier definition text and range are displayed properly depending on method.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_outlier()
  app_driver$expect_no_shiny_error()

  # Initially only the first slider should be visible.
  testthat::expect_true(app_driver$is_visible(app_driver$active_module_element("iqr_slider")))
  testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("zscore_slider")))
  testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("percentile_slider")))

  # IQR METHOD
  testthat::expect_identical(app_driver$get_active_module_input("method"), "IQR")
  testthat::expect_match(
    normalize_math_italic_text(app_driver$active_module_element_text("ui_outlier_help")),
    "x<Q1−3×IQRx<Q1−3×IQRx",
    fixed = TRUE
  )
  testthat::expect_identical(app_driver$get_active_module_input("iqr_slider"), 3L)
  app_driver$set_active_module_input("iqr_slider", 8L)
  app_driver$expect_no_shiny_error()

  # Z-score METHOD
  app_driver$set_active_module_input("method", "Z-score")
  app_driver$expect_no_shiny_error()
  testthat::expect_true(app_driver$is_visible(app_driver$active_module_element("zscore_slider")))
  testthat::expect_match(
    normalize_math_italic_text(app_driver$active_module_element_text("ui_outlier_help")),
    "Zscore(x)<−3Zscore(x)<−3Zscore(x)",
    fixed = TRUE
  )
  testthat::expect_identical(app_driver$get_active_module_input("zscore_slider"), 3L)
  app_driver$set_active_module_input("zscore_slider", 5L)
  app_driver$expect_no_shiny_error()

  # Percentile METHOD
  app_driver$set_active_module_input("method", "Percentile")
  app_driver$expect_no_shiny_error()
  testthat::expect_true(app_driver$is_visible(app_driver$active_module_element("percentile_slider")))
  testthat::expect_match(
    normalize_math_italic_text(app_driver$active_module_element_text("ui_outlier_help")),
    "Percentile(x)<0.01Percentile(x)<0.01 Percentile(x)",
    fixed = TRUE
  )
  testthat::expect_identical(app_driver$get_active_module_input("percentile_slider"), 0.01)
  app_driver$set_active_module_input("percentile_slider", 0.05)
  app_driver$expect_no_shiny_error()

  app_driver$stop()
})

testthat::test_that("e2e - tm_outliers: Outliers summary table is displayed with proper content.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_outlier()
  app_driver$expect_no_shiny_error()

  # Initial state.
  testthat::expect_identical(
    app_driver$active_module_element_text("total_outliers"),
    "Total number of outlier(s): 0 / 84 [0.00%]"
  )

  table_text <- app_driver$active_module_element_text("summary_table")
  testthat::expect_match(table_text, "Outliers.*Missing.*Total")
  statistics <- app_driver$get_active_module_input("categorical_var-dataset_CO2_singleextract-filter1-vals")
  testthat::expect_match(table_text, paste(statistics, collapse = "|"), fixed = FALSE)

  # Change method to Z-score and adjust slider.
  app_driver$set_active_module_input("method", "Z-score")
  app_driver$set_active_module_input("zscore_slider", 1.5)
  testthat::expect_identical(
    app_driver$active_module_element_text("total_outliers"),
    "Total number of outlier(s): 8 / 84 [9.52%]"
  )
  table_text <- app_driver$active_module_element_text("summary_table")
  testthat::expect_match(
    table_text,
    "01 [14.29%]2 [28.57%]001 [14.29%]001 [14.29%]1 [14.29%]1 [14.29%]1 [14.29%]",
    fixed = TRUE
  )

  # Select split outliers.
  app_driver$set_active_module_input("split_outliers", TRUE)
  testthat::expect_identical(
    app_driver$active_module_element_text("total_outliers"),
    "Total number of outlier(s): 12 / 84 [14.29%]"
  )
  table_text <- app_driver$active_module_element_text("summary_table")
  testthat::expect_match(
    table_text,
    "1 [14.29%]1 [14.29%]1 [14.29%]1 [14.29%]1 [14.29%]1 [14.29%]1 [14.29%]1",
    fixed = TRUE
  )


  app_driver$stop()
})

testthat::test_that("e2e - tm_outliers: Outlier table is displayed with proper content.", {
  skip_if_too_deep(5)

  app_driver <- app_driver_tm_outlier()
  app_driver$expect_no_shiny_error()

  app_driver$set_active_module_input("method", "Z-score")
  app_driver$set_active_module_input("zscore_slider", 1.5)

  table_content <- app_driver$active_module_element_text("table_ui")

  test_match <- function(x) {
    testthat::expect_match(
      table_content,
      paste(x, collapse = ""),
      fixed = TRUE
    )
  }

  test_match(c("primary_key", "uptake", "Plant"))
  test_match(c("1", "14", "44.3", "Qn2"))
  test_match(c("4", "29", "9.3", "Qc2"))
  test_match(c("8", "78", "10.6", "Mc3"))

  app_driver$stop()
})