diff --git a/tests/testthat/test-shinytest2-tm_g_forest_rsp.R b/tests/testthat/test-shinytest2-tm_g_forest_rsp.R new file mode 100644 index 0000000000..24e04ec005 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_g_forest_rsp.R @@ -0,0 +1,323 @@ +app_driver_tm_g_forest_rsp <- function() { + data <- teal.data::teal_data() %>% + within({ + library(dplyr) + library(tern) + ADSL <- teal.data::rADSL + ADRS <- teal.data::rADRS %>% + mutate(AVALC = d_onco_rsp_label(AVALC)) %>% + with_label("Character Result/Finding") %>% + filter(PARAMCD != "OVRINV" | AVISIT == "FOLLOW UP") + }) + + datanames <- c("ADSL", "ADRS") + 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 = modules( + tm_g_forest_rsp( + label = "Forest Response", + dataname = "ADRS", + 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[["ADRS"]], "PARAMCD", "PARAM"), + "INVET" + ), + 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" + ), + conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8, 2), 0.95, keep_order = TRUE), + plot_height = c(600L, 200L, 2000L), + default_responses = list( + BESRSPI = list( + rsp = c("Stable Disease (SD)", "Not Evaluable (NE)"), + levels = c( + "Complete Response (CR)", "Partial Response (PR)", "Stable Disease (SD)", + "Progressive Disease (PD)", "Not Evaluable (NE)" + ) + ), + INVET = list( + rsp = c("Complete Response (CR)", "Partial Response (PR)"), + levels = c( + "Complete Response (CR)", "Not Evaluable (NE)", "Partial Response (PR)", + "Progressive Disease (PD)", "Stable Disease (SD)" + ) + ), + OVRINV = list( + rsp = c("Progressive Disease (PD)", "Stable Disease (SD)"), + levels = c("Progressive Disease (PD)", "Stable Disease (SD)", "Not Evaluable (NE)") + ) + ) + ) + ) + ) +} + +testthat::test_that("e2e - tm_g_forest_rsp: Module initializes in teal without errors and produces plot output.", { + skip_if_too_deep(5) + + app_driver <- app_driver_tm_g_forest_rsp() + 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_main"))) + + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_g_forest_rsp: Module initializes with specified + label, arm_var, paramcd, aval_var, responders, subgroup_var, strata_var, + conf_level, fixed_symbol_size, rel_width_forest, font_size.", + { + skip_if_too_deep(5) + + app_driver <- app_driver_tm_g_forest_rsp() + + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Forest Response" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("arm_var-dataset_ADSL_singleextract-select"), + "ARMCD" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("paramcd-dataset_ADRS_singleextract-filter1-vals"), + "INVET" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("aval_var-dataset_ADRS_singleextract-select"), + "AVALC" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("responders"), + c("Complete Response (CR)", "Partial Response (PR)") + ) + + testthat::expect_equal( + app_driver$get_active_module_input("subgroup_var-dataset_ADSL_singleextract-select"), + c("SEX", "BMRKR2") + ) + testthat::expect_equal( + app_driver$get_active_module_input("strata_var-dataset_ADSL_singleextract-select"), + "STRATA2" + ) + 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"), + 15 + ) + + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_g_forest_rsp: Selecting arm_var changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + plot_before <- app_driver$get_active_module_pws_output("myplot") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-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_rsp: Deselecting arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text("myplot-plot_out_main"), + "Treatment variable must be selected" + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_forest_rsp: Selecting paramcd changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + plot_before <- app_driver$get_active_module_pws_output("myplot") + app_driver$set_active_module_input("paramcd-dataset_ADRS_singleextract-filter1-vals", "OVRINV") + 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_rsp: Deselecting paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + app_driver$set_active_module_input("paramcd-dataset_ADRS_singleextract-filter1-vals", NULL) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text("myplot-plot_out_main"), + "Please select Endpoint filter" + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_forest_rsp: Selecting responders changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + plot_before <- app_driver$get_active_module_pws_output("myplot") + app_driver$set_active_module_input("responders", "Complete Response (CR)") + 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_rsp: Deselecting responders throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + app_driver$set_active_module_input("responders", NULL) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text("myplot-plot_out_main"), + "`Responders` field is empty" + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_forest_rsp: Selecting subgroup_var changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + plot_before <- app_driver$get_active_module_pws_output("myplot") + app_driver$set_active_module_input("subgroup_var-dataset_ADSL_singleextract-select", c("SEX", "BMRKR2", "AGEU")) + 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_rsp: Selecting a non-factors column in subgroup_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + app_driver$set_active_module_input("subgroup_var-dataset_ADSL_singleextract-select", c("SEX", "AGE")) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text("myplot-plot_out_main"), + "Not all subgroup variables are factors" + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_forest_rsp: Deselecting subgroup_var changes plot and doesn't throw validation errors.", { # nolint: line_length + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + plot_before <- app_driver$get_active_module_pws_output("myplot") + app_driver$set_active_module_input("subgroup_var-dataset_ADSL_singleextract-select", NULL) + 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_rsp: Selecting strata_var changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + plot_before <- app_driver$get_active_module_pws_output("myplot") + app_driver$set_active_module_input("strata_var-dataset_ADSL_singleextract-select", "STRATA1") + 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_rsp: Deselecting strata_var changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + plot_before <- app_driver$get_active_module_pws_output("myplot") + app_driver$set_active_module_input("strata_var-dataset_ADSL_singleextract-select", NULL) + 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_rsp: Selecting conf_level changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + plot_before <- app_driver$get_active_module_pws_output("myplot") + app_driver$set_active_module_input("conf_level", "0.9") + 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_rsp: Deselecting conf_level or selecting outside the range of 0-1 throws validation error.", { # nolint: line_length + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + app_driver$set_active_module_input("conf_level", NULL) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text("myplot-plot_out_main"), + "Please choose a confidence level between 0 and 1" + ) + app_driver$set_active_module_input("conf_level", 2) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text("myplot-plot_out_main"), + "Please choose a confidence level between 0 and 1" + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_forest_rsp: Unsetting fixed_symbol_size changes plot and doesn't throw validation errors.", { # nolint: line_length + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + plot_before <- app_driver$get_active_module_pws_output("myplot") + app_driver$set_active_module_input("fixed_symbol_size", FALSE) + 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_rsp: Changing rel_width_forest changes plot and doesn't throw validation errors.", { # nolint: line_length + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + plot_before <- app_driver$get_active_module_pws_output("myplot") + app_driver$set_active_module_input("rel_width_forest", 30) + 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_rsp: Changing font_size changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_forest_rsp() + plot_before <- app_driver$get_active_module_pws_output("myplot") + app_driver$set_active_module_input("font_size", 25) + testthat::expect_false(identical(plot_before, app_driver$get_active_module_pws_output("myplot"))) + app_driver$expect_no_validation_error() + app_driver$stop() +})