Wave 2 - tm_g_forest_tte shinytest2

tests/testthat/test-shinytest2-tm_g_forest_tte.R

@@ -0,0 +1,252 @@
+app_driver_tm_g_forest_tte <- function() { # nolint: object_length.
+  data <- within(teal.data::teal_data(), {
+    ADSL <- teal.modules.clinical::tmc_ex_adsl
+    ADSL$RACE <- with_label(droplevels(ADSL$RACE), "Race")
+    ADTTE <- teal.modules.clinical::tmc_ex_adtte
+  })
+
+  datanames <- c("ADSL", "ADTTE")
+  teal.data::datanames(data) <- datanames
+  teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[datanames]
+
+  arm_ref_comp <- list(
+    ARM = list(
+      ref = "B: Placebo",
+      comp = c("A: Drug X", "C: Combination")
+    ),
+    ARMCD = list(
+      ref = "ARM B",
+      comp = c("ARM A", "ARM C")
+    )
+  )
+
+  init_teal_app_driver(
+    data = data,
+    modules = tm_g_forest_tte(
+      label = "Forest Survival (e2e)",
+      dataname = "ADTTE",
+      arm_var = teal.transform::choices_selected(
+        teal.transform::variable_choices(data[["ADSL"]], c("ARM", "ARMCD")),
+        "ARMCD"
+      ),
+      arm_ref_comp = arm_ref_comp,
+      paramcd = teal.transform::choices_selected(
+        teal.transform::value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"),
+        "OS"
+      ),
+      subgroup_var = teal.transform::choices_selected(
+        teal.transform::variable_choices(data[["ADSL"]], names(data[["ADSL"]])),
+        c("BMRKR2", "SEX")
+      ),
+      strata_var = teal.transform::choices_selected(
+        teal.transform::variable_choices(data[["ADSL"]], c("STRATA1", "STRATA2")),
+        "STRATA2"
+      ),
+      fixed_symbol_size = FALSE,
+      plot_height = c(500L, 300L, 2000L),
+      plot_width = c(1000L, 700L, 2000L),
+      rel_width_forest = c(25L, 0L, 100L),
+      font_size = c(12L, 1L, 30L),
+      pre_output = NULL,
+      post_output = NULL,
+      ggplot2_args = teal.widgets::ggplot2_args()
+    )
+  )
+}
+
+# Initialization --------------------------------------------------------------
+
+testthat::test_that("e2e - tm_g_forest_tte: Module initializes in teal without errors and produces output.", {
+  skip_if_too_deep(5)
+  app_driver <- app_driver_tm_g_forest_tte()
+  app_driver$expect_no_shiny_error()
+  app_driver$expect_no_validation_error()
+  testthat::expect_true(
+    app_driver$is_visible(app_driver$active_module_element("myplot-plot_out_main"))
+  )
+
+  app_driver$stop()
+})
+
+testthat::test_that(
+  paste0(
+    "e2e - tm_g_forest_tte: Starts with specified ",
+    "label, paramcd, arm_var, buckets, paramcd, subgroup_var, strata_var and plot settings"
+  ),
+  {
+    skip_if_too_deep(5)
+    app_driver <- app_driver_tm_g_forest_tte()
+
+    testthat::expect_identical(
+      trimws(app_driver$get_text("#teal-main_ui-root-active_tab > li.active")),
+      "Forest Survival (e2e)"
+    )
+
+    testthat::expect_identical(
+      app_driver$get_active_module_input(ns_des_input("arm_var", "ADSL", "select")),
+      "ARMCD"
+    )
+
+    testthat::expect_identical(
+      app_driver$get_active_module_input(ns_des_input("paramcd", "ADTTE", "filter1-vals")),
+      "OS"
+    )
+
+    testthat::expect_identical(
+      app_driver$get_active_module_input(ns_des_input("aval_var", "ADTTE", "select")),
+      "AVAL"
+    )
+
+    testthat::expect_identical(
+      app_driver$get_active_module_input(ns_des_input("cnsr_var", "ADTTE", "select")),
+      "CNSR"
+    )
+
+    testthat::expect_equal(
+      app_driver$get_active_module_input("buckets"),
+      list(Ref = list("ARM B"), Comp = list("ARM A", "ARM C"))
+    )
+
+    testthat::expect_setequal(
+      app_driver$get_active_module_input(ns_des_input("subgroup_var", "ADSL", "select")),
+      c("SEX", "BMRKR2")
+    )
+
+    testthat::expect_equal(
+      app_driver$get_active_module_input(ns_des_input("strata_var", "ADSL", "select")),
+      "STRATA2"
+    )
+
+    # Plot settings -----------------------------------------------------------
+    # only tests the options that are customizable
+
+    testthat::expect_equal(app_driver$get_active_module_input("conf_level"), "0.95")
+    testthat::expect_true(app_driver$get_active_module_input("fixed_symbol_size"))
+    testthat::expect_equal(app_driver$get_active_module_input("rel_width_forest"), 25)
+    testthat::expect_equal(app_driver$get_active_module_input("font_size"), 12)
+
+    app_driver$stop()
+  }
+)
+
+testthat::test_that(
+  "e2e - tm_g_forest_tte: Selection of 'paramcd' changes the element and does not throw validation errors",
+  {
+    skip_if_too_deep(5)
+    app_driver <- app_driver_tm_g_forest_tte()
+    plot_before <- app_driver$get_active_module_pws_output("myplot")
+    app_driver$set_active_module_input(ns_des_input("paramcd", "ADTTE", "filter1-vals"), "CRSD")
+    testthat::expect_false(identical(plot_before, app_driver$get_active_module_pws_output("myplot")))
+    app_driver$expect_no_validation_error()
+    app_driver$stop()
+  }
+)
+
+testthat::test_that("e2e - tm_g_forest_tte: Deselection of paramcd filter throws validation error.", {
+  skip_if_too_deep(5)
+  app_driver <- app_driver_tm_g_forest_tte()
+  input_id <- ns_des_input("paramcd", "ADTTE", "filter1-vals")
+  app_driver$set_active_module_input(input_id, character(0L))
+  app_driver$expect_validation_error()
+  testthat::expect_match(
+    app_driver$active_module_element_text(
+      sprintf(
+        "%s_input .shiny-validation-message",
+        input_id
+      )
+    ),
+    "Please select Endpoint filter."
+  )
+  app_driver$stop()
+})
+
+testthat::test_that(
+  "e2e - tm_g_forest_tte: Selection of 'arm_var' changes the element and does not throw validation errors",
+  {
+    skip_if_too_deep(5)
+    app_driver <- app_driver_tm_g_forest_tte()
+    plot_before <- app_driver$get_active_module_pws_output("myplot")
+    app_driver$set_active_module_input(ns_des_input("arm_var", "ADSL", "select"), "ARM")
+    testthat::expect_false(identical(plot_before, app_driver$get_active_module_pws_output("myplot")))
+    app_driver$expect_no_validation_error()
+    app_driver$stop()
+  }
+)
+
+testthat::test_that("e2e - tm_g_forest_tte: Deselection of paramcd var throws validation error.", {
+  skip_if_too_deep(5)
+  app_driver <- app_driver_tm_g_forest_tte()
+  input_id <- ns_des_input("arm_var", "ADSL", "select")
+  app_driver$set_active_module_input(input_id, character(0L))
+  app_driver$expect_validation_error()
+  testthat::expect_match(
+    app_driver$active_module_element_text(
+      sprintf(
+        "%s_input .shiny-validation-message",
+        input_id
+      )
+    ),
+    "Treatment variable must be selected"
+  )
+  app_driver$stop()
+})
+
+testthat::test_that(
+  "e2e - tm_g_forest_tte: Selecting aval_var does not throw validation errors and changes a plot.",
+  {
+    skip_if_too_deep(5)
+    # not possible in this app due to fixed input
+  }
+)
+
+testthat::test_that(
+  "e2e - tm_g_forest_tte: Deselecting aval_var throws validation error.",
+  {
+    skip_if_too_deep(5)
+    # not possible in this app due to fixed input
+  }
+)
+
+testthat::test_that(
+  "e2e - tm_g_forest_tte: Selecting cnsr_var does not throw validation errors and changes a plot.",
+  {
+    skip_if_too_deep(5)
+    # not possible in this app due to fixed input
+  }
+)
+
+testthat::test_that(
+  "e2e - tm_g_forest_tte: Deselecting cnsr_var throws validation error.",
+  {
+    skip_if_too_deep(5)
+    # not possible in this app due to fixed input
+  }
+)
+
+testthat::test_that(
+  "e2e - tm_g_forest_tte: Selecting time_unit variable does not throw validation errors and changes a plot.",
+  {
+    skip_if_too_deep(5)
+    # not possible in this app due to fixed input
+  }
+)
+
+testthat::test_that(
+  "e2e - tm_g_forest_tte: Selecting conf_level does not throw validation errors and changes a plot.",
+  {
+    skip_if_too_deep(5)
+    app_driver <- app_driver_tm_g_forest_tte()
+    input_id <- "conf_level"
+    plot_before <- app_driver$get_active_module_pws_output("myplot")
+    app_driver$set_active_module_input(input_id, "0.99")
+    testthat::expect_false(identical(plot_before, app_driver$get_active_module_pws_output("myplot")))
+    app_driver$expect_validation_error()
+    testthat::expect_match(
+      app_driver$active_module_element_text(
+        sprintf("%s_input .shiny-validation-message", input_id)
+      ),
+      "Please choose a confidence level"
+    )
+    app_driver$stop()
+  }
+)