From 79a849cee6219106fc8d722dd5f8e86a1bcab124 Mon Sep 17 00:00:00 2001 From: Marcin <133694481+m7pr@users.noreply.github.com> Date: Thu, 25 Apr 2024 15:58:28 +0200 Subject: [PATCH 1/2] Wave 1 - `tm_a_gee` shinytests (#1127) Part of #1108 We can move `active_module_tws_output` to be a method of `teal:::TealAppDriver` --------- Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com> Co-authored-by: kartikeya kirar --- .github/workflows/check.yaml | 2 + R/tm_a_gee.R | 2 +- tests/testthat/test-shinytest2-tm_a_gee.R | 294 ++++++++++++++++++++++ 3 files changed, 297 insertions(+), 1 deletion(-) create mode 100644 tests/testthat/test-shinytest2-tm_a_gee.R diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index cc21eb858a..f44c1ca3b0 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -10,9 +10,11 @@ on: - ready_for_review branches: - main + - shinytest2@main push: branches: - main + - shinytest2@main workflow_dispatch: jobs: diff --git a/R/tm_a_gee.R b/R/tm_a_gee.R index 42909bc981..e636bc8e16 100644 --- a/R/tm_a_gee.R +++ b/R/tm_a_gee.R @@ -448,7 +448,7 @@ srv_gee <- function(id, iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() - iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level.")) + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level")) iv$add_rule( "conf_level", shinyvalidate::sv_between( diff --git a/tests/testthat/test-shinytest2-tm_a_gee.R b/tests/testthat/test-shinytest2-tm_a_gee.R new file mode 100644 index 0000000000..04cd396559 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_a_gee.R @@ -0,0 +1,294 @@ +app_driver_tm_a_gee <- function() { + data <- teal.data::teal_data() + data <- within(data, { + library(dplyr) + ADSL <- tmc_ex_adsl + ADQS <- tmc_ex_adqs %>% + filter(ABLFL != "Y" & ABLFL2 != "Y") %>% + mutate( + AVISIT = as.factor(AVISIT), + AVISITN = rank(AVISITN) %>% + as.factor() %>% + as.numeric() %>% + as.factor(), + AVALBIN = AVAL < 50 # Just as an example to get a binary endpoint. + ) %>% + droplevels() + }) + datanames <- c("ADSL", "ADQS") + teal.data::datanames(data) <- datanames + teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[datanames] + + init_teal_app_driver( + data = data, + modules = tm_a_gee( + label = "GEE", + dataname = "ADQS", + aval_var = teal.transform::choices_selected("AVALBIN", fixed = TRUE), + id_var = teal.transform::choices_selected(c("USUBJID", "SUBJID"), "USUBJID"), + arm_var = teal.transform::choices_selected(c("ARM", "ARMCD"), "ARM"), + visit_var = teal.transform::choices_selected(c("AVISIT", "AVISITN"), "AVISIT"), + paramcd = teal.transform::choices_selected( + choices = teal.transform::value_choices(data[["ADQS"]], "PARAMCD", "PARAM"), + selected = "FKSI-FWB" + ), + cov_var = teal.transform::choices_selected(c("BASE", "AGE", "SEX", "BASE:AVISIT"), NULL), + conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8, -1), 0.95, keep_order = TRUE) + ) + ) +} + +testthat::test_that("e2e - tm_a_gee: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + + app_driver <- app_driver_tm_a_gee() + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() + testthat::expect_true(app_driver$is_visible(app_driver$active_module_element("table-table-with-settings"))) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_a_gee: Starts with specified label, id_var, arm_var, visit_var, paramcd, cov_var, + conf_level and conf_struct.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "GEE" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("aval_var-dataset_ADQS_singleextract-select"), + "AVALBIN" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("id_var-dataset_ADQS_singleextract-select"), + "USUBJID" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("arm_var-dataset_ADSL_singleextract-select"), + "ARM" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("visit_var-dataset_ADQS_singleextract-select"), + "AVISIT" + ) + testthat::expect_equal( + app_driver$get_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals"), + "FKSI-FWB" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("cov_var-dataset_ADQS_singleextract-select"), + NULL + ) + + testthat::expect_equal(app_driver$get_active_module_input("conf_level"), "0.95") + + testthat::expect_equal(app_driver$get_active_module_input("cor_struct"), "unstructured") + + radio_buttons <- app_driver$active_module_element_text("output_table") + testthat::expect_match( + radio_buttons, + "Output Type.*LS means.*Covariance.*Coefficients", + fixed = FALSE + ) + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_a_gee: Selection of id_var changes the table and does not throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + table_before <- app_driver$get_active_module_tws_output("table") + app_driver$set_active_module_input("id_var-dataset_ADQS_singleextract-select", "SUBJID") + testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_a_gee: Deselection of id_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + app_driver$set_active_module_input("id_var-dataset_ADQS_singleextract-select", character(0)) + testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("id_var-dataset_ADQS_singleextract-select_input > div > span"), + "A Subject identifier is required" + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_a_gee: Change in arm_var changes the table and does not throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + + table_before <- app_driver$get_active_module_tws_output("table") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_a_gee: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", character(0)) + testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input > div > span"), + "A treatment variable is required" + ) + app_driver$stop() +}) + + +testthat::test_that("e2e - tm_a_gee: Selection of visit_var changes the table and does not throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + table_before <- app_driver$get_active_module_tws_output("table") + app_driver$set_active_module_input("visit_var-dataset_ADQS_singleextract-select", "AVISITN") + testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_a_gee: Deselection of visit_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + app_driver$set_active_module_input("visit_var-dataset_ADQS_singleextract-select", character(0)) + testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("visit_var-dataset_ADQS_singleextract-select_input > div > span"), + "A visit variable is required" + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_a_gee: Selection of paramcd changes the table and does not throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + table_before <- app_driver$get_active_module_tws_output("table") + app_driver$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", "BFIALL") + testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_a_gee: Deselection of paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + app_driver$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", character(0)) + testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("paramcd-dataset_ADQS_singleextract-filter1-vals_input > div > span"), + "An endpoint is required" + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_a_gee: Selection of cov_var changes the table and does not throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + table_before <- app_driver$get_active_module_tws_output("table") + app_driver$set_active_module_input("cov_var-dataset_ADQS_singleextract-select", "BASE") + testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_a_gee: Deselection of cov_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + app_driver$set_active_module_input("cov_var-dataset_ADQS_singleextract-select", character(0)) + testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("cov_var-dataset_ADQS_singleextract-select_input > div > span"), + "An endpoint is required" + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_a_gee: Selection of conf_level changes the table and does not throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + table_before <- app_driver$get_active_module_tws_output("table") + app_driver$set_active_module_input("conf_level", 0.90) + testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_a_gee: Selection of conf_level out of [0,1] range throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + table_before <- app_driver$get_active_module_tws_output("table") + app_driver$set_active_module_input("conf_level", -1) + testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("conf_level_input > div > span"), + "Confidence level must be between 0 and 1" + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_a_gee: Deselection of conf_level throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + app_driver$set_active_module_input("conf_level", character(0)) + testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("conf_level_input > div > span"), + "Please choose a confidence level" + ) + app_driver$stop() +}) + + +testthat::test_that("e2e - tm_a_gee: Selection of cor_struct changes the table and does not throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + table_before <- app_driver$get_active_module_tws_output("table") + app_driver$set_active_module_input("cor_struct", "auto-regressive") + testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_a_gee: Deselection of cor_struct throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + app_driver$set_active_module_input("cor_struct", character(0)) + testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame()) + # TO BE FIXED - there is no error displayed + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("cov_struct_input > div > span"), + "Please choose a correlation structure" + ) + app_driver$stop() +}) + + +testthat::test_that("e2e - tm_a_gee: Selection of output_table changes the table and doesn't throw validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + table_before <- app_driver$get_active_module_tws_output("table") + app_driver$set_active_module_input("output_table", "t_gee_cov") + testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) From 8a9cc2b9cfac45a2007ef5473fdd5e5f224ac744 Mon Sep 17 00:00:00 2001 From: m7pr Date: Thu, 25 Apr 2024 13:59:26 +0000 Subject: [PATCH 2/2] [skip actions] Bump version to 0.9.0.9024 --- DESCRIPTION | 4 ++-- NEWS.md | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 369de23ed9..01d1c4c78c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: teal.modules.clinical Title: 'teal' Modules for Standard Clinical Outputs -Version: 0.9.0.9023 -Date: 2024-04-24 +Version: 0.9.0.9024 +Date: 2024-04-25 Authors@R: c( person("Joe", "Zhu", , "joe.zhu@roche.com", role = c("aut", "cre")), person("Jana", "Stoilova", , "jana.stoilova@roche.com", role = "aut"), diff --git a/NEWS.md b/NEWS.md index 64e036fee1..7b5da78583 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal.modules.clinical 0.9.0.9023 +# teal.modules.clinical 0.9.0.9024 ### Enhancements * Updated `tm_g_forest_rsp` and `tm_g_forest_tte` to use refactored version of `g_forest`. Plots are now displayed as `ggplot` objects instead of `grob` objects. Added parameters `font_size` and `rel_width_forest` to control font size and width of plot relative to table, respectively.