From 1cdbc7c604063f3f3e3709c11b6ba92c2988dcde Mon Sep 17 00:00:00 2001 From: Marcin <133694481+m7pr@users.noreply.github.com> Date: Fri, 10 May 2024 10:18:49 +0200 Subject: [PATCH] 1108 `{shinytest2}` feature branch (#1126) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Closes #1108 A unified branch for all partial PRs that will solve #1108 Merge at the end. Place where we can unify PRs --------- Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com> Signed-off-by: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Signed-off-by: kartikeya kirar Co-authored-by: m7pr Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Co-authored-by: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Co-authored-by: vedhav Co-authored-by: kartikeya kirar Co-authored-by: Dawid Kałędkowski <6959016+gogonzo@users.noreply.github.com> Co-authored-by: Dawid Kałędkowski Co-authored-by: gogonzo Co-authored-by: vedhav Co-authored-by: kartikeyakirar --- .github/workflows/check.yaml | 1 + DESCRIPTION | 11 +- R/tm_a_gee.R | 2 +- R/tm_g_pp_therapy.R | 5 +- tests/testthat/helper-TealAppDriver.R | 4 + tests/testthat/test-shinytest2-tm_a_gee.R | 324 ++++++++++ tests/testthat/test-shinytest2-tm_a_mmrm.R | 543 ++++++++++++++++ .../test-shinytest2-tm_g_barchart_simple.R | 348 ++++++++++ tests/testthat/test-shinytest2-tm_g_ci.R | 289 +++++++++ .../test-shinytest2-tm_g_forest_rsp.R | 336 ++++++++++ .../test-shinytest2-tm_g_forest_tte.R | 230 +++++++ tests/testthat/test-shinytest2-tm_g_ipp.R | 305 +++++++++ tests/testthat/test-shinytest2-tm_g_km.R | 389 +++++++++++ .../testthat/test-shinytest2-tm_g_lineplot.R | 231 +++++++ .../test-shinytest2-tm_g_pp_adverse_events.R | 416 ++++++++++++ ...test-shinytest2-tm_g_pp_patient_timeline.R | 603 ++++++++++++++++++ .../test-shinytest2-tm_g_pp_therapy.R | 235 +++++++ .../testthat/test-shinytest2-tm_g_pp_vitals.R | 239 +++++++ .../test-shinytest2-tm_t_abnormality.R | 225 +++++++ ...inytest2-tm_t_abnormality_by_worst_grade.R | 214 +++++++ tests/testthat/test-shinytest2-tm_t_ancova.R | 296 +++++++++ .../test-shinytest2-tm_t_binary_outcome.R | 302 +++++++++ tests/testthat/test-shinytest2-tm_t_coxreg.R | 260 ++++++++ tests/testthat/test-shinytest2-tm_t_events.R | 196 ++++++ .../test-shinytest2-tm_t_events_by_grade.R | 241 +++++++ .../test-shinytest2-tm_t_events_patyear.R | 177 +++++ .../test-shinytest2-tm_t_events_summary.R | 242 +++++++ .../testthat/test-shinytest2-tm_t_exposure.R | 250 ++++++++ .../testthat/test-shinytest2-tm_t_logistic.R | 203 ++++++ .../test-shinytest2-tm_t_mult_events.R | 157 +++++ .../test-shinytest2-tm_t_pp_basic_info.R | 130 ++++ .../test-shinytest2-tm_t_pp_laboratory.R | 370 +++++++++++ .../test-shinytest2-tm_t_pp_medical_history.R | 201 ++++++ ...test-shinytest2-tm_t_pp_prior_medication.R | 242 +++++++ .../test-shinytest2-tm_t_shift_by_arm.R | 195 ++++++ ...st-shinytest2-tm_t_shift_by_arm_by_worst.R | 275 ++++++++ .../test-shinytest2-tm_t_shift_by_grade.R | 218 +++++++ tests/testthat/test-shinytest2-tm_t_smq.R | 189 ++++++ tests/testthat/test-shinytest2-tm_t_summary.R | 137 ++++ .../test-shinytest2-tm_t_summary_by.R | 241 +++++++ tests/testthat/test-shinytest2-tm_t_tte.R | 257 ++++++++ 41 files changed, 9720 insertions(+), 9 deletions(-) create mode 100644 tests/testthat/test-shinytest2-tm_a_gee.R create mode 100644 tests/testthat/test-shinytest2-tm_a_mmrm.R create mode 100644 tests/testthat/test-shinytest2-tm_g_barchart_simple.R create mode 100644 tests/testthat/test-shinytest2-tm_g_ci.R create mode 100644 tests/testthat/test-shinytest2-tm_g_forest_rsp.R create mode 100644 tests/testthat/test-shinytest2-tm_g_forest_tte.R create mode 100644 tests/testthat/test-shinytest2-tm_g_ipp.R create mode 100644 tests/testthat/test-shinytest2-tm_g_km.R create mode 100644 tests/testthat/test-shinytest2-tm_g_lineplot.R create mode 100644 tests/testthat/test-shinytest2-tm_g_pp_adverse_events.R create mode 100644 tests/testthat/test-shinytest2-tm_g_pp_patient_timeline.R create mode 100644 tests/testthat/test-shinytest2-tm_g_pp_therapy.R create mode 100644 tests/testthat/test-shinytest2-tm_g_pp_vitals.R create mode 100644 tests/testthat/test-shinytest2-tm_t_abnormality.R create mode 100644 tests/testthat/test-shinytest2-tm_t_abnormality_by_worst_grade.R create mode 100644 tests/testthat/test-shinytest2-tm_t_ancova.R create mode 100644 tests/testthat/test-shinytest2-tm_t_binary_outcome.R create mode 100644 tests/testthat/test-shinytest2-tm_t_coxreg.R create mode 100644 tests/testthat/test-shinytest2-tm_t_events.R create mode 100644 tests/testthat/test-shinytest2-tm_t_events_by_grade.R create mode 100644 tests/testthat/test-shinytest2-tm_t_events_patyear.R create mode 100644 tests/testthat/test-shinytest2-tm_t_events_summary.R create mode 100644 tests/testthat/test-shinytest2-tm_t_exposure.R create mode 100644 tests/testthat/test-shinytest2-tm_t_logistic.R create mode 100644 tests/testthat/test-shinytest2-tm_t_mult_events.R create mode 100644 tests/testthat/test-shinytest2-tm_t_pp_basic_info.R create mode 100644 tests/testthat/test-shinytest2-tm_t_pp_laboratory.R create mode 100644 tests/testthat/test-shinytest2-tm_t_pp_medical_history.R create mode 100644 tests/testthat/test-shinytest2-tm_t_pp_prior_medication.R create mode 100644 tests/testthat/test-shinytest2-tm_t_shift_by_arm.R create mode 100644 tests/testthat/test-shinytest2-tm_t_shift_by_arm_by_worst.R create mode 100644 tests/testthat/test-shinytest2-tm_t_shift_by_grade.R create mode 100644 tests/testthat/test-shinytest2-tm_t_smq.R create mode 100644 tests/testthat/test-shinytest2-tm_t_summary.R create mode 100644 tests/testthat/test-shinytest2-tm_t_summary_by.R create mode 100644 tests/testthat/test-shinytest2-tm_t_tte.R diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index 3cf6030f08..a9fe73dc93 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -27,6 +27,7 @@ jobs: with: additional-env-vars: | _R_CHECK_CRAN_INCOMING_REMOTE_=false + TESTING_DEPTH=5 additional-r-cmd-check-params: --as-cran enforce-note-blocklist: true note-blocklist: | diff --git a/DESCRIPTION b/DESCRIPTION index 24968e33aa..5daa7ffd47 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: teal.modules.clinical Title: 'teal' Modules for Standard Clinical Outputs Version: 0.9.1.9003 -Date: 2024-05-08 +Date: 2024-05-09 Authors@R: c( person("Joe", "Zhu", , "joe.zhu@roche.com", role = c("aut", "cre")), person("Jana", "Stoilova", , "jana.stoilova@roche.com", role = "aut"), @@ -71,6 +71,7 @@ Suggests: lubridate (>= 1.7.9), nestcolor (>= 0.1.0), pkgload, + rvest, shinytest2, styler, testthat (>= 3.1.5), @@ -80,16 +81,16 @@ VignetteBuilder: Config/Needs/verdepcheck: insightsengineering/teal, insightsengineering/teal.transform, insightsengineering/tern, tidymodels/broom, mllg/checkmate, tidyverse/dplyr, rstudio/DT, - insightsengineering/formatters, tidyverse/ggplot2, slowkow/ggrepel, - r-lib/lifecycle, daroczig/logger, insightsengineering/rlistings, + tidyverse/ggplot2, slowkow/ggrepel, r-lib/lifecycle, + daroczig/logger, insightsengineering/rlistings, rstudio/rmarkdown, insightsengineering/rtables, r-lib/scales, rstudio/shiny, daattali/shinyjs, rstudio/shinyvalidate, dreamRs/shinyWidgets, insightsengineering/teal.code, insightsengineering/teal.data, insightsengineering/teal.logger, insightsengineering/teal.reporter, insightsengineering/teal.widgets, insightsengineering/tern.gee, insightsengineering/tern.mmrm, - tidyverse/tidyr, shosaco/vistime, tidyverse/forcats, yihui/knitr, - tidyverse/lubridate, insightsengineering/nestcolor, r-lib/pkgload, + shosaco/vistime, tidyverse/forcats, yihui/knitr, tidyverse/lubridate, + insightsengineering/nestcolor, r-lib/pkgload, tidyverse/rvest, rstudio/shinytest2, r-lib/styler, r-lib/testthat, r-lib/withr Config/Needs/website: insightsengineering/nesttemplate Config/testthat/edition: 3 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/R/tm_g_pp_therapy.R b/R/tm_g_pp_therapy.R index d1856305c2..eb54131f26 100644 --- a/R/tm_g_pp_therapy.R +++ b/R/tm_g_pp_therapy.R @@ -65,15 +65,14 @@ template_therapy <- function(dataname = "ANL", dataname[setdiff(cols_to_include, names(dataname))] <- NA - therapy_table <- - dataname %>% + therapy_table <- dataname %>% dplyr::filter(atirel %in% c("CONCOMITANT", "PRIOR")) %>% # removed PRIOR_CONCOMITANT dplyr::select(dplyr::all_of(cols_to_include)) %>% dplyr::filter(!is.na(cmdecod)) %>% dplyr::mutate(Dosage = paste(cmdose, cmdosu, cmdosfrq, cmroute)) %>% dplyr::select(-cmdose, -cmdosu, -cmdosfrq, -cmroute) %>% dplyr::select(cmindc, cmdecod, Dosage, dplyr::everything()) %>% - dplyr::mutate(CMDECOD = dplyr::case_when( + dplyr::mutate(!!cmdecod_char := dplyr::case_when( nchar(as.character(cmdecod)) > 20 ~ as.character(cmtrt), TRUE ~ as.character(cmdecod) )) %>% diff --git a/tests/testthat/helper-TealAppDriver.R b/tests/testthat/helper-TealAppDriver.R index b28850e396..c0c29a7e43 100644 --- a/tests/testthat/helper-TealAppDriver.R +++ b/tests/testthat/helper-TealAppDriver.R @@ -23,3 +23,7 @@ init_teal_app_driver <- function(...) { .package = "teal" ) } + +ns_des_input <- function(id, dataname, type) { + sprintf("%s-dataset_%s_singleextract-%s", id, dataname, type) +} 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..3563f2e9f6 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_a_gee.R @@ -0,0 +1,324 @@ +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", + parentname = "ADSL", + 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), + arm_ref_comp = NULL, + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +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(ns_des_input("aval_var", "ADQS", "select")), + "AVALBIN" + ) + + testthat::expect_equal( + app_driver$get_active_module_input(ns_des_input("id_var", "ADQS", "select")), + "USUBJID" + ) + + testthat::expect_equal( + app_driver$get_active_module_input(ns_des_input("arm_var", "ADSL", "select")), + "ARM" + ) + + testthat::expect_equal( + app_driver$get_active_module_input(ns_des_input("visit_var", "ADQS", "select")), + "AVISIT" + ) + testthat::expect_equal( + app_driver$get_active_module_input(ns_des_input("paramcd", "ADQS", "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 does not change 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_table_output("table-table-with-settings") + app_driver$set_active_module_input(ns_des_input("id_var", "ADQS", "select"), "SUBJID") + testthat::expect_true( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + 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(ns_des_input("id_var", "ADQS", "select"), character(0)) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), 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_table_output("table-table-with-settings") + app_driver$set_active_module_input(ns_des_input("arm_var", "ADSL", "select"), "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + 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(ns_des_input("arm_var", "ADSL", "select"), character(0)) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), 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 does not change 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_table_output("table-table-with-settings") + app_driver$set_active_module_input(ns_des_input("visit_var", "ADQS", "select"), "AVISITN") + testthat::expect_true( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + 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(ns_des_input("visit_var", "ADQS", "select"), character(0)) + app_driver$wait_for_idle() + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), 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_table_output("table-table-with-settings") + app_driver$set_active_module_input(ns_des_input("paramcd", "ADQS", "filter1-vals"), "BFIALL") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + 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(ns_des_input("paramcd", "ADQS", "filter1-vals"), character(0)) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), 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_table_output("table-table-with-settings") + app_driver$set_active_module_input("cov_var-dataset_ADQS_singleextract-select", "BASE") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + 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_table_output("table-table-with-settings") + app_driver$set_active_module_input("conf_level", 0.90) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + 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_table_output("table-table-with-settings") + app_driver$set_active_module_input("conf_level", -1) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), 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_table_output("table-table-with-settings"), 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_table_output("table-table-with-settings") + app_driver$set_active_module_input("cor_struct", "auto-regressive") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_a_gee: Deselection of cor_struct does not throw validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_gee() + app_driver$set_active_module_input("cor_struct", character(0), wait_ = FALSE) # not waiting because of a warning + app_driver$expect_no_validation_error() + 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_table_output("table-table-with-settings") + app_driver$set_active_module_input("output_table", "t_gee_cov") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R new file mode 100644 index 0000000000..d992fcb4e6 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -0,0 +1,543 @@ +app_driver_tm_a_mmrm <- function(fit_model = TRUE) { # nolint: object_length. + arm_ref_comp <- list( + ARMCD = list( + ref = "ARM B", + comp = c("ARM A", "ARM C") + ) + ) + + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- tmc_ex_adsl + ADQS <- tmc_ex_adqs %>% + dplyr::filter(ABLFL != "Y" & ABLFL2 != "Y") %>% + dplyr::filter(AVISIT %in% c("WEEK 1 DAY 8", "WEEK 2 DAY 15", "WEEK 3 DAY 22")) %>% + dplyr::mutate( + AVISIT = as.factor(AVISIT), + AVISITN = rank(AVISITN) %>% + as.factor() %>% + as.numeric() %>% + as.factor() #' making consecutive numeric factor + ) + }) + + datanames <- c("ADSL", "ADQS") + teal.data::datanames(data) <- datanames + teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[datanames] + + arm_var <- choices_selected(c("ARM", "ARMCD"), "ARM") + + app_driver <- init_teal_app_driver( + data = data, + modules = tm_a_mmrm( + label = "MMRM", + dataname = "ADQS", + parentname = ifelse(inherits(arm_var, "data_extract_spec"), + teal.transform::datanames_input(arm_var), "ADSL" + ), + aval_var = choices_selected(c("AVAL", "CHG"), "AVAL"), + id_var = choices_selected(c("USUBJID", "SUBJID"), "USUBJID"), + arm_var = arm_var, + visit_var = choices_selected(c("AVISIT", "AVISITN"), "AVISIT"), + arm_ref_comp = arm_ref_comp, + paramcd = choices_selected( + choices = value_choices(data[["ADQS"]], "PARAMCD", "PARAM"), + selected = "FKSI-FWB" + ), + cov_var = choices_selected(c("BASE", "AGE", "SEX", "BASE:AVISIT"), NULL), + method = teal.transform::choices_selected(c( + "Satterthwaite", "Kenward-Roger", + "Kenward-Roger-Linear" + ), "Satterthwaite", keep_order = TRUE), + conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, + keep_order = + TRUE + ), + plot_height = c(700L, 200L, 2000L), + plot_width = NULL, + total_label = default_total_label(), + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args(), + ggplot2_args = teal.widgets::ggplot2_args() + ), + timeout = 30000 + ) + if (fit_model) { + app_driver$click(selector = app_driver$active_module_element("button_start")) + } + app_driver +} + +output_functions <- c( + "t_mmrm_lsmeans", + "g_mmrm_lsmeans", + "t_mmrm_cov", + "t_mmrm_fixed", + "t_mmrm_diagnostic", + "g_mmrm_diagnostic" +) + +testthat::test_that( + "e2e - tm_a_mmrm: Module initializes in teal without errors and displays a message to click 'Fit Model'.", + { + skip_if_too_deep(5) + + app_driver <- app_driver_tm_a_mmrm(FALSE) + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() + + null_text <- app_driver$active_module_element_text("null_input_msg") + + testthat::expect_match(null_text, "Please first specify 'Model Settings' and press 'Fit Model'") + + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_a_mmrm: Module initializes with specified label, aval_var, paramcd, + visit_var, cov_var, arm_var, buckets, combine_comp_arms, id_var, cor_struct, + weights_emmeans, conf_level, method, parallel and output_function.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm(FALSE) + + testthat::expect_equal(app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), "MMRM") + + testthat::expect_equal(app_driver$get_active_module_input("aval_var-dataset_ADQS_singleextract-select"), "AVAL") + + 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("visit_var-dataset_ADQS_singleextract-select"), "AVISIT") + + testthat::expect_null(app_driver$get_active_module_input("cov_var-dataset_ADQS_singleextract-select")) + + 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("buckets"), + list( + Ref = list("A: Drug X"), + Comp = list("B: Placebo", "C: Combination") + ) + ) + + testthat::expect_false(app_driver$get_active_module_input("combine_comp_arms")) + + 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("weights_emmeans"), "proportional") + + testthat::expect_equal(app_driver$get_active_module_input("cor_struct"), "unstructured") + + testthat::expect_equal(app_driver$get_active_module_input("conf_level"), "0.95") + + testthat::expect_equal(app_driver$get_active_module_input("method"), "Satterthwaite") + + testthat::expect_true(app_driver$get_active_module_input("parallel")) + + testthat::expect_equal(app_driver$get_active_module_input("output_function"), "t_mmrm_lsmeans") + + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_a_mmrm: Click on fit model shows table for default selection.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + app_driver$expect_no_validation_error() + + table <- app_driver$get_active_module_table_output("mmrm_table-table-with-settings") + col_val <- app_driver$get_active_module_input("buckets") + testthat::expect_true(all(unlist(col_val, use.names = FALSE) %in% colnames(table))) + testthat::expect_equal(nrow(table), 25) + + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_a_mmrm: Function t_mmrm_lsmeans selection shows output settings; changing + settings throws no validation errors and verify visibility of generated tables.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + + app_driver$click(selector = app_driver$active_module_element("button_start")) + app_driver$expect_no_validation_error() + + app_driver$set_active_module_input("output_function", "t_mmrm_lsmeans", wait_ = FALSE) + app_driver$expect_no_validation_error() + + testthat::expect_equal(app_driver$get_active_module_input("t_mmrm_lsmeans_show_relative"), "reduction") + app_driver$set_active_module_input("t_mmrm_lsmeans_show_relative", "increase") + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_a_mmrm: Function g_mmrm_lsmeans selection shows output settings; changing + settings throws no validation errors and verify visibility of generated plots.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + + app_driver$click(selector = app_driver$active_module_element("button_start")) + app_driver$expect_no_validation_error() + + app_driver$set_active_module_input("output_function", "g_mmrm_lsmeans", wait_ = FALSE) + app_driver$expect_no_validation_error() + + plot_before <- app_driver$get_active_module_plot_output("mmrm_plot") + testthat::expect_match(plot_before, "data:image/png;base64,") + + app_driver$set_active_module_input("g_mmrm_lsmeans_select", "estimates") + app_driver$expect_no_validation_error() + app_driver$set_active_module_input("g_mmrm_lsmeans_select", "contrasts") + app_driver$expect_no_validation_error() + + app_driver$set_active_module_input( + "g_mmrm_lsmeans_select", + c("estimates", "contrasts") + ) + app_driver$expect_no_validation_error() + + app_driver$set_active_module_input("g_mmrm_lsmeans_width", 0.9) + app_driver$expect_no_validation_error() + + app_driver$set_active_module_input("g_mmrm_lsmeans_contrasts_show_pval", TRUE) + app_driver$expect_no_validation_error() + + plot <- app_driver$get_active_module_plot_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") + + testthat::expect_false(identical(plot_before, plot)) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_a_mmrm: Function g_mmrm_diagnostic selection shows output settings; changing + settings throws no validation errors and verify visibility of generated plots.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + + app_driver$click(selector = app_driver$active_module_element("button_start")) + app_driver$expect_no_validation_error() + + app_driver$set_active_module_input("output_function", "g_mmrm_diagnostic", wait_ = FALSE) + app_driver$expect_no_validation_error() + + plot_before <- app_driver$get_active_module_plot_output("mmrm_plot") + testthat::expect_match(plot_before, "data:image/png;base64,") + + app_driver$set_active_module_input("g_mmrm_diagnostic_type", "q-q-residual") + app_driver$expect_no_validation_error() + + plot <- app_driver$get_active_module_plot_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") + + testthat::expect_false(identical(plot_before, plot)) + app_driver$stop() + } +) + +for (func in output_functions) { + testthat::test_that( + sprintf( + "e2e - tm_a_mmrm: Deselection of aval_var throws validation error in method %s.", + func + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + # Set initial output function + app_driver$set_active_module_input("output_function", func, wait_ = FALSE) + app_driver$expect_no_validation_error() + + app_driver$set_active_module_input("aval_var-dataset_ADQS_singleextract-select", character(0L)) + if (grepl("^g_", func)) { + testthat::expect_identical(app_driver$get_active_module_plot_output("mmrm_plot"), character(0)) + } else { + testthat::expect_identical( + app_driver$get_active_module_table_output("mmrm_table-table-with-settings"), data.frame() + ) + } + + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_des_input("aval_var", "ADQS", "select_input") + ) + ), + "Analysis Variable' field is not selected" + ) + app_driver$expect_validation_error() + app_driver$stop() + } + ) + + testthat::test_that( + sprintf( + "e2e - tm_a_mmrm: Deselection paramcd throws validation error in method %s.", + func + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + # Set initial output function + app_driver$set_active_module_input("output_function", func, wait_ = FALSE) + app_driver$expect_no_validation_error() + + app_driver$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", character(0L)) + if (grepl("^g_", func)) { + testthat::expect_identical(app_driver$get_active_module_plot_output("mmrm_plot"), character(0)) + } else { + testthat::expect_identical( + app_driver$get_active_module_table_output("mmrm_table-table-with-settings"), data.frame() + ) + } + + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_des_input("paramcd", "ADQS", "filter1-vals_input") + ) + ), + "Select Endpoint' field is not selected" + ) + app_driver$expect_validation_error() + app_driver$stop() + } + ) + + testthat::test_that( + sprintf( + "e2e - tm_a_mmrm: Deselection of visit_var throws validation error in method %s.", + func + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + # Set initial output function + app_driver$set_active_module_input("output_function", func, wait_ = FALSE) + app_driver$expect_no_validation_error() + + app_driver$set_active_module_input("visit_var-dataset_ADQS_singleextract-select", character(0L)) + if (grepl("^g_", func)) { + testthat::expect_identical(app_driver$get_active_module_plot_output("mmrm_plot"), character(0)) + } else { + testthat::expect_identical( + app_driver$get_active_module_table_output("mmrm_table-table-with-settings"), data.frame() + ) + } + + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_des_input("visit_var", "ADQS", "select_input") + ) + ), + "Visit Variable' field is not selected" + ) + app_driver$expect_validation_error() + app_driver$stop() + } + ) + + testthat::test_that( + sprintf( + "e2e - tm_a_mmrm: Deselection of arm_var throws validation error in method %s.", + func + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + # Set initial output function + app_driver$set_active_module_input("output_function", func, wait_ = FALSE) + app_driver$expect_no_validation_error() + + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", character(0L)) + if (grepl("^g_", func)) { + testthat::expect_identical(app_driver$get_active_module_plot_output("mmrm_plot"), character(0)) + } else { + testthat::expect_identical( + app_driver$get_active_module_table_output("mmrm_table-table-with-settings"), data.frame() + ) + } + + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_des_input("arm_var", "ADSL", "select_input") + ) + ), + "Treatment variable must be selected" + ) + app_driver$expect_validation_error() + app_driver$stop() + } + ) + + testthat::test_that( + sprintf( + "e2e - tm_a_mmrm: Deselection of id_var throws validation error in method %s.", + func + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + # Set initial output function + app_driver$set_active_module_input("output_function", func, wait_ = FALSE) + app_driver$expect_no_validation_error() + + app_driver$set_active_module_input("id_var-dataset_ADQS_singleextract-select", character(0L)) + if (grepl("^g_", func)) { + testthat::expect_identical(app_driver$get_active_module_plot_output("mmrm_plot"), character(0)) + } else { + testthat::expect_identical( + app_driver$get_active_module_table_output("mmrm_table-table-with-settings"), data.frame() + ) + } + + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_des_input("id_var", "ADQS", "select_input") + ) + ), + "Subject Identifier' field is not selected" + ) + app_driver$expect_validation_error() + app_driver$stop() + } + ) + + testthat::test_that( + sprintf( + "e2e - tm_a_mmrm: Deselection of conf_level throws validation error in method %s.", + func + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + # Set initial output function + app_driver$set_active_module_input("output_function", func, wait_ = FALSE) + app_driver$expect_no_validation_error() + + app_driver$set_active_module_input("conf_level", numeric(0L)) + if (grepl("^g_", func)) { + testthat::expect_identical(app_driver$get_active_module_plot_output("mmrm_plot"), character(0)) + } else { + testthat::expect_identical( + app_driver$get_active_module_table_output("mmrm_table-table-with-settings"), data.frame() + ) + } + + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + "conf_level_input" + ) + ), + "Confidence Level' field is not selected" + ) + app_driver$expect_validation_error() + app_driver$stop() + } + ) +} + +input_list <- list( + "aval_var-dataset_ADQS_singleextract-select" = "CHG", + "paramcd-dataset_ADQS_singleextract-filter1-vals" = "BFIALL", + "visit_var-dataset_ADQS_singleextract-select" = "AVISITN", + "cov_var-dataset_ADQS_singleextract-select" = "AGE", + "arm_var-dataset_ADSL_singleextract-select" = "ARMCD", + "combine_comp_arms" = TRUE, + "id_var-dataset_ADQS_singleextract-select" = "SUBJID", + "weights_emmeans" = "equal", + "cor_struct" = "ante-dependence", + "conf_level" = "0.8", + "method" = "Kenward-Roger" +) + +non_responsive_conditions <- list( + "g_mmrm_lsmeans" = c("id_var-dataset_ADQS_singleextract-select"), + "g_mmrm_diagnostic" = c( + "arm_var-dataset_ADSL_singleextract-select", + "id_var-dataset_ADQS_singleextract-select", + "weights_emmeans", + "cor_struct", + "conf_level", + "method" + ) +) +# TODO: Remove the conditional skipping logic once the following issues are resolved: +# Issue 1153: https://github.com/insightsengineering/teal.modules.clinical/issues/1153 +# Issue 1151: https://github.com/insightsengineering/teal.modules.clinical/issues/1151 + +# Iterate over each output function +for (func in output_functions) { + testthat::test_that( + sprintf( + "e2e - tm_a_mmrm: Validate output on different selection on method %s.", + func + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + # Set initial output function + app_driver$set_active_module_input("output_function", func, wait_ = FALSE) + app_driver$expect_no_validation_error() + + + if (grepl("^g_", func)) { + plot_before <- app_driver$get_active_module_plot_output("mmrm_plot") + } else { + table_before <- app_driver$get_active_module_table_output("mmrm_table-table-with-settings") + } + + # Iterate over each input and test changes + for (input_name in names(input_list)) { + if (input_name %in% non_responsive_conditions[[func]]) { + next + } + + app_driver$set_active_module_input(input_name, input_list[[input_name]]) + app_driver$click(selector = app_driver$active_module_element("button_start")) + app_driver$expect_no_validation_error() + + # Check output based on function type (plot or table) + if (grepl("^g_", func)) { + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("mmrm_plot") + ) + ) + plot_before <- app_driver$get_active_module_plot_output("mmrm_plot") + } else { + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("mmrm_table-table-with-settings") + ) + ) + } + } + app_driver$stop() + } + ) +} diff --git a/tests/testthat/test-shinytest2-tm_g_barchart_simple.R b/tests/testthat/test-shinytest2-tm_g_barchart_simple.R new file mode 100644 index 0000000000..b77376da53 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_g_barchart_simple.R @@ -0,0 +1,348 @@ +app_driver_tm_g_barchart_simple <- function() { # nolint: object_length. + data <- within(teal.data::teal_data(), { + ADSL <- dplyr::mutate( + teal.modules.clinical::tmc_ex_adsl, + ITTFL = with_label(factor("Y"), "Intent-To-Treat Population Flag") + ) + + ADAE <- dplyr::filter( + teal.modules.clinical::tmc_ex_adae, + !((AETOXGR == 1) & (AESEV == "MILD") & (ARM == "A: Drug X")) + ) + }) + + datanames <- c("ADSL", "ADAE") + 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_g_barchart_simple( + label = "ADAE Analysis (e2e)", + x = teal.transform::data_extract_spec( + dataname = "ADSL", + select = teal.transform::select_spec( + choices = teal.transform::variable_choices( + "ADSL", c("ARM", "ACTARM", "SEX", "RACE", "ITTFL", "SAFFL", "STRATA2") + ), + selected = "ACTARM", + multiple = FALSE + ) + ), + fill = list( + teal.transform::data_extract_spec( + dataname = "ADSL", + select = teal.transform::select_spec( + choices = teal.transform::variable_choices( + "ADSL", c("ARM", "ACTARM", "SEX", "RACE", "ITTFL", "SAFFL", "STRATA2") + ), + selected = "SEX", + multiple = FALSE + ) + ), + teal.transform::data_extract_spec( + dataname = "ADAE", + select = teal.transform::select_spec( + choices = teal.transform::variable_choices("ADAE", c("AETOXGR", "AESEV", "AESER")), + selected = NULL, + multiple = FALSE + ) + ) + ), + x_facet = list( + teal.transform::data_extract_spec( + dataname = "ADAE", + select = teal.transform::select_spec( + choices = teal.transform::variable_choices("ADAE", c("AETOXGR", "AESEV", "AESER")), + selected = "AETOXGR", + multiple = FALSE + ) + ), + teal.transform::data_extract_spec( + dataname = "ADSL", + select = teal.transform::select_spec( + choices = teal.transform::variable_choices( + "ADSL", + c("ARM", "ACTARM", "SEX", "RACE", "ITTFL", "SAFFL", "STRATA2") + ), + selected = NULL, + multiple = FALSE + ) + ) + ), + y_facet = list( + data_extract_spec( + dataname = "ADAE", + select = teal.transform::select_spec( + choices = teal.transform::variable_choices( + "ADAE", + c("AETOXGR", "AESEV", "AESER") + ), + selected = "AESEV", + multiple = FALSE + ) + ), + data_extract_spec( + dataname = "ADSL", + select = teal.transform::select_spec( + choices = teal.transform::variable_choices( + "ADSL", + c("ARM", "ACTARM", "SEX", "RACE", "ITTFL", "SAFFL", "STRATA2") + ), + selected = NULL, + multiple = FALSE + ) + ) + ), + plot_options = list( + stacked = TRUE, + label_bars = FALSE, + rotate_bar_labels = TRUE, + rotate_x_label = TRUE, + rotate_y_label = TRUE, + flip_axis = TRUE, + show_n = FALSE + ), + plot_height = c(600L, 200L, 2000L), + plot_width = NULL, + pre_output = NULL, + post_output = NULL, + ggplot2_args = teal.widgets::ggplot2_args() + ) + ) +} + +# Initialization -------------------------------------------------------------- + +testthat::test_that("e2e - tm_g_barchart_simple: Module initializes in teal without errors and produces output.", { + skip_if_too_deep(5) + + app_driver <- app_driver_tm_g_barchart_simple() + 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")) + ) + + testthat::expect_true(app_driver$is_visible(app_driver$active_module_element("table"))) + + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_g_barchart_simple: 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_g_barchart_simple() + + testthat::expect_equal( + trimws(app_driver$get_text("#teal-main_ui-root-active_tab > li.active")), + "ADAE Analysis (e2e)" + ) + + testthat::expect_equal( + app_driver$get_active_module_input(ns_des_input("x", "ADSL", "select")), + "ACTARM" + ) + + testthat::expect_equal(app_driver$get_active_module_input("fill-dataset"), "ADSL") + + testthat::expect_equal( + app_driver$get_active_module_input(ns_des_input("fill", "ADSL", "select")), + "SEX" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("x_facet-dataset"), + "ADAE" + ) + + testthat::expect_equal( + app_driver$get_active_module_input(ns_des_input("x_facet", "ADAE", "select")), + "AETOXGR" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("y_facet-dataset"), + "ADAE" + ) + + testthat::expect_equal( + app_driver$get_active_module_input(ns_des_input("y_facet", "ADAE", "select")), + "AESEV" + ) + + # Plot settings ----------------------------------------------------------- + # only tests the options that are customizable + + testthat::expect_equal(app_driver$get_active_module_input("barlayout"), "stacked") + testthat::expect_false(app_driver$get_active_module_input("label_bars")) + testthat::expect_true(app_driver$get_active_module_input("rotate_bar_labels")) + testthat::expect_true(app_driver$get_active_module_input("rotate_x_label")) + testthat::expect_true(app_driver$get_active_module_input("rotate_y_label")) + testthat::expect_true(app_driver$get_active_module_input("flip_axis")) + testthat::expect_false(app_driver$get_active_module_input("show_n")) + + app_driver$stop() + } +) + +# X-variable ------------------------------------------------------------------ + +testthat::test_that( + "e2e - tm_g_barchart_simple: Selection of 'x' changes the element and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_barchart_simple() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input(ns_des_input("x", "ADSL", "select"), "RACE") + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_g_barchart_simple: Deselection of 'x' throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_barchart_simple() + app_driver$set_active_module_input(ns_des_input("x", "ADSL", "select"), character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_des_input("x", "ADSL", "select_input") + ) + ), + "^Please select an x-variable$" + ) + app_driver$stop() +}) + +# Test pairs of dataset selection --------------------------------------------- + +test_dataset_selection <- function(input_id, new_dataset, new_value) { + testthat::test_that( + sprintf( + "e2e - tm_g_barchart_simple: Selection of '%s' dataset changes the element and does not throw validation errors.", + input_id + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_barchart_simple() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input(sprintf("%s-dataset", input_id), new_dataset) + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + testthat::expect_null(app_driver$get_active_module_input(ns_des_input(input_id, new_dataset, "select"))) + app_driver$set_active_module_input(ns_des_input(input_id, new_dataset, "select"), new_value) + testthat::expect_identical( + app_driver$get_active_module_input(ns_des_input(input_id, new_dataset, "select")), + new_value + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } + ) + + testthat::test_that( + sprintf( + "%s: Deselection of '%s' dataset changes the element and does not throw validation errors.", + "e2e - tm_g_barchart_simple", + input_id + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_barchart_simple() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input(sprintf("%s-dataset", input_id), character(0L)) + testthat::expect_null(app_driver$get_active_module_input(input_id)) + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$expect_no_validation_error() + app_driver$stop() + } + ) +} + +test_dataset_selection("fill", "ADAE", "AESER") +test_dataset_selection("x_facet", "ADSL", "RACE") +test_dataset_selection("y_facet", "ADSL", "ARM") + +# Duplicate variables cannot be selected -------------------------------------- + +for (input_id in c("fill", "x_facet", "y_facet")) { + testthat::test_that( + sprintf( + "e2e - tm_g_barchart_simple: Duplicate between 'x' and '%s' selection throws validation error.", + input_id + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_barchart_simple() + app_driver$set_active_module_input(ns_des_input("x", "ADSL", "select"), "ACTARM", wait_ = FALSE) + app_driver$set_active_module_input(sprintf("%s-dataset", input_id), "ADSL", wait_ = FALSE) + app_driver$set_active_module_input(ns_des_input(input_id, "ADSL", "select"), "ACTARM") + + app_driver$expect_validation_error() + + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_des_input("x", "ADSL", "select_input") + ) + ), + "^Duplicated value: ACTARM$" + ) + + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_des_input(input_id, "ADSL", "select_input") + ) + ), + "^Duplicated value: ACTARM$" + ) + app_driver$stop() + } + ) +} + +# Plot settings --------------------------------------------------------------- + +test_that_plot_settings <- function(input_id, new_value, setup_fun = function(app_driver) NULL) { + testthat::test_that( + sprintf( + "e2e - tm_g_barchart_simple: Changing '%s' changes the plot and does not throw validation errors.", + input_id + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_barchart_simple() + setup_fun(app_driver) + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input(input_id, new_value) + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$expect_no_validation_error() + app_driver$stop() + } + ) +} + +test_that_plot_settings("barlayout", "side_by_side") +test_that_plot_settings("expand_y_range", 0.9) +test_that_plot_settings("facet_scale_x", FALSE) +test_that_plot_settings("facet_scale_y", FALSE) +test_that_plot_settings("label_bars", TRUE) +test_that_plot_settings("rotate_x_label", FALSE) +test_that_plot_settings("rotate_y_label", FALSE) +test_that_plot_settings("flip_axis", FALSE) +test_that_plot_settings("show_n", TRUE) + +# needs extra setup +test_that_plot_settings( + "rotate_bar_labels", + FALSE, + setup_fun = function(app_driver) app_driver$set_active_module_input("label_bars", TRUE) +) diff --git a/tests/testthat/test-shinytest2-tm_g_ci.R b/tests/testthat/test-shinytest2-tm_g_ci.R new file mode 100644 index 0000000000..bcc79ed8f5 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_g_ci.R @@ -0,0 +1,289 @@ +app_driver_tm_g_ci <- function() { + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- teal.data::rADSL + ADLB <- teal.data::rADLB + }) + teal.data::datanames(data) <- c("ADSL", "ADLB") + teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[c("ADSL", "ADLB")] + init_teal_app_driver( + data = data, + modules = tm_g_ci( + label = "Confidence Interval Plot", + x_var = teal.transform::data_extract_spec( + dataname = "ADSL", + select = teal.transform::select_spec( + choices = c("ARMCD", "BMRKR2"), + selected = c("ARMCD"), + multiple = FALSE, + fixed = FALSE + ) + ), + y_var = teal.transform::data_extract_spec( + dataname = "ADLB", + filter = list( + teal.transform::filter_spec( + vars = "PARAMCD", + choices = c("ALT", "CRP", "IGA"), + selected = "ALT", + multiple = FALSE, + label = "Select lab:" + ), + teal.transform::filter_spec( + vars = "AVISIT", + choices = c( + "SCREENING", "BASELINE", "WEEK 1 DAY 8", "WEEK 2 DAY 15", + "WEEK 3 DAY 22", "WEEK 4 DAY 29", "WEEK 5 DAY 36" + ), + selected = "SCREENING", + multiple = FALSE, + label = "Select visit:" + ) + ), + select = teal.transform::select_spec( + label = "Analyzed Value", + choices = c("AVAL", "CHG", "CHG2"), + selected = "AVAL", + multiple = FALSE, + fixed = FALSE + ) + ), + color = teal.transform::data_extract_spec( + dataname = "ADSL", + select = teal.transform::select_spec( + label = "Color by variable", + choices = c("SEX", "STRATA1", "STRATA2"), + selected = c("STRATA1"), + multiple = FALSE, + fixed = FALSE + ) + ), + stat = c("mean", "median"), + conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, + keep_order = TRUE + ), + plot_height = c(700L, 200L, 2000L), + plot_width = NULL, + pre_output = NULL, + post_output = NULL, + ggplot2_args = teal.widgets::ggplot2_args() + ) + ) +} + +testthat::test_that("e2e - tm_g_ci: Module initializes in teal without errors and produces plot output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ci() + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() + testthat::expect_match(app_driver$get_active_module_plot_output("myplot"), "data:image/png;base64,") + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_g_ci: Module initializes with specified label, x_var, y_var, ADLB filters, color, conf_level and stat.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ci() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Confidence Interval Plot" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("x_var-dataset_ADSL_singleextract-select"), + "ARMCD" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("y_var-dataset_ADLB_singleextract-select"), + "AVAL" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("y_var-dataset_ADLB_singleextract-filter1-col"), + "PARAMCD" + ) + testthat::expect_equal( + app_driver$get_active_module_input("y_var-dataset_ADLB_singleextract-filter1-vals"), + "ALT" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("y_var-dataset_ADLB_singleextract-filter2-col"), + "AVISIT" + ) + testthat::expect_equal( + app_driver$get_active_module_input("y_var-dataset_ADLB_singleextract-filter2-vals"), + "SCREENING" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("color-dataset_ADSL_singleextract-select"), + "STRATA1" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("conf_level"), + "0.95" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("stat"), + "mean" + ) + + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_g_ci: Selecting x_var column changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ci() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("x_var-dataset_ADSL_singleextract-select", "BMRKR2") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ci: Deselecting x_var column throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ci() + app_driver$set_active_module_input("x_var-dataset_ADSL_singleextract-select", character(0)) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + app_driver$expect_validation_error() + testthat::expect_identical( + app_driver$active_module_element_text("x_var-dataset_ADSL_singleextract-select_input > div > span"), + "Select a treatment (x axis)" + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ci: Selecting y_var column changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ci() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("y_var-dataset_ADLB_singleextract-select", "CHG2") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ci: Deselecting y_var column throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ci() + app_driver$set_active_module_input("y_var-dataset_ADLB_singleextract-select", character(0)) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("y_var-dataset_ADLB_singleextract-select_input > div > span"), + "Select an analysis value (y axis)" + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_g_ci: Selecting PARAMCD filter value changes plot and doesn't throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ci() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("y_var-dataset_ADLB_singleextract-filter1-vals", "CRP") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_g_ci: Deselecting PARAMCD filter value throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ci() + app_driver$set_active_module_input("y_var-dataset_ADLB_singleextract-filter1-vals", character(0)) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("y_var-dataset_ADLB_singleextract-filter1-vals_input > div > span"), + "Please select the filters." + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ci: Selecting AVISIT filter value doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ci() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("y_var-dataset_ADLB_singleextract-filter2-vals", "BASELINE") + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ci: Deselecting AVISIT filter value throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ci() + app_driver$set_active_module_input("y_var-dataset_ADLB_singleextract-filter2-vals", character(0)) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("y_var-dataset_ADLB_singleextract-filter2-vals_input > div > span"), + "Please select the filters." + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ci: Selecting color column changes plot output and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ci() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("color-dataset_ADSL_singleextract-select", "SEX") + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ci: Deselecting color column changes plot output and doesn't throw validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ci() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("color-dataset_ADSL_singleextract-select", character(0)) + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ci: Selecting confidence interval value changes plot and doesn't throw any errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ci() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("conf_level", 0.90) + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + + +testthat::test_that("e2e - tm_g_ci: Selecting statistic to use changes a plot and doesn't throw any errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ci() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("stat", "median") + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) 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..485e471e4b --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_g_forest_rsp.R @@ -0,0 +1,336 @@ +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", + parentname = "ADSL", + 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" + ), + aval_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADRS"]], "AVALC"), + "AVALC", + fixed = TRUE + ), + 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 = TRUE, + 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)") + ) + ), + plot_width = c(1500L, 800L, 3000L), + rel_width_forest = c(25L, 0L, 100L), + font_size = c(15L, 1L, 30L), + pre_output = NULL, + post_output = NULL, + ggplot2_args = teal.widgets::ggplot2_args() + ) + ) + ) +} + +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_plot_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_plot_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_plot_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_plot_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_plot_output("myplot") + app_driver$set_active_module_input("responders", "Complete Response (CR)") + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_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_plot_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_plot_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_plot_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_plot_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_plot_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_plot_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_plot_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_plot_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_plot_output("myplot") + app_driver$set_active_module_input("conf_level", "0.9") + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_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_plot_output("myplot") + app_driver$set_active_module_input("fixed_symbol_size", FALSE) + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_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_plot_output("myplot") + app_driver$set_active_module_input("rel_width_forest", 30) + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_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_plot_output("myplot") + app_driver$set_active_module_input("font_size", 25) + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_g_forest_tte.R b/tests/testthat/test-shinytest2-tm_g_forest_tte.R new file mode 100644 index 0000000000..ee8517a2c9 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_g_forest_tte.R @@ -0,0 +1,230 @@ +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", + parentname = "ADSL", + 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" + ), + aval_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADTTE"]], "AVAL"), + "AVAL", + fixed = TRUE + ), + cnsr_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADTTE"]], "CNSR"), + "CNSR", + fixed = TRUE + ), + conf_level = teal.transform::choices_selected( + c(0.95, 0.9, 0.8), 0.95, + keep_order = TRUE + ), + time_unit_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADTTE"]], "AVALU"), + "AVALU", + fixed = TRUE + ), + 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( + "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_plot_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_plot_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_plot_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_plot_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 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_plot_output("myplot") + app_driver$set_active_module_input(input_id, "0.99") + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_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() + } +) diff --git a/tests/testthat/test-shinytest2-tm_g_ipp.R b/tests/testthat/test-shinytest2-tm_g_ipp.R new file mode 100644 index 0000000000..66b00635ad --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_g_ipp.R @@ -0,0 +1,305 @@ +app_driver_tm_g_ipp <- function() { + data <- teal.data::teal_data() %>% + within({ + library(dplyr) + library(tern) + ADSL <- teal.data::rADSL %>% + slice(1:20) %>% + df_explicit_na() + ADLB <- teal.data::rADLB %>% + filter(USUBJID %in% ADSL$USUBJID) %>% + df_explicit_na() %>% + filter(AVISIT != "SCREENING") + }) + + datanames <- c("ADSL", "ADLB") + 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_g_ipp( + label = "Individual Patient Plot", + dataname = "ADLB", + parentname = "ADSL", + arm_var = teal.transform::choices_selected( + teal.transform::value_choices(data[["ADLB"]], "ARMCD"), + "ARM A" + ), + paramcd = teal.transform::choices_selected( + teal.transform::value_choices(data[["ADLB"]], "PARAMCD"), + "ALT" + ), + aval_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], c("AVAL", "CHG")), + "AVAL" + ), + avalu_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], c("AVALU")), + "AVALU", + fixed = TRUE + ), + id_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], c("USUBJID")), + "USUBJID", + fixed = TRUE + ), + visit_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], c("AVISIT", "ATOXGR")), + "AVISIT" + ), + baseline_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], c("BASE")), + "BASE", + fixed = TRUE + ), + add_baseline_hline = FALSE, + separate_by_obs = FALSE, + suppress_legend = FALSE, + add_avalu = TRUE, + plot_height = c(1200L, 400L, 5000L), + plot_width = NULL, + pre_output = NULL, + post_output = NULL, + ggplot2_args = teal.widgets::ggplot2_args() + ) + ) +} + +testthat::test_that("e2e - tm_g_ipp: Module initializes in teal without errors and produces plot output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ipp() + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() + testthat::expect_match( + app_driver$get_active_module_plot_output("myplot"), + "data:image/png;base64," + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_g_ipp: Starts with specified + label, parentname, arm_var, paramcd, id_var, visit_var, aval_var, avalu_var, baseline_var + add_baseline_hline, separate_by_obs, suppress_legend, add_avalu.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ipp() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Individual Patient Plot" + ) + 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("arm_var-dataset_ADSL_singleextract-filter1-vals"), + "ARM A" + ) + testthat::expect_equal( + app_driver$get_active_module_input("paramcd-dataset_ADLB_singleextract-filter1-col"), + "PARAMCD" + ) + testthat::expect_equal( + app_driver$get_active_module_input("paramcd-dataset_ADLB_singleextract-filter1-vals"), + "ALT" + ) + testthat::expect_equal( + app_driver$get_active_module_input("visit_var-dataset_ADLB_singleextract-select"), + "AVISIT" + ) + testthat::expect_equal( + app_driver$get_active_module_input("aval_var-dataset_ADLB_singleextract-select"), + "AVAL" + ) + testthat::expect_equal( + app_driver$get_active_module_input("id_var-dataset_ADLB_singleextract-select"), + "USUBJID" + ) + testthat::expect_equal( + app_driver$get_active_module_input("avalu_var-dataset_ADLB_singleextract-select"), + "AVALU" + ) + testthat::expect_equal( + app_driver$get_active_module_input("baseline_var-dataset_ADLB_singleextract-select"), + "BASE" + ) + testthat::expect_false(app_driver$get_active_module_input("add_baseline_hline")) + testthat::expect_false(app_driver$get_active_module_input("separate_by_obs")) + testthat::expect_false(app_driver$get_active_module_input("suppress_legend")) + testthat::expect_true(app_driver$get_active_module_input("add_avalu")) + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_g_ipp: Selecting arm_var changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ipp() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-filter1-vals", "ARM B") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ipp: Deselecting arm_var column throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ipp() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-filter1-vals_input > div > span"), + "Please select Arm filter." + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ipp: Selecting paramcd changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ipp() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("paramcd-dataset_ADLB_singleextract-filter1-vals", "CRP") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ipp: Deselecting paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ipp() + app_driver$set_active_module_input("paramcd-dataset_ADLB_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("paramcd-dataset_ADLB_singleextract-filter1-vals_input > div > span"), + "Please select Parameter filter." + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ipp: Selecting visit_var changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ipp() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("visit_var-dataset_ADLB_singleextract-select", "ATOXGR") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ipp: Deselecting visit_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ipp() + app_driver$set_active_module_input("visit_var-dataset_ADLB_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("visit_var-dataset_ADLB_singleextract-select_input > div > span"), + "A Timepoint Variable must be selected" + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ipp: Selecting aval_var changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ipp() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("aval_var-dataset_ADLB_singleextract-select", "CHG") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ipp: Deselecting aval_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ipp() + app_driver$set_active_module_input("aval_var-dataset_ADLB_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("aval_var-dataset_ADLB_singleextract-select_input > div > span"), + "A Parameter values over Time must be selected" + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ipp: Changing add_baseline_hline changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ipp() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("add_baseline_hline", TRUE) + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) +testthat::test_that("e2e - tm_g_ipp: Changing separate_by_obs changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ipp() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("separate_by_obs", TRUE) + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ipp: Changing suppress_legend changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ipp() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("suppress_legend", TRUE) + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_ipp: Changing add_avalu changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_ipp() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("add_avalu", FALSE) + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_g_km.R b/tests/testthat/test-shinytest2-tm_g_km.R new file mode 100644 index 0000000000..57685ae350 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_g_km.R @@ -0,0 +1,389 @@ +app_driver_tm_g_km <- function() { + data <- teal.data::teal_data() %>% + within({ + library(dplyr) + ADSL <- tmc_ex_adsl + ADTTE <- tmc_ex_adtte %>% + rename( + VALUE_UNIT = AVALU, + ANALYSIS_VAL = AVAL, + CENSORING = CNSR + ) + }) + + 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( + ACTARMCD = list( + ref = "ARM B", + comp = c("ARM A", "ARM C") + ), + ARM = list( + ref = "B: Placebo", + comp = c("A: Drug X", "C: Combination") + ) + ) + + init_teal_app_driver( + data = data, + modules = tm_g_km( + label = "Kaplan-Meier Plot", + dataname = "ADTTE", + parentname = "ADSL", + arm_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADSL"]], c("ARM", "ARMCD", "ACTARMCD")), + "ARM" + ), + paramcd = teal.transform::choices_selected( + teal.transform::value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), + "OS" + ), + arm_ref_comp = arm_ref_comp, + strata_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADSL"]], c("SEX", "BMRKR2")), + "SEX" + ), + facet_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADSL"]], c("SEX", "BMRKR2")), + NULL + ), + time_unit_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADTTE"]], "VALUE_UNIT"), + "VALUE_UNIT", + fixed = TRUE + ), + aval_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADTTE"]], "ANALYSIS_VAL"), + "ANALYSIS_VAL", + fixed = TRUE + ), + cnsr_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADTTE"]], "CENSORING"), + "CENSORING", + fixed = TRUE + ), + conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8, -1), 0.95, keep_order = TRUE), + font_size = c(11L, 1L, 30), + control_annot_surv_med = control_surv_med_annot(), + control_annot_coxph = control_coxph_annot(x = 0.27, y = 0.35, w = 0.3), + legend_pos = c(0.9, 0.5), + rel_height_plot = c(80L, 0L, 100L), + plot_height = c(800L, 400L, 5000L), + plot_width = NULL, + pre_output = NULL, + post_output = NULL + ) + ) +} + +testthat::test_that("e2e - tm_g_km: Module initializes in teal without errors and produces plot output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() + + testthat::expect_match( + app_driver$get_active_module_plot_output("myplot"), + "data:image/png;base64," + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_g_km: Starts with specified paramcd, aval_var, cnsr_var, facet_var, arm_var, compare_arms, strata_var.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Kaplan-Meier Plot" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("paramcd-dataset_ADTTE_singleextract-filter1-vals"), + "OS" + ) + + testthat::expect_equal( + app_driver$get_active_module_input(ns_des_input("aval_var", "ADTTE", "select")), + "ANALYSIS_VAL" + ) + + testthat::expect_equal( + app_driver$get_active_module_input(ns_des_input("cnsr_var", "ADTTE", "select")), + "CENSORING" + ) + + testthat::expect_null( + app_driver$get_active_module_input(ns_des_input("facet_var", "ADSL", "select")) + ) + + testthat::expect_equal( + app_driver$get_active_module_input(ns_des_input("arm_var", "ADSL", "select")), + "ARM" + ) + + testthat::expect_true(app_driver$get_active_module_input("compare_arms")) + + testthat::expect_equal( + app_driver$get_active_module_input(ns_des_input("strata_var", "ADSL", "select")), + "SEX" + ) + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_g_km: Changing {paramcd} changes the plot without errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("paramcd-dataset_ADTTE_singleextract-filter1-vals", "EFS") + app_driver$expect_no_validation_error() + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_km: Changing {facet_var} changes the plot without errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input(ns_des_input("facet_var", "ADSL", "select"), "SEX") + app_driver$expect_no_validation_error() + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_km: Changing {arm_var} changes the plot without errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input(ns_des_input("arm_var", "ADSL", "select"), "ACTARMCD") + app_driver$expect_no_validation_error() + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_km: Changing {compare_arms} changes the plot without errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("compare_arms", FALSE) + app_driver$expect_no_validation_error() + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_km: Changing {strata_var} changes the plot without errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input(ns_des_input("strata_var", "ADSL", "select"), "BMRKR2") + app_driver$expect_no_validation_error() + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_km: Deselecting {paramcd} throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + app_driver$set_active_module_input("paramcd-dataset_ADTTE_singleextract-filter1-vals", character(0)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + "paramcd-dataset_ADTTE_singleextract-filter1-vals_input .shiny-validation-message" + ), + "An endpoint is required" + ) + testthat::expect_match( + app_driver$active_module_element_text("myplot-plot-with-settings"), + "An endpoint is required" + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_km: Deselecting {arm_var} throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + app_driver$set_active_module_input(ns_des_input("arm_var", "ADSL", "select"), character(0)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + "arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message" + ), + "Treatment variable must be selected" + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_km: Deselecting {compare_arms} sets it to FALSE.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + app_driver$set_active_module_input("compare_arms", NULL) + app_driver$expect_no_validation_error() + testthat::expect_false(app_driver$get_active_module_input("compare_arms")) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_km: Deselecting {strata_var} does not throw errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + app_driver$set_active_module_input(ns_des_input("strata_var", "ADSL", "select"), character(0)) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +# groups ---------------------------------------------------------------------------------------------------------- + +testthat::test_that("e2e - tm_g_km: Starts with specified groups.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + + testthat::expect_equal( + app_driver$get_active_module_input("buckets"), + list( + Ref = list("B: Placebo"), + Comp = list("A: Drug X", "C: Combination") + ) + ) + + testthat::expect_false(app_driver$get_active_module_input("combine_comp_arms")) + + app_driver$stop() +}) + +# comparison settings --------------------------------------------------------------------------------------------- + +testthat::test_that("e2e - tm_g_km: Starts with specified collapsed comparison settings.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + + app_driver$is_visible(app_driver$active_module_element("pval_method_coxph")) + app_driver$is_visible(app_driver$active_module_element("ties_coxph")) + + testthat::expect_equal(app_driver$get_active_module_input("pval_method_coxph"), "log-rank") + testthat::expect_equal( + app_driver$active_module_element_text("pval_method_coxph-label"), + "p-value method for Coxph (Hazard Ratio)" + ) + testthat::expect_equal(app_driver$get_active_module_input("ties_coxph"), "exact") + testthat::expect_equal( + app_driver$active_module_element_text("ties_coxph-label"), + "Ties for Coxph (Hazard Ratio)" + ) + + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_km: Changing {pval_method_coxph} changes the plot without errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("pval_method_coxph", "wald") + app_driver$expect_no_validation_error() + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_km: Changing {ties_coxph} changes the plot without errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("ties_coxph", "breslow") + app_driver$expect_no_validation_error() + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_km: Deselecting {pval_method_coxph} gives no validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + app_driver$set_active_module_input("pval_method_coxph", character(0)) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_km: Deselecting {ties_coxph} gives no validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + app_driver$set_active_module_input("ties_coxph", character(0)) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +# plot settings --------------------------------------------------------------------------------------------------- + +testthat::test_that("e2e - tm_g_km: Starts with specified collapsed additional plot settings.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + + testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("xticks"))) + testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("yval"))) + testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("font_size"))) + testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("rel_height_plot"))) + testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("show_ci_ribbon"))) + testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("show_km_table"))) + testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("conf_level"))) + testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("xlab"))) + + testthat::expect_equal(app_driver$get_active_module_input("xticks"), "") + testthat::expect_equal(app_driver$get_active_module_input("yval"), "Survival probability") + testthat::expect_equal(app_driver$get_active_module_input("font_size"), 11) + testthat::expect_equal(app_driver$get_active_module_input("rel_height_plot"), 80) + testthat::expect_false(app_driver$get_active_module_input("show_ci_ribbon")) + testthat::expect_true(app_driver$get_active_module_input("show_km_table")) + testthat::expect_equal(app_driver$get_active_module_input("conf_level"), "0.95") + testthat::expect_equal(app_driver$get_active_module_input("xlab"), "Time") + + testthat::expect_equal( + app_driver$active_module_element_text("xticks-label"), + "Specify break intervals for x-axis e.g. 0 ; 500" + ) + testthat::expect_match(app_driver$active_module_element_text("yval-label"), "Value on y-axis", fixed = FALSE) + testthat::expect_equal(app_driver$active_module_element_text("font_size-label"), "Table Font Size") + testthat::expect_equal(app_driver$active_module_element_text("rel_height_plot-label"), "Relative Height of Plot (%)") + testthat::expect_equal(app_driver$active_module_element_text("xlab-label"), "X-axis label") + + app_driver$stop() +}) + +test_that_plot_settings <- function(input_id, new_value) { + testthat::test_that( + sprintf( + "e2e - tm_g_km: Changing '%s' changes the plot and does not throw validation errors.", + input_id + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input(input_id, new_value) + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("myplot"))) + app_driver$expect_no_validation_error() + app_driver$stop() + } + ) +} + +test_that_plot_settings("xticks", 50) +test_that_plot_settings("yval", "Failure probability") +test_that_plot_settings("font_size", 12) +test_that_plot_settings("rel_height_plot", 70) +test_that_plot_settings("show_ci_ribbon", TRUE) +test_that_plot_settings("show_km_table", FALSE) +test_that_plot_settings("conf_level", 0.8) +test_that_plot_settings("xlab", "Time2") + +testthat::test_that("e2e - tm_g_km: Deselecting {conf_level} throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_km() + app_driver$set_active_module_input("conf_level", -1) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text("myplot-plot-with-settings"), + "Confidence level must be between 0 and 1." + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_g_lineplot.R b/tests/testthat/test-shinytest2-tm_g_lineplot.R new file mode 100644 index 0000000000..cb7ac91b33 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_g_lineplot.R @@ -0,0 +1,231 @@ +app_driver_tm_g_lineplot <- function() { + data <- within(teal.data::teal_data(), { + require(nestcolor) + ADSL <- teal.modules.clinical::tmc_ex_adsl + + ADLB <- dplyr::mutate( + teal.modules.clinical::tmc_ex_adlb, + AVISIT == forcats::fct_reorder(AVISIT, AVISITN, min) + ) + }) + + datanames <- c("ADSL", "ADLB") + 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_g_lineplot( + label = "Line Plot", + dataname = "ADLB", + parentname = "ADSL", + strata = teal.transform::choices_selected( + teal.transform::variable_choices("ADSL", c("ARM", "ARMCD", "ACTARMCD")), + "ARM" + ), + x = teal.transform::choices_selected(teal.transform::variable_choices( + "ADLB", + "AVISIT" + ), "AVISIT", fixed = TRUE), + y = teal.transform::choices_selected( + teal.transform::variable_choices("ADLB", c("AVAL", "BASE", "CHG", "PCHG")), + "AVAL" + ), + y_unit = teal.transform::choices_selected(teal.transform::variable_choices( + "ADLB", + "AVALU" + ), "AVALU", fixed = TRUE), + paramcd = teal.transform::choices_selected(teal.transform::variable_choices( + "ADLB", + "PARAMCD" + ), "PARAMCD", fixed = TRUE), + param = teal.transform::choices_selected( + teal.transform::value_choices("ADLB", "PARAMCD", "PARAM"), + "ALT" + ), + conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, + keep_order = + TRUE + ), + interval = "mean_ci", + mid = "mean", + whiskers = c("mean_ci_lwr", "mean_ci_upr"), + table = c("n", "mean_sd", "median", "range"), + mid_type = "pl", + mid_point_size = c(2, 1, 5), + table_font_size = c(4, 2, 6), + plot_height = c(1000L, 200L, 4000L), + plot_width = NULL, + pre_output = NULL, + post_output = NULL, + ggplot2_args = teal.widgets::ggplot2_args() + ), + timeout = 30000 + ) +} + +testthat::test_that("e2e - tm_g_lineplot: Module initializes in teal without errors.", { + skip_if_too_deep(5) + + app_driver <- app_driver_tm_g_lineplot() + 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_lineplot: Starts with specified label, param, strata, y, x, mid, interval, incl_screen, + plot_settings and table_settings.", + { + skip_if_too_deep(5) + + app_driver <- app_driver_tm_g_lineplot() + + testthat::expect_equal(trimws(app_driver$get_text("#teal-main_ui-root-active_tab > li.active")), "Line Plot") + testthat::expect_equal(app_driver$get_active_module_input("param-dataset_ADLB_singleextract-filter1-vals"), "ALT") + testthat::expect_equal(app_driver$get_active_module_input("strata-dataset_ADSL_singleextract-select"), "ARM") + testthat::expect_equal(app_driver$get_active_module_input("y-dataset_ADLB_singleextract-select"), "AVAL") + testthat::expect_equal(app_driver$get_active_module_input("x-dataset_ADLB_singleextract-select"), "AVISIT") + testthat::expect_equal(app_driver$get_active_module_input("mid"), "mean") + testthat::expect_equal(app_driver$get_active_module_input("interval"), "mean_ci") + testthat::expect_true(app_driver$get_active_module_input("incl_screen")) + + # addtional plot settings + testthat::expect_equal(app_driver$get_active_module_input("conf_level"), "0.95") + testthat::expect_equal(app_driver$get_active_module_input("mid_point_size"), 2) + testthat::expect_equal(app_driver$get_active_module_input("whiskers"), c("Upper", "Lower")) + testthat::expect_equal(app_driver$get_active_module_input("mid_type"), "pl") + testthat::expect_equal(app_driver$get_active_module_input("y_unit-dataset_ADLB_singleextract-select"), "AVALU") + testthat::expect_equal(app_driver$get_active_module_input("paramcd-dataset_ADLB_singleextract-select"), "PARAMCD") + + # addtional table settings + testthat::expect_equal(app_driver$get_active_module_input("table_font_size"), 4) + testthat::expect_equal(app_driver$get_active_module_input("table"), c("n", "mean_sd", "median", "range")) + + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_g_lineplot: Selecting param changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_lineplot() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("param-dataset_ADLB_singleextract-filter1-vals", "CRP") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_lineplot: Deselecting param throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_lineplot() + app_driver$set_active_module_input("param-dataset_ADLB_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("param-dataset_ADLB_singleextract-filter1-vals_input > div > span"), + "Please select Biomarker filter." + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_g_lineplot: Selecting strata changes plot and doesn't throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_lineplot() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("strata-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_g_lineplot: Deselecting strata throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_lineplot() + app_driver$set_active_module_input("strata-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text( + "strata-dataset_ADSL_singleextract-select_input > div > span" + ), + "Please select a treatment variable" + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_lineplot: Selecting y changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_lineplot() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("y-dataset_ADLB_singleextract-select", "BASE") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_lineplot: Deselecting y throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_lineplot() + app_driver$set_active_module_input("y-dataset_ADLB_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text( + "y-dataset_ADLB_singleextract-select_input > div > span" + ), + "Please select an analysis variable" + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_lineplot: Selecting conf_level changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_lineplot() + plot_before <- app_driver$get_active_module_plot_output("myplot") + app_driver$set_active_module_input("conf_level", "0.8") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("myplot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_lineplot: Deselecting conf_level validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_lineplot() + app_driver$set_active_module_input("conf_level", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("conf_level_input > div > span"), + "Please choose a confidence level" + ) + app_driver$expect_validation_error() + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_g_pp_adverse_events.R b/tests/testthat/test-shinytest2-tm_g_pp_adverse_events.R new file mode 100644 index 0000000000..a2c9309d09 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_g_pp_adverse_events.R @@ -0,0 +1,416 @@ +app_driver_tm_g_pp_adverse_events <- function() { # nolint: object_length + data <- teal.data::teal_data() |> within({ + library(nestcolor) + library(dplyr) + + ADAE <- teal.data::rADAE + ADSL <- teal.data::rADSL %>% filter(USUBJID %in% ADAE$USUBJID) + }) + + teal.data::datanames(data) <- c("ADAE", "ADSL") + teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[c("ADAE", "ADSL")] + + + init_teal_app_driver( + data = data, + modules = tm_g_pp_adverse_events( + label = "Adverse Events", + dataname = "ADAE", + parentname = "ADSL", + patient_col = "USUBJID", + plot_height = c(600L, 200L, 2000L), + aeterm = choices_selected( + choices = variable_choices(data[["ADAE"]], c("AETERM", "AGEU")), + selected = "AETERM" + ), + tox_grade = choices_selected( + choices = variable_choices(data[["ADAE"]], c("AETOXGR", "COUNTRY")), + selected = "AETOXGR" + ), + causality = choices_selected( + choices = variable_choices(data[["ADAE"]], c("AEREL", "ACTARM")), + selected = "AEREL" + ), + outcome = choices_selected( + choices = variable_choices(data[["ADAE"]], c("AEOUT", "SITEID")), + selected = "AEOUT" + ), + action = choices_selected( + choices = variable_choices(data[["ADAE"]], c("AEACN", "SMQ01NAM")), + selected = "AEACN" + ), + time = choices_selected( + choices = variable_choices(data[["ADAE"]], c("ASTDY", "AGE")), + selected = "ASTDY" + ), + decod = NULL, + font_size = c(12L, 12L, 25L), + plot_width = NULL, + pre_output = NULL, + post_output = NULL, + ggplot2_args = teal.widgets::ggplot2_args() + ) + ) +} + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Module initializes in teal without any errors and produces the plot and table.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() + testthat::expect_match(app_driver$get_active_module_plot_output("chart"), "data:image/png;base64,") + testthat::expect_true( + app_driver$is_visible(app_driver$active_module_element("table")) + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Module initializes with specific label, patient_id, aeterm, + tox_grade, causality, outcome, action, time, decod.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Adverse Events" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("patient_id"), + "AB12345-CHN-3-id-128" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("aeterm-dataset_ADAE_singleextract-select"), + "AETERM" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("tox_grade-dataset_ADAE_singleextract-select"), + "AETOXGR" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("causality-dataset_ADAE_singleextract-select"), + "AEREL" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("outcome-dataset_ADAE_singleextract-select"), + "AEOUT" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("action-dataset_ADAE_singleextract-select"), + "AEACN" + ) + + testthat::expect_equal( + app_driver$get_active_module_input("time-dataset_ADAE_singleextract-select"), + "ASTDY" + ) + + testthat::expect_null( + app_driver$get_active_module_input("decod-dataset_ADAE_singleextract-select") + ) + + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Selecting patient_id doesn't throw errors and changes the plot and table.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + plot_before <- app_driver$get_active_module_plot_output("chart") + table_before <- app_driver$get_active_module_table_output("table") + app_driver$set_active_module_input("patient_id", "AB12345-CHN-15-id-262") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("chart") + ) + ) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table") + ) + ) + app_driver$expect_no_shiny_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Deselecting patient_id throw validation error", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + input_id <- "patient_id" + app_driver$set_active_module_input(input_id, "") + app_driver$expect_validation_error() + testthat::expect_identical( + app_driver$active_module_element_text(sprintf("%s_input .shiny-validation-message", input_id)), + "Please select a patient" + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Selecting aeterm column doesn't throw errors and changes the plot and table.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + plot_before <- app_driver$get_active_module_plot_output("chart") + table_before <- app_driver$get_active_module_table_output("table") + app_driver$set_active_module_input("aeterm-dataset_ADAE_singleextract-select", "AGEU") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("chart") + ) + ) + + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table") + ) + ) + app_driver$expect_no_shiny_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Deselecting aeterm column throw validation error", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + input_id <- "aeterm-dataset_ADAE_singleextract-select" + app_driver$set_active_module_input(input_id, "") + app_driver$expect_validation_error() + testthat::expect_identical( + app_driver$active_module_element_text(sprintf("%s_input .shiny-validation-message", input_id)), + "Please select AETERM variable." + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Selecting tox_grade column doesn't throw errors and changes the plot and table.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + plot_before <- app_driver$get_active_module_plot_output("chart") + table_before <- app_driver$get_active_module_table_output("table") + app_driver$set_active_module_input("tox_grade-dataset_ADAE_singleextract-select", "COUNTRY") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("chart") + ) + ) + + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table") + ) + ) + app_driver$expect_no_shiny_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Deselecting tox_grade column throw validation error", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + input_id <- "tox_grade-dataset_ADAE_singleextract-select" + app_driver$set_active_module_input(input_id, "") + app_driver$expect_validation_error() + testthat::expect_identical( + app_driver$active_module_element_text(sprintf("%s_input .shiny-validation-message", input_id)), + "Please select AETOXGR variable." + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Selecting causality column doesn't throw errors and changes the plot and table.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + plot_before <- app_driver$get_active_module_plot_output("chart") + table_before <- app_driver$get_active_module_table_output("table") + app_driver$set_active_module_input("causality-dataset_ADAE_singleextract-select", "ACTARM") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("chart") + ) + ) + + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table") + ) + ) + app_driver$expect_no_shiny_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Deselecting causality column throw validation error", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + input_id <- "causality-dataset_ADAE_singleextract-select" + app_driver$set_active_module_input(input_id, "") + app_driver$expect_validation_error() + testthat::expect_identical( + app_driver$active_module_element_text(sprintf("%s_input .shiny-validation-message", input_id)), + "Please select AEREL variable." + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Selecting outcome column doesn't throw errors and changes the plot and table.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + plot_before <- app_driver$get_active_module_plot_output("chart") + table_before <- app_driver$get_active_module_table_output("table") + app_driver$set_active_module_input("outcome-dataset_ADAE_singleextract-select", "SITEID") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("chart") + ) + ) + + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table") + ) + ) + app_driver$expect_no_shiny_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Deselecting outcome column throw validation error", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + input_id <- "outcome-dataset_ADAE_singleextract-select" + app_driver$set_active_module_input(input_id, "") + app_driver$expect_validation_error() + testthat::expect_identical( + app_driver$active_module_element_text(sprintf("%s_input .shiny-validation-message", input_id)), + "Please select AEOUT variable." + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Selecting action column doesn't throw errors and changes the plot and table.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + plot_before <- app_driver$get_active_module_plot_output("chart") + table_before <- app_driver$get_active_module_table_output("table") + app_driver$set_active_module_input("action-dataset_ADAE_singleextract-select", "SMQ01NAM") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("chart") + ) + ) + + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table") + ) + ) + app_driver$expect_no_shiny_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Deselecting action column throw validation error", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + input_id <- "action-dataset_ADAE_singleextract-select" + app_driver$set_active_module_input(input_id, "") + app_driver$expect_validation_error() + testthat::expect_identical( + app_driver$active_module_element_text(sprintf("%s_input .shiny-validation-message", input_id)), + "Please select AEACN variable." + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Selecting time column doesn't throw errors and changes the plot and table.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + plot_before <- app_driver$get_active_module_plot_output("chart") + table_before <- app_driver$get_active_module_table_output("table") + app_driver$set_active_module_input("time-dataset_ADAE_singleextract-select", "AGE") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("chart") + ) + ) + + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table") + ) + ) + app_driver$expect_no_shiny_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e tm_g_pp_adverse_events - Deselecting time column throw validation error", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_adverse_events() + input_id <- "time-dataset_ADAE_singleextract-select" + app_driver$set_active_module_input(input_id, "") + app_driver$expect_validation_error() + testthat::expect_identical( + app_driver$active_module_element_text(sprintf("%s_input .shiny-validation-message", input_id)), + "Please select ASTDY variable." + ) + app_driver$stop() + } +) diff --git a/tests/testthat/test-shinytest2-tm_g_pp_patient_timeline.R b/tests/testthat/test-shinytest2-tm_g_pp_patient_timeline.R new file mode 100644 index 0000000000..a46061bfb6 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_g_pp_patient_timeline.R @@ -0,0 +1,603 @@ +app_driver_tm_g_pp_patient_timeline <- function() { # nolint object_length + data <- teal.data::teal_data() + data <- within(data, { + library(dplyr) + ADAE <- tmc_ex_adae + ADSL <- tmc_ex_adsl %>% filter(USUBJID %in% ADAE$USUBJID) + ADCM <- tmc_ex_adcm %>% mutate( + CMSTDY = case_when( + CMCAT == "medcl B" ~ 20, + CMCAT == "medcl C" ~ 150, + TRUE ~ 1 + ) %>% with_label("Study Day of Start of Medication"), + CMENDY = case_when( + CMCAT == "medcl B" ~ 700, + CMCAT == "medcl C" ~ 1000, + TRUE ~ 500 + ) %>% with_label("Study Day of End of Medication"), + CMASTDTM = ASTDTM, + CMAENDTM = AENDTM + ) + }) + + adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4") + teal.data::datanames(data) <- c("ADSL", "ADAE", "ADCM") + teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[c("ADSL", "ADAE", "ADCM")] + teal.data::join_keys(data)["ADCM", "ADCM"] <- adcm_keys + teal.data::join_keys(data)["ADAE", "ADCM"] <- c("STUDYID", "USUBJID") + + + init_teal_app_driver( + data = data, + modules = tm_g_pp_patient_timeline( + label = "Patient Timeline", + dataname_adae = "ADAE", + dataname_adcm = "ADCM", + parentname = "ADSL", + patient_col = "USUBJID", + plot_height = c(600L, 200L, 2000L), + cmdecod = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADCM"]], c("CMDECOD", "CMCAT")), + selected = "CMDECOD" + ), + aeterm = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAE"]], c("AETERM", "AESOC")), + selected = "AETERM" + ), + aetime_start = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAE"]], c("ASTDTM", "TRTSDTM")), + selected = "ASTDTM" + ), + aetime_end = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAE"]], c("AENDTM", "EOSDT")), + selected = "AENDTM" + ), + dstime_start = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADCM"]], c("CMASTDTM", "TRTEDTM")), + selected = "CMASTDTM" + ), + dstime_end = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADCM"]], c("CMAENDTM", "TRTEDTM")), + selected = "CMAENDTM" + ), + aerelday_start = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAE"]], c("ASTDY", "AENDY")), + selected = "ASTDY" + ), + aerelday_end = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAE"]], c("AENDY", "ASTDY")), + selected = "AENDY" + ), + dsrelday_start = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADCM"]], c("ASTDY", "AENDY")), + selected = "ASTDY" + ), + dsrelday_end = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADCM"]], c("AENDY", "ASTDY")), + selected = "AENDY" + ), + font_size = c(12L, 12L, 25L), + plot_width = NULL, + pre_output = NULL, + post_output = NULL, + ggplot2_args = teal.widgets::ggplot2_args() + ) + ) +} + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Module initializes in teal without errors and produces plot output.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() + + testthat::expect_match( + app_driver$get_active_module_plot_output("patient_timeline_plot"), + "data:image/png;base64," + ) + + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Starts with specified label, patient_id, cmdecod, aeterm, aetime_start, + aetime_end, dstime_start, dstime_end, aerelday_start, aerelday_end, dsrelday_start, dsrelday_en.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Patient Timeline" + ) + testthat::expect_equal( + app_driver$get_active_module_input("patient_id"), + "AB12345-CHN-11-id-2" + ) + testthat::expect_equal( + app_driver$get_active_module_input("cmdecod-dataset_ADCM_singleextract-select"), + "CMDECOD" + ) + testthat::expect_equal( + app_driver$get_active_module_input("aeterm-dataset_ADAE_singleextract-select"), + "AETERM" + ) + testthat::expect_equal( + app_driver$get_active_module_input("aetime_start-dataset_ADAE_singleextract-select"), + "ASTDTM" + ) + testthat::expect_equal( + app_driver$get_active_module_input("aetime_end-dataset_ADAE_singleextract-select"), + "AENDTM" + ) + testthat::expect_equal( + app_driver$get_active_module_input("dstime_start-dataset_ADCM_singleextract-select"), + "CMASTDTM" + ) + testthat::expect_equal( + app_driver$get_active_module_input("dstime_end-dataset_ADCM_singleextract-select"), + "CMAENDTM" + ) + testthat::expect_equal( + app_driver$get_active_module_input("aerelday_start-dataset_ADAE_singleextract-select"), + "ASTDY" + ) + testthat::expect_equal( + app_driver$get_active_module_input("aerelday_end-dataset_ADAE_singleextract-select"), + "AENDY" + ) + testthat::expect_equal( + app_driver$get_active_module_input("dsrelday_start-dataset_ADCM_singleextract-select"), + "ASTDY" + ) + testthat::expect_equal( + app_driver$get_active_module_input("dsrelday_end-dataset_ADCM_singleextract-select"), + "AENDY" + ) + testthat::expect_true(app_driver$get_active_module_input("relday_x_axis")) + testthat::expect_equal( + app_driver$get_active_module_input("font_size"), + 12 + ) + + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Encodings aerelday_start, aerelday_end, dsrelday_start, dsrelday_end + are shown only when relday_x_axis is checked.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + + testthat::expect_true( + all( + app_driver$is_visible(app_driver$active_module_element("aerelday_start-dataset_ADAE_singleextract-select")), + app_driver$is_visible(app_driver$active_module_element("aerelday_end-dataset_ADAE_singleextract-select")), + app_driver$is_visible(app_driver$active_module_element("dsrelday_start-dataset_ADCM_singleextract-select")), + app_driver$is_visible(app_driver$active_module_element("dsrelday_end-dataset_ADCM_singleextract-select")) + ) + ) + + app_driver$set_active_module_input("relday_x_axis", FALSE) + + testthat::expect_false( + any( + app_driver$is_visible(app_driver$active_module_element("aerelday_start-dataset_ADAE_singleextract-select")), + app_driver$is_visible(app_driver$active_module_element("aerelday_end-dataset_ADAE_singleextract-select")), + app_driver$is_visible(app_driver$active_module_element("dsrelday_start-dataset_ADCM_singleextract-select")), + app_driver$is_visible(app_driver$active_module_element("dsrelday_end-dataset_ADCM_singleextract-select")) + ) + ) + + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Encodings aetime_start, aetime_end, dstime_start, dstime_end + are shown only when relday_x_axis is unchecked.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + + testthat::expect_false( + any( + app_driver$is_visible(app_driver$active_module_element("aetime_start-dataset_ADAE_singleextract-select")), + app_driver$is_visible(app_driver$active_module_element("aetime_end-dataset_ADAE_singleextract-select")), + app_driver$is_visible(app_driver$active_module_element("dstime_start-dataset_ADCM_singleextract-select")), + app_driver$is_visible(app_driver$active_module_element("dstime_end-dataset_ADCM_singleextract-select")) + ) + ) + + app_driver$set_active_module_input("relday_x_axis", FALSE) + + testthat::expect_true( + all( + app_driver$is_visible(app_driver$active_module_element("aetime_start-dataset_ADAE_singleextract-select")), + app_driver$is_visible(app_driver$active_module_element("aetime_end-dataset_ADAE_singleextract-select")), + app_driver$is_visible(app_driver$active_module_element("dstime_start-dataset_ADCM_singleextract-select")), + app_driver$is_visible(app_driver$active_module_element("dstime_end-dataset_ADCM_singleextract-select")) + ) + ) + + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Selecting patient_id changes plot and doesn't throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + plot_before <- app_driver$get_active_module_plot_output("patient_timeline_plot") + app_driver$set_active_module_input("patient_id", "AB12345-USA-2-id-3") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("patient_timeline_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_g_pp_patient_timeline: Deselecting patient_id column throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + app_driver$set_active_module_input("patient_id", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("patient_timeline_plot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("patient_id_input > div > span"), + "Please select a patient" + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Selecting cmdecod changes plot and doesn't throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + plot_before <- app_driver$get_active_module_plot_output("patient_timeline_plot") + app_driver$set_active_module_input("cmdecod-dataset_ADCM_singleextract-select", "CMCAT") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("patient_timeline_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Deselecting cmdecod changes plot and doesn't throw validation error.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + plot_before <- app_driver$get_active_module_plot_output("patient_timeline_plot") + app_driver$set_active_module_input("cmdecod-dataset_ADCM_singleextract-select", NULL) + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("patient_timeline_plot"))) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Selecting aeterm changes plot and doesn't throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + plot_before <- app_driver$get_active_module_plot_output("patient_timeline_plot") + app_driver$set_active_module_input("aeterm-dataset_ADAE_singleextract-select", "AESOC") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("patient_timeline_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Deselecting aeterm changes plot and doesn't throw validation error.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + plot_before <- app_driver$get_active_module_plot_output("patient_timeline_plot") + app_driver$set_active_module_input("aeterm-dataset_ADAE_singleextract-select", NULL) + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("patient_timeline_plot"))) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Selecting aetime_start changes plot and doesn't throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + app_driver$set_active_module_input("relday_x_axis", FALSE) + plot_before <- app_driver$get_active_module_plot_output("patient_timeline_plot") + app_driver$set_active_module_input("aetime_start-dataset_ADAE_singleextract-select", "TRTSDTM") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("patient_timeline_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Deselecting aetime_start throws validation error.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + app_driver$set_active_module_input("relday_x_axis", FALSE) + app_driver$set_active_module_input("aetime_start-dataset_ADAE_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("aetime_start-dataset_ADAE_singleextract-select_input > div > span"), + "Please add AE start date." + ) + app_driver$expect_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Selecting aetime_end changes plot and doesn't throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + app_driver$set_active_module_input("relday_x_axis", FALSE) + plot_before <- app_driver$get_active_module_plot_output("patient_timeline_plot") + app_driver$set_active_module_input("aetime_end-dataset_ADAE_singleextract-select", "EOSDT") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("patient_timeline_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Deselecting aetime_end throws validation error.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + app_driver$set_active_module_input("relday_x_axis", FALSE) + app_driver$set_active_module_input("aetime_end-dataset_ADAE_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("aetime_end-dataset_ADAE_singleextract-select_input > div > span"), + "Please add AE end date." + ) + app_driver$expect_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Selecting aerelday_start changes plot and doesn't throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + plot_before <- app_driver$get_active_module_plot_output("patient_timeline_plot") + app_driver$set_active_module_input("aerelday_start-dataset_ADAE_singleextract-select", "AENDY") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("patient_timeline_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Deselecting aerelday_start throws validation error.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + app_driver$set_active_module_input("aerelday_start-dataset_ADAE_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("aerelday_start-dataset_ADAE_singleextract-select_input > div > span"), + "Please add AE start date." + ) + app_driver$expect_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Selecting aerelday_end changes plot and doesn't throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + plot_before <- app_driver$get_active_module_plot_output("patient_timeline_plot") + app_driver$set_active_module_input("aerelday_end-dataset_ADAE_singleextract-select", "ASTDY") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("patient_timeline_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Deselecting aerelday_end throws validation error.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + app_driver$set_active_module_input("aerelday_end-dataset_ADAE_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("aerelday_end-dataset_ADAE_singleextract-select_input > div > span"), + "Please add AE end date." + ) + app_driver$expect_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Selecting dstime_start changes plot and doesn't throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + app_driver$set_active_module_input("relday_x_axis", FALSE) + plot_before <- app_driver$get_active_module_plot_output("patient_timeline_plot") + app_driver$set_active_module_input("dstime_start-dataset_ADCM_singleextract-select", "TRTEDTM") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("patient_timeline_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Deselecting dstime_start throws validation error.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + app_driver$set_active_module_input("relday_x_axis", FALSE) + app_driver$set_active_module_input("dstime_start-dataset_ADCM_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("dstime_start-dataset_ADCM_singleextract-select_input > div > span"), + "Please add Medication start date." + ) + app_driver$expect_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Selecting dstime_end changes plot and doesn't throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + app_driver$set_active_module_input("relday_x_axis", FALSE) + plot_before <- app_driver$get_active_module_plot_output("patient_timeline_plot") + app_driver$set_active_module_input("dstime_end-dataset_ADCM_singleextract-select", "TRTEDTM") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("patient_timeline_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Deselecting dstime_end throws validation error.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + app_driver$set_active_module_input("relday_x_axis", FALSE) + app_driver$set_active_module_input("dstime_end-dataset_ADCM_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("dstime_end-dataset_ADCM_singleextract-select_input > div > span"), + "Please add Medication end date." + ) + app_driver$expect_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Selecting dsrelday_start changes plot and doesn't throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + plot_before <- app_driver$get_active_module_plot_output("patient_timeline_plot") + app_driver$set_active_module_input("dsrelday_start-dataset_ADCM_singleextract-select", "AENDY") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("patient_timeline_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Deselecting dsrelday_start throws validation error.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + app_driver$set_active_module_input("dsrelday_start-dataset_ADCM_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("dsrelday_start-dataset_ADCM_singleextract-select_input > div > span"), + "Please add Medication start date." + ) + app_driver$expect_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Selecting dsrelday_end changes plot and doesn't throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + plot_before <- app_driver$get_active_module_plot_output("patient_timeline_plot") + app_driver$set_active_module_input("dsrelday_end-dataset_ADCM_singleextract-select", "ASTDY") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("patient_timeline_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_g_pp_patient_timeline: Deselecting dsrelday_end throws validation error.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_patient_timeline() + app_driver$set_active_module_input("dsrelday_end-dataset_ADCM_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("myplot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("dsrelday_end-dataset_ADCM_singleextract-select_input > div > span"), + "Please add Medication end date." + ) + app_driver$expect_validation_error() + app_driver$stop() + } +) diff --git a/tests/testthat/test-shinytest2-tm_g_pp_therapy.R b/tests/testthat/test-shinytest2-tm_g_pp_therapy.R new file mode 100644 index 0000000000..dcd0f6fba4 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_g_pp_therapy.R @@ -0,0 +1,235 @@ +app_driver_tm_g_pp_therapy <- function() { # nolint: object_length. + data <- within(teal.data::teal_data(), { + ADCM <- teal.modules.clinical::tmc_ex_adcm + ADSL <- dplyr::filter( + teal.modules.clinical::tmc_ex_adsl, + USUBJID %in% ADCM$USUBJID + ) + ADCM$CMASTDTM <- ADCM$ASTDTM + ADCM$CMAENDTM <- ADCM$AENDTM + + # Manual duplicate choices to test changes in the encodings + set.seed(123) + ADCM$ATIREL2 <- gsub("PRIOR", "PRIOR_CONCOMITANT", ADCM$ATIREL) + ADCM$CMDECOD2 <- sample(ADCM$CMDECOD, size = length(ADCM$CMDECOD)) + ADCM$CMINDC2 <- sample(ADCM$CMINDC, size = length(ADCM$CMINDC)) + ADCM$CMDOSE2 <- sample(ADCM$CMDOSE, size = length(ADCM$CMDOSE)) + ADCM$CMDOSU2 <- sample(ADCM$CMDOSU, size = length(ADCM$CMDOSU)) + ADCM$CMROUTE2 <- sample(ADCM$CMROUTE, size = length(ADCM$CMROUTE)) + ADCM$CMDOSFRQ2 <- sample(ADCM$CMDOSFRQ, size = length(ADCM$CMDOSFRQ)) + ADCM$ASTDY2 <- sample(ADCM$ASTDY, size = length(ADCM$ASTDY)) + ADCM$AENDY2 <- sample(ADCM$AENDY, size = length(ADCM$AENDY)) + ADCM$CMTRT2 <- sample(ADCM$CMTRT, size = length(ADCM$CMTRT)) + }) + + adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4") + datanames <- c("ADSL", "ADCM") + + teal.data::datanames(data) <- datanames + teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[datanames] + teal.data::join_keys(data)["ADCM", "ADCM"] <- adcm_keys + + init_teal_app_driver( + data = data, + modules = tm_g_pp_therapy( + label = "Therapy (e2e)", + dataname = "ADCM", + parentname = "ADSL", + patient_col = "USUBJID", + atirel = choices_selected( + choices = variable_choices("ADCM", c("ATIREL", "ATIREL2")), + selected = "ATIREL2" + ), + cmdecod = choices_selected( + choices = variable_choices("ADCM", c("CMDECOD", "CMDECOD2")), + selected = "CMDECOD2" + ), + cmindc = choices_selected( + choices = variable_choices("ADCM", c("CMINDC", "CMINDC2")), + selected = "CMINDC2" + ), + cmdose = choices_selected( + choices = variable_choices("ADCM", c("CMDOSE", "CMDOSE2")), + selected = "CMDOSE2" + ), + cmtrt = choices_selected( + choices = variable_choices("ADCM", c("CMTRT", "CMTRT2")), + selected = "CMTRT" + ), + cmdosu = choices_selected( + choices = variable_choices("ADCM", c("CMDOSU", "CMDOSU2")), + selected = "CMDOSU2" + ), + cmroute = choices_selected( + choices = variable_choices("ADCM", c("CMROUTE", "CMROUTE2")), + selected = "CMROUTE2" + ), + cmdosfrq = choices_selected( + choices = variable_choices("ADCM", c("CMDOSFRQ", "CMDOSFRQ2")), + selected = "CMDOSFRQ2" + ), + cmstdy = choices_selected( + choices = variable_choices("ADCM", c("ASTDY", "ASTDY2")), + selected = "ASTDY2" + ), + cmendy = choices_selected( + choices = variable_choices("ADCM", c("AENDY", "AENDY2")), + selected = "AENDY2" + ), + font_size = c(12L, 1L, 30L), + plot_height = c(500L, 300L, 2000L), + plot_width = c(1000L, 700L, 2000L), + pre_output = NULL, + post_output = NULL, + ggplot2_args = teal.widgets::ggplot2_args() + ) + ) +} + +# Initialization -------------------------------------------------------------- + +testthat::test_that("e2e - tm_g_pp_therapy: Module initializes in teal without errors and produces output.", { + skip_if_too_deep(5) + + app_driver <- app_driver_tm_g_pp_therapy() + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() + + testthat::expect_true( + app_driver$is_visible(app_driver$active_module_element("therapy_plot-plot_out_main")) + ) + testthat::expect_true( + app_driver$is_visible(app_driver$active_module_element("therapy_table")) + ) + + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_g_pp_therapy: 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_pp_therapy() + + testthat::expect_equal( + trimws(app_driver$get_text("#teal-main_ui-root-active_tab > li.active")), + "Therapy (e2e)" + ) + + testthat::expect_equal(app_driver$get_active_module_input("patient_id"), "AB12345-CHN-11-id-2") + + select_inputs <- c( + "atirel" = "ATIREL2", "cmdecod" = "CMDECOD2", "cmindc" = "CMINDC2", + "cmdose" = "CMDOSE2", "cmtrt" = "CMTRT", "cmdosu" = "CMDOSU2", + "cmroute" = "CMROUTE2", "cmdosfrq" = "CMDOSFRQ2", "cmstdy" = "ASTDY2", + "cmendy" = "AENDY2" + ) + + for (el_name in names(select_inputs)) { + testthat::expect_equal( + app_driver$get_active_module_input(ns_des_input(el_name, "ADCM", "select")), + select_inputs[[el_name]] + ) + } + + # Plot settings ----------------------------------------------------------- + # only tests the options that are customizable + testthat::expect_equal(app_driver$get_active_module_input("font_size"), 12) + + app_driver$stop() + } +) + +# Test changing selection ------------------------------------ + +# Check if a new selection of input changes the plot and table without any validation errors. +test_different_selection <- function(input_name, input_id, new_value) { # nolint object_length + testthat::test_that( + sprintf( + "e2e - tm_g_pp_therapy: Selection of %s changes the plot and table without any validation errors.", + input_name + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_therapy() + plot_before <- list( + app_driver$get_active_module_plot_output("therapy_plot"), + app_driver$active_module_element_text("therapy_table") + ) + app_driver$set_active_module_input(input_id, new_value) + testthat::expect_false( + identical( + plot_before, + list( + app_driver$get_active_module_plot_output("therapy_plot"), + app_driver$active_module_element_text("therapy_table") + ) + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } + ) +} + +test_different_selection("patient_id", "patient_id", "AB12345-RUS-1-id-4") +test_different_selection("cmdecod", ns_des_input("cmdecod", "ADCM", "select"), "CMDECOD") +test_different_selection("atirel", ns_des_input("atirel", "ADCM", "select"), "ATIREL") +test_different_selection("cmindc", ns_des_input("cmindc", "ADCM", "select"), "CMINDC") +test_different_selection("cmdose", ns_des_input("cmdose", "ADCM", "select"), "CMDOSE") +test_different_selection("cmdosu", ns_des_input("cmdosu", "ADCM", "select"), "CMDOSU") +test_different_selection("cmroute", ns_des_input("cmroute", "ADCM", "select"), "CMROUTE") +test_different_selection("cmdosfrq", ns_des_input("cmdosfrq", "ADCM", "select"), "CMDOSFRQ") +test_different_selection("cmstdy", ns_des_input("cmstdy", "ADCM", "select"), "ASTDY") +test_different_selection("cmendy", ns_des_input("cmendy", "ADCM", "select"), "AENDY") + +testthat::test_that( + "e2e - tm_g_pp_therapy: Changing font_size changes the plot and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_therapy() + plot_before <- app_driver$get_active_module_plot_output("therapy_plot") + app_driver$set_active_module_input("font_size", 15) + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("therapy_plot"))) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +# Test de-selecting inputs ------------------------------------ + +# Check if the delection throws the expected validation error +# When `deselect_message` is not provided, the test will check for a standard message "Please select %s variable." +test_delection_validation <- function(input_name, input_id, deselect_message) { + if (missing(deselect_message)) { + deselect_message <- sprintf("Please select %s variable.", toupper(input_name)) + } + testthat::test_that(sprintf("e2e - tm_g_pp_therapy: Deselection of %s throws validation error.", input_name), { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_therapy() + app_driver$set_active_module_input(input_id, NULL) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + sprintf( + "%s_input .shiny-validation-message", + input_id + ) + ), + deselect_message + ) + app_driver$stop() + }) +} + +test_delection_validation("patient_id", "patient_id", "Please select a patient.") +test_delection_validation("cmdecod", ns_des_input("cmdecod", "ADCM", "select"), "Please select medication decoding variable.") # nolint line_length_linter +test_delection_validation("atirel", ns_des_input("atirel", "ADCM", "select")) +test_delection_validation("cmindc", ns_des_input("cmindc", "ADCM", "select")) +test_delection_validation("cmdose", ns_des_input("cmdose", "ADCM", "select")) +test_delection_validation("cmdosu", ns_des_input("cmdosu", "ADCM", "select")) +test_delection_validation("cmroute", ns_des_input("cmroute", "ADCM", "select")) +test_delection_validation("cmdosfrq", ns_des_input("cmdosfrq", "ADCM", "select")) +test_delection_validation("cmstdy", ns_des_input("cmstdy", "ADCM", "select")) +test_delection_validation("cmendy", ns_des_input("cmendy", "ADCM", "select")) diff --git a/tests/testthat/test-shinytest2-tm_g_pp_vitals.R b/tests/testthat/test-shinytest2-tm_g_pp_vitals.R new file mode 100644 index 0000000000..da6fc1a61e --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_g_pp_vitals.R @@ -0,0 +1,239 @@ +app_driver_tm_g_pp_vitals <- function() { + data <- teal.data::teal_data() %>% + within({ + ADSL <- teal.data::rADSL + ADVS <- teal.data::rADVS + }) + + datanames <- c("ADSL", "ADVS") + 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_g_pp_vitals( + label = "Vitals", + dataname = "ADVS", + parentname = "ADSL", + patient_col = "USUBJID", + plot_height = c(600L, 200L, 2000L), + paramcd = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADVS"]], c("PARAMCD", "PARAM")), + selected = "PARAMCD" + ), + xaxis = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADVS"]], c("ADY", "BMRKR1")), + selected = "ADY" + ), + aval_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADVS"]], c("AVAL", "BASE2")), + selected = "AVAL" + ), + plot_width = NULL, + pre_output = NULL, + post_output = NULL, + ggplot2_args = teal.widgets::ggplot2_args() + ) + ) +} + +testthat::test_that("e2e - tm_g_pp_vitals: Module initializes in teal without errors and produces plot output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_vitals() + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() + + testthat::expect_match( + app_driver$get_attr( + app_driver$active_module_element("vitals_plot-plot_main > img"), + "src" + ), + "data:image/png;base64," + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_g_pp_vitals: Starts with specified label, patient_id, paramcd, xaxis, aval_var, font_size, + parentname, patient_col.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_vitals() + + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Vitals" + ) + testthat::expect_equal( + app_driver$get_active_module_input("patient_id"), + "AB12345-CHN-3-id-128" + ) + testthat::expect_equal( + app_driver$get_active_module_input("paramcd-dataset_ADVS_singleextract-select"), + "PARAMCD" + ) + testthat::expect_equal( + app_driver$get_active_module_input("paramcd_levels_vals"), + c("DIABP", "PULSE", "RESP", "SYSBP", "TEMP", "WEIGHT") + ) + testthat::expect_equal( + app_driver$get_active_module_input("xaxis-dataset_ADVS_singleextract-select"), + "ADY" + ) + testthat::expect_equal( + app_driver$get_active_module_input("aval_var-dataset_ADVS_singleextract-select"), + "AVAL" + ) + testthat::expect_equal( + app_driver$get_active_module_input("font_size"), + 12 + ) + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_g_pp_vitals: Selecting patient_id changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_vitals() + plot_before <- app_driver$get_active_module_plot_output("vitals_plot") + app_driver$set_active_module_input("patient_id", "AB12345-CHN-15-id-262") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("vitals_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_pp_vitals: Deselecting patient_id column throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_vitals() + app_driver$set_active_module_input("patient_id", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("vitals_plot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("patient_id_input > div > span"), + "Please select a patient." + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_g_pp_vitals: Selecting valid paramcd and paramcd_levels_vals changes plot + and doesn't throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_vitals() + plot_before <- app_driver$get_active_module_plot_output("vitals_plot") + + # Changing the PARAMCD variable + app_driver$set_active_module_input("paramcd-dataset_ADVS_singleextract-select", "PARAM") + + # Expecting validation error on empty PARAMCD levels input + app_driver$expect_validation_error() + testthat::expect_identical( + app_driver$active_module_element_text("paramcd_levels > div > span"), + "Please select PARAMCD variable levels." + ) + + # Updating the dependant PARAMCD levels + app_driver$set_active_module_input( + "paramcd_levels_vals", + c( + "Diastolic Blood Pressure", "Pulse Rate", "Respiratory Rate", + "Systolic Blood Pressure", "Temperature", "Weight" + ) + ) + + # Expecting the plot to update without errors + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("vitals_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_g_pp_vitals: Deselecting paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_vitals() + app_driver$set_active_module_input("paramcd-dataset_ADVS_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("vitals_plot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("paramcd-dataset_ADVS_singleextract-select_input > div > span"), + "Please select PARAMCD variable." + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_pp_vitals: Selecting xaxis changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_vitals() + plot_before <- app_driver$get_active_module_plot_output("vitals_plot") + app_driver$set_active_module_input("xaxis-dataset_ADVS_singleextract-select", "BMRKR1") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("vitals_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_pp_vitals: Deselecting xaxis column throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_vitals() + app_driver$set_active_module_input("xaxis-dataset_ADVS_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("vitals_plot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("xaxis-dataset_ADVS_singleextract-select_input > div > span"), + "Please select Vitals x-axis variable." + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_pp_vitals: Selecting aval_var changes plot and doesn't throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_vitals() + plot_before <- app_driver$get_active_module_plot_output("vitals_plot") + app_driver$set_active_module_input("aval_var-dataset_ADVS_singleextract-select", "BASE2") + testthat::expect_false( + identical( + plot_before, + app_driver$get_active_module_plot_output("vitals_plot") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_pp_vitals: Deselecting aval_var column throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_vitals() + app_driver$set_active_module_input("aval_var-dataset_ADVS_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_plot_output("vitals_plot"), character(0)) + testthat::expect_identical( + app_driver$active_module_element_text("aval_var-dataset_ADVS_singleextract-select_input > div > span"), + "Please select AVAL variable." + ) + app_driver$expect_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_g_pp_vitals: Changing font_size changes plot and doesn't throw validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_g_pp_vitals() + plot_before <- app_driver$get_active_module_plot_output("vitals_plot") + app_driver$set_active_module_input("font_size", 20) + testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("vitals_plot"))) + app_driver$expect_no_validation_error() + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_abnormality.R b/tests/testthat/test-shinytest2-tm_t_abnormality.R new file mode 100644 index 0000000000..49f5bb43b8 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_abnormality.R @@ -0,0 +1,225 @@ +app_driver_tm_t_abnormality <- function() { + data <- teal.data::teal_data() + data <- within(data, { + library(dplyr) + + ADSL <- teal.data::rADSL + ADLB <- teal.data::rADLB %>% + mutate( + ONTRTFL = case_when( + AVISIT %in% c("SCREENING", "BASELINE") ~ "", + TRUE ~ "Y" + ) %>% with_label("On Treatment Record Flag") + ) + }) + datanames <- c("ADSL", "ADLB") + 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_t_abnormality( + label = "Abnormality Table", + dataname = "ADLB", + parentname = "ADSL", + arm_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADSL"]], subset = c("ARM", "ARMCD")), + selected = "ARM" + ), + add_total = FALSE, + by_vars = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], subset = c("LBCAT", "PARAM", "AVISIT")), + selected = c("LBCAT", "PARAM"), + keep_order = TRUE + ), + baseline_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], subset = "BNRIND"), + selected = "BNRIND", fixed = TRUE + ), + grade = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], subset = "ANRIND"), + selected = "ANRIND", + fixed = TRUE + ), + abnormal = list(low = "LOW", high = "HIGH"), + id_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], subset = "USUBJID"), + selected = "USUBJID", fixed = TRUE + ), + exclude_base_abn = FALSE, + treatment_flag_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], subset = "ONTRTFL"), + selected = "ONTRTFL", fixed = TRUE + ), + treatment_flag = teal.transform::choices_selected("Y"), + total_label = default_total_label(), + drop_arm_levels = TRUE, + pre_output = NULL, + post_output = NULL, + na_level = default_na_str(), + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that("e2e - tm_t_abnormality: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality() + 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_t_abnormality: Starts with specified label, arm_var, by_vars, + add_total, exclude_base_abn, drop_arm_levels.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality() + + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Abnormality Table" + ) + 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("by_vars-dataset_ADLB_singleextract-select"), + c("LBCAT", "PARAM") + ) + testthat::expect_false(app_driver$get_active_module_input("add_total")) + testthat::expect_false(app_driver$get_active_module_input("exclude_base_abn")) + testthat::expect_true(app_driver$get_active_module_input("drop_arm_levels")) + testthat::expect_equal( + app_driver$get_active_module_input("baseline_var-dataset_ADLB_singleextract-select"), + "BNRIND" + ) + testthat::expect_equal( + app_driver$get_active_module_input("grade-dataset_ADLB_singleextract-select"), + "ANRIND" + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_abnormality: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - arm_var: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "Please select a treatment variable." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_abnormality: Selecting by_vars changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("by_vars-dataset_ADLB_singleextract-select", "AVISIT") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_abnormality: Deselection of by_vars throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality() + app_driver$set_active_module_input("by_vars-dataset_ADLB_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("by_vars-dataset_ADLB_singleextract-select_input .shiny-validation-message"), + "Please select a Row By Variable." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_abnormality: Changing add_total changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("add_total", TRUE) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_abnormality: Changing exclude_base_abn changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("exclude_base_abn", TRUE) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_abnormality: Changing drop_arm_levels does not change the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("drop_arm_levels", FALSE) + testthat::expect_true( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) diff --git a/tests/testthat/test-shinytest2-tm_t_abnormality_by_worst_grade.R b/tests/testthat/test-shinytest2-tm_t_abnormality_by_worst_grade.R new file mode 100644 index 0000000000..72ea302628 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_abnormality_by_worst_grade.R @@ -0,0 +1,214 @@ +app_driver_tm_t_abnormality_by_worst_grade <- function() { # nolint: object_length + data <- teal.data::teal_data() %>% + within({ + library(dplyr) + + ADSL <- teal.data::rADSL + ADLB <- teal.data::rADLB %>% + filter(!AVISIT %in% c("SCREENING", "BASELINE")) + }) + + datanames <- c("ADSL", "ADLB") + 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_t_abnormality_by_worst_grade( + label = "Laboratory Test Results with Highest Grade Post-Baseline", + dataname = "ADLB", + parentname = "ADSL", + arm_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADSL"]], subset = c("ARM", "ARMCD")), + selected = "ARM" + ), + id_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], subset = "USUBJID"), + selected = "USUBJID", fixed = TRUE + ), + paramcd = teal.transform::choices_selected( + choices = teal.transform::value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = c("ALT", "CRP", "IGA") + ), + add_total = FALSE, + atoxgr_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], subset = "ATOXGR"), + selected = "ATOXGR", fixed = TRUE + ), + worst_high_flag_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], subset = "WGRHIFL"), + selected = "WGRHIFL", fixed = TRUE + ), + worst_low_flag_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], subset = "WGRLOFL"), + selected = "WGRLOFL", fixed = TRUE + ), + worst_flag_indicator = teal.transform::choices_selected("Y"), + total_label = default_total_label(), + drop_arm_levels = TRUE, + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ), + filter = teal::teal_slices( + teal_slice("ADSL", "SAFFL", selected = "Y"), + teal_slice("ADLB", "ONTRTFL", selected = "Y") + ) + ) +} + +testthat::test_that( + "e2e - tm_t_abnormality_by_worst_grade: Module initializes in teal without errors and produces table output.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality_by_worst_grade() + 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_t_abnormality_by_worst_grade: Starts with specified label, arm_var, paramcd, id_var, atoxgr_var, + worst_high_flag_var, worst_low_flag_var, worst_flag_indicator, add_total, drop_arm_levels.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality_by_worst_grade() + + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Laboratory Test Results with Highest Grade Post-Baseline" + ) + 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("paramcd-dataset_ADLB_singleextract-filter1-vals"), + c("ALT", "CRP", "IGA") + ) + testthat::expect_false(app_driver$get_active_module_input("add_total")) + testthat::expect_true(app_driver$get_active_module_input("drop_arm_levels")) + testthat::expect_equal( + app_driver$get_active_module_input("id_var-dataset_ADLB_singleextract-select"), + "USUBJID" + ) + testthat::expect_equal( + app_driver$get_active_module_input("atoxgr_var-dataset_ADLB_singleextract-select"), + "ATOXGR" + ) + testthat::expect_equal( + app_driver$get_active_module_input("worst_high_flag_var-dataset_ADLB_singleextract-select"), + "WGRHIFL" + ) + testthat::expect_equal( + app_driver$get_active_module_input("worst_low_flag_var-dataset_ADLB_singleextract-select"), + "WGRLOFL" + ) + testthat::expect_equal( + app_driver$get_active_module_input("worst_flag_indicator"), + "Y" + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_abnormality_by_worst_grade: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality_by_worst_grade() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_abnormality_by_worst_grade: Selecting paramcd changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality_by_worst_grade() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("paramcd-dataset_ADLB_singleextract-filter1-vals", c("ALT", "CRP")) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_abnormality_by_worst_grade: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality_by_worst_grade() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "Please select a treatment variable." + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_t_abnormality_by_worst_grade: Deselection of paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality_by_worst_grade() + app_driver$set_active_module_input("paramcd-dataset_ADLB_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "paramcd-dataset_ADLB_singleextract-filter1-vals_input .shiny-validation-message" + ), + "Please select at least one Laboratory parameter." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_abnormality_by_worst_grade: Changing add_total changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality_by_worst_grade() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("add_total", TRUE) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_abnormality_by_worst_grade: Changing drop_arm_levels does not change the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_abnormality_by_worst_grade() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("drop_arm_levels", FALSE) + testthat::expect_identical(table_before, app_driver$get_active_module_table_output("table-table-with-settings")) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) diff --git a/tests/testthat/test-shinytest2-tm_t_ancova.R b/tests/testthat/test-shinytest2-tm_t_ancova.R new file mode 100644 index 0000000000..2953897737 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_ancova.R @@ -0,0 +1,296 @@ +app_driver_tm_t_ancova <- function() { + data <- teal.data::teal_data() %>% + within({ + ADSL <- tmc_ex_adsl + ADQS <- tmc_ex_adqs + }) + + datanames <- c("ADSL", "ADQS") + 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") + ), + ACTARMCD = list( + ref = "ARM B", + comp = c("ARM A", "ARM C") + ) + ) + + init_teal_app_driver( + data = data, + modules = tm_t_ancova( + label = "ANCOVA Table", + dataname = "ADQS", + parentname = "ADSL", + avisit = teal.transform::choices_selected( + choices = teal.transform::value_choices(data[["ADQS"]], "AVISIT"), + selected = "WEEK 1 DAY 8" + ), + arm_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADSL"]], c("ARM", "ACTARMCD", "ARMCD")), + selected = "ARMCD" + ), + arm_ref_comp = arm_ref_comp, + aval_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADQS"]], c("CHG", "AVAL")), + selected = "CHG" + ), + cov_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADQS"]], c("BASE", "STRATA1", "SEX")), + selected = "STRATA1" + ), + paramcd = teal.transform::choices_selected( + choices = teal.transform::value_choices(data[["ADQS"]], "PARAMCD", "PARAM"), + selected = "FKSI-FWB" + ), + interact_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADQS"]], c("BASE", "STRATA1", "SEX")), + selected = "STRATA1" + ), + conf_level = teal.transform::choices_selected(c(2, 0.95, 0.9, 0.8), 0.95, keep_order = TRUE), + include_interact = FALSE, + interact_y = FALSE, + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that("e2e - tm_t_ancova: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_ancova() + 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_t_ancova: Starts with specified label, avisit, paramcd, aval_var, aval_var, + arm_var, buckets, combine_comp_arms, interact_var, cov_var, conf_level, include_interact.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_ancova() + + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "ANCOVA Table" + ) + testthat::expect_equal( + app_driver$get_active_module_input("avisit-dataset_ADQS_singleextract-filter1-vals"), + "WEEK 1 DAY 8" + ) + testthat::expect_equal( + app_driver$get_active_module_input("avisit-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("aval_var-dataset_ADQS_singleextract-select"), + "CHG" + ) + 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("buckets"), + list( + Ref = list("ARM A"), + Comp = list("ARM B", "ARM C") + ) + ) + testthat::expect_false(app_driver$get_active_module_input("combine_comp_arms")) + testthat::expect_equal( + app_driver$get_active_module_input("interact_var-dataset_ADQS_singleextract-select"), + "STRATA1" + ) + testthat::expect_equal( + app_driver$get_active_module_input("cov_var-dataset_ADQS_singleextract-select"), + "STRATA1" + ) + testthat::expect_equal( + app_driver$get_active_module_input("conf_level"), + "0.95" + ) + testthat::expect_false(app_driver$get_active_module_input("include_interact")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_ancova: Selecting avisit changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_ancova() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input( + "avisit-dataset_ADQS_singleextract-filter1-vals", + c("WEEK 1 DAY 8", "WEEK 2 DAY 15") + ) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_ancova: Deselection of avisit throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_ancova() + app_driver$set_active_module_input("avisit-dataset_ADQS_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "avisit-dataset_ADQS_singleextract-filter1-vals_input .shiny-validation-message" + ), + "`Analysis Visit` field cannot be empty." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_ancova: Selecting paramcd changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_ancova() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", c("BFIALL", "FATIGI")) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_ancova: Deselection of paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_ancova() + app_driver$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "paramcd-dataset_ADQS_singleextract-filter1-vals_input .shiny-validation-message" + ), + "`Select Endpoint` is not selected." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_ancova: Selecting aval_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_ancova() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("aval_var-dataset_ADQS_singleextract-select", "AVAL") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_ancova: Deselection of aval_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_ancova() + app_driver$set_active_module_input("aval_var-dataset_ADQS_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("aval_var-dataset_ADQS_singleextract-select_input .shiny-validation-message"), + "Analysis variable cannot be empty." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_ancova: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_ancova() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARM") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_ancova: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_ancova() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "Treatment variable must be selected" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_ancova: Selecting cov_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_ancova() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("cov_var-dataset_ADQS_singleextract-select", "BASE") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_ancova: Deselection of cov_var changes table and doesn't throw validation error.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_ancova() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("cov_var-dataset_ADQS_singleextract-select", NULL) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) diff --git a/tests/testthat/test-shinytest2-tm_t_binary_outcome.R b/tests/testthat/test-shinytest2-tm_t_binary_outcome.R new file mode 100644 index 0000000000..2f600f0aef --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_binary_outcome.R @@ -0,0 +1,302 @@ +app_driver_tm_t_binary_outcome <- function() { + data <- teal.data::teal_data() %>% + within({ + library(dplyr) + 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( + ARMCD = list(ref = "ARM B", comp = c("ARM A", "ARM C")), + ARM = list(ref = "B: Placebo", comp = c("A: Drug X", "C: Combination")) + ) + + init_teal_app_driver( + data = data, + modules = tm_t_binary_outcome( + label = "Responders", + dataname = "ADRS", + parentname = "ADSL", + arm_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADRS"]], c("ARM", "ARMCD", "ACTARMCD")), + selected = "ARM" + ), + arm_ref_comp = arm_ref_comp, + paramcd = teal.transform::choices_selected( + choices = teal.transform::value_choices(data[["ADRS"]], "PARAMCD", "PARAM"), + selected = "BESRSPI" + ), + strata_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADRS"]], c("SEX", "BMRKR2", "RACE")), + selected = "RACE" + ), + aval_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices( + data[["ADRS"]], c("AVALC", "SEX") + ), + selected = "AVALC", + fixed = FALSE + ), + conf_level = teal.transform::choices_selected( + c(2, 0.95, 0.9, 0.8), 0.95, + keep_order = TRUE + ), + default_responses = list( + BESRSPI = list( + rsp = c("Complete Response (CR)", "Partial Response (PR)"), + levels = c( + "Complete Response (CR)", "Partial Response (PR)", + "Stable Disease (SD)", "Progressive Disease (PD)" + ) + ), + INVET = list( + rsp = c("Stable Disease (SD)", "Not Evaluable (NE)"), + 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)") + ) + ), + rsp_table = FALSE, + control = list(global = list( + method = "waldcc", + conf_level = 0.95 + ), unstrat = list( + method_ci = "waldcc", + method_test = "schouten", odds = TRUE + ), strat = list( + method_ci = "cmh", method_test = + "cmh" + )), + add_total = FALSE, + total_label = default_total_label(), + na_level = default_na_str(), + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that("e2e - tm_t_binary_outcome: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_binary_outcome() + 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_t_binary_outcome: Starts with specified label, paramcd, responders, arm_var, + buckets, u_diff_ci, u_diff_test, strata_var, s_diff_ci, prop_ci_method, conf_level, + aval_var, compare_arms, combine_comp_arms, u_odds_ratio, show_rsp_cat.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_binary_outcome() + + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Responders" + ) + testthat::expect_equal( + app_driver$get_active_module_input("paramcd-dataset_ADRS_singleextract-filter1-vals"), + "BESRSPI" + ) + 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("arm_var-dataset_ADSL_singleextract-select"), + "ARM" + ) + testthat::expect_equal( + app_driver$get_active_module_input("buckets"), + list( + Ref = list("B: Placebo"), + Comp = list("A: Drug X", "C: Combination") + ) + ) + testthat::expect_equal( + app_driver$get_active_module_input("u_diff_ci"), + "waldcc" + ) + testthat::expect_equal( + app_driver$get_active_module_input("u_diff_test"), + "schouten" + ) + testthat::expect_equal( + app_driver$get_active_module_input("strata_var-dataset_ADSL_singleextract-select"), + "RACE" + ) + testthat::expect_equal( + app_driver$get_active_module_input("s_diff_ci"), + "cmh" + ) + testthat::expect_equal( + app_driver$get_active_module_input("prop_ci_method"), + "waldcc" + ) + testthat::expect_equal( + app_driver$get_active_module_input("conf_level"), + "0.95" + ) + testthat::expect_equal( + app_driver$get_active_module_input("aval_var-dataset_ADRS_singleextract-select"), + "AVALC" + ) + testthat::expect_true(app_driver$get_active_module_input("compare_arms")) + testthat::expect_false(app_driver$get_active_module_input("combine_comp_arms")) + testthat::expect_true(app_driver$get_active_module_input("u_odds_ratio")) + testthat::expect_false(app_driver$get_active_module_input("show_rsp_cat")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_binary_outcome: Selecting paramcd changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_binary_outcome() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("paramcd-dataset_ADRS_singleextract-filter1-vals", "INVET") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_binary_outcome: Deselection of paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_binary_outcome() + app_driver$set_active_module_input("paramcd-dataset_ADRS_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "paramcd-dataset_ADRS_singleextract-filter1-vals_input .shiny-validation-message" + ), + "Please select a filter." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_binary_outcome: Selecting responders changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_binary_outcome() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("responders", c("Stable Disease (SD)", "Progressive Disease (PD)")) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_binary_outcome: Deselection of responders throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_binary_outcome() + app_driver$set_active_module_input("responders", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-responders .shiny-validation-message"), + "`Responders` field is empty" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_binary_outcome: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_binary_outcome() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_binary_outcome: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_binary_outcome() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "Treatment variable must be selected" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_binary_outcome: Selecting strata_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_binary_outcome() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("strata_var-dataset_ADSL_singleextract-select", "SEX") + + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_binary_outcome: Deselection of strata_var changes the table and does not throw validation errors.", # nolint line_length_linter + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_binary_outcome() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("strata_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) diff --git a/tests/testthat/test-shinytest2-tm_t_coxreg.R b/tests/testthat/test-shinytest2-tm_t_coxreg.R new file mode 100644 index 0000000000..61693fa9dd --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_coxreg.R @@ -0,0 +1,260 @@ +app_driver_tm_t_coxreg <- function() { + # TODO: Check if data fabrication is needed for Cox regression + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- teal.data::rADSL + ADTTE <- teal.data::rADTTE + }) + 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( + ACTARMCD = list( + ref = "ARM B", + comp = c("ARM A", "ARM C") + ), + ARM = list( + ref = "B: Placebo", + comp = c("A: Drug X", "C: Combination") + ) + ) + + init_teal_app_driver( + data = data, + modules = tm_t_coxreg( + label = "Cox Reg.", + dataname = "ADTTE", + parentname = "ADSL", + arm_var = teal.transform::choices_selected(c("ARM", "ARMCD", "ACTARMCD"), "ARM"), + arm_ref_comp = arm_ref_comp, + paramcd = teal.transform::choices_selected( + teal.transform::value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), "OS" + ), + strata_var = teal.transform::choices_selected( + c("COUNTRY", "STRATA1", "STRATA2"), "STRATA1" + ), + cov_var = teal.transform::choices_selected( + c("AGE", "BMRKR1", "BMRKR2", "REGION1"), "AGE" + ), + multivariate = TRUE, + aval_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADTTE"]], "AVAL"), "AVAL", + fixed = TRUE + ), + cnsr_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADTTE"]], "CNSR"), "CNSR", + fixed = TRUE + ), + na_level = default_na_str(), + conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, + keep_order = + TRUE + ), + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that("e2e - tm_t_coxreg: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_coxreg() + 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_t_coxreg: Starts with specified label, type, paramcd, arm_var, buckets, + cov_var, strata_var, pval_method, ties, conf_level, combine_comp_arms.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_coxreg() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Cox Reg." + ) + testthat::expect_equal( + app_driver$get_active_module_input("type"), + "Multivariate" + ) + testthat::expect_equal( + app_driver$get_active_module_input("paramcd-dataset_ADTTE_singleextract-filter1-vals"), + "OS" + ) + 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("buckets"), + list( + Ref = list("B: Placebo"), + Comp = list("A: Drug X", "C: Combination") + ) + ) + testthat::expect_equal( + app_driver$get_active_module_input("cov_var-dataset_ADSL_singleextract-select"), + "AGE" + ) + testthat::expect_equal( + app_driver$get_active_module_input("strata_var-dataset_ADSL_singleextract-select"), + "STRATA1" + ) + testthat::expect_equal( + app_driver$get_active_module_input("pval_method"), + "wald" + ) + testthat::expect_equal( + app_driver$get_active_module_input("ties"), + "exact" + ) + testthat::expect_equal( + app_driver$get_active_module_input("conf_level"), + "0.95" + ) + testthat::expect_false(app_driver$get_active_module_input("combine_comp_arms")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_coxreg: Selecting paramcd changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_coxreg() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("paramcd-dataset_ADTTE_singleextract-filter1-vals", "CRSD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_coxreg: Deselection of paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_coxreg() + app_driver$set_active_module_input("paramcd-dataset_ADTTE_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "paramcd-dataset_ADTTE_singleextract-filter1-vals_input .shiny-validation-message" + ), + "An endpoint is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_coxreg: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_coxreg() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_coxreg: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_coxreg() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "Treatment variable must be selected" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_coxreg: Selecting cov_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_coxreg() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("cov_var-dataset_ADSL_singleextract-select", c("BMRKR1", "BMRKR2")) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_coxreg: Deselection of cov_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_coxreg() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("cov_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_coxreg: Selecting strata_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_coxreg() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("strata_var-dataset_ADSL_singleextract-select", c("STRATA2", "COUNTRY")) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_coxreg: Deselection of strata_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_coxreg() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("strata_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) diff --git a/tests/testthat/test-shinytest2-tm_t_events.R b/tests/testthat/test-shinytest2-tm_t_events.R new file mode 100644 index 0000000000..8cc68a408b --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_events.R @@ -0,0 +1,196 @@ +app_driver_tm_t_events <- function() { + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- teal.data::rADSL + ADAE <- teal.data::rADAE + }) + datanames <- c("ADSL", "ADAE") + 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_t_events( + label = "Adverse Event Table", + dataname = "ADAE", + parentname = "ADSL", + arm_var = teal.transform::choices_selected(c("ARM", "ARMCD"), "ARM"), + llt = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAE"]], c("AETERM", "AEDECOD")), + selected = c("AEDECOD") + ), + hlt = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAE"]], c("AEBODSYS", "AESOC")), + selected = "AEBODSYS" + ), + add_total = TRUE, + event_type = "adverse event", + total_label = default_total_label(), + na_level = default_na_str(), + sort_criteria = c("freq_desc", "alpha"), + sort_freq_col = default_total_label(), + prune_freq = 0, + prune_diff = 0, + drop_arm_levels = TRUE, + incl_overall_sum = TRUE, + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that("e2e - tm_t_events: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events() + 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_t_events: Starts with specified label, arm_var, hlt, llt, sort_criteria, + prune_freq, prune_diff, add_total, drop_arm_levels.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events() + + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Adverse Event Table" + ) + 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("hlt-dataset_ADAE_singleextract-select"), + "AEBODSYS" + ) + testthat::expect_equal( + app_driver$get_active_module_input("llt-dataset_ADAE_singleextract-select"), + "AEDECOD" + ) + testthat::expect_equal( + app_driver$get_active_module_input("sort_criteria"), + "freq_desc" + ) + testthat::expect_equal( + app_driver$get_active_module_input("prune_freq"), + 0 + ) + testthat::expect_equal( + app_driver$get_active_module_input("prune_diff"), + 0 + ) + testthat::expect_true(app_driver$get_active_module_input("add_total")) + testthat::expect_true(app_driver$get_active_module_input("drop_arm_levels")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_events: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_events: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "Please select 1 or 2 treatment variable values" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_events: Selecting hlt changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("hlt-dataset_ADAE_singleextract-select", "AESOC") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_events: Deselection of hlt changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("hlt-dataset_ADAE_singleextract-select", NULL) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_events: Selecting llt changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("llt-dataset_ADAE_singleextract-select", "AETERM") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_events: Deselection of llt changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("llt-dataset_ADAE_singleextract-select", NULL) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) diff --git a/tests/testthat/test-shinytest2-tm_t_events_by_grade.R b/tests/testthat/test-shinytest2-tm_t_events_by_grade.R new file mode 100644 index 0000000000..d62c0005d1 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_events_by_grade.R @@ -0,0 +1,241 @@ +app_driver_tm_t_events_by_grade <- function() { # nolint: object_length + data <- teal.data::teal_data() + data <- within(data, { + library(dplyr) + + ADSL <- teal.data::rADSL + lbls_adae <- col_labels(teal.data::rADAE) + ADAE <- teal.data::rADAE %>% + mutate_if(is.character, as.factor) + col_labels(ADAE) <- lbls_adae + }) + + datanames <- c("ADSL", "ADAE") + 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_t_events_by_grade( + label = "Adverse Events by Grade Table", + dataname = "ADAE", + parentname = "ADSL", + arm_var = teal.transform::choices_selected(c("ARM", "ARMCD"), "ARM"), + llt = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAE"]], c("AETERM", "AEDECOD")), + selected = c("AEDECOD") + ), + hlt = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAE"]], c("AEBODSYS", "AESOC")), + selected = "AEBODSYS" + ), + grade = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAE"]], c("AETOXGR", "AESEV")), + selected = "AETOXGR" + ), + grading_groups = list( + `Any Grade (%)` = c("1", "2", "3", "4", "5"), `Grade 1-2 (%)` = + c("1", "2"), `Grade 3-4 (%)` = c("3", "4"), `Grade 5 (%)` = "5" + ), + col_by_grade = FALSE, + prune_freq = 0, + prune_diff = 0, + add_total = TRUE, + total_label = default_total_label(), + na_level = default_na_str(), + drop_arm_levels = TRUE, + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that( + "e2e - tm_t_events_by_grade: Module initializes in teal without errors and produces table output.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_by_grade() + 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_t_events_by_grade: Starts with specified label, arm_var, hlt, llt, + grade, prune_freq, prune_diff, add_total, col_by_grade, drop_arm_levels.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_by_grade() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Adverse Events by Grade Table" + ) + 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("hlt-dataset_ADAE_singleextract-select"), + "AEBODSYS" + ) + testthat::expect_equal( + app_driver$get_active_module_input("llt-dataset_ADAE_singleextract-select"), + "AEDECOD" + ) + testthat::expect_equal( + app_driver$get_active_module_input("grade-dataset_ADAE_singleextract-select"), + "AETOXGR" + ) + testthat::expect_equal( + app_driver$get_active_module_input("prune_freq"), + 0 + ) + testthat::expect_equal( + app_driver$get_active_module_input("prune_diff"), + 0 + ) + testthat::expect_true(app_driver$get_active_module_input("add_total")) + testthat::expect_false(app_driver$get_active_module_input("col_by_grade")) + testthat::expect_true(app_driver$get_active_module_input("drop_arm_levels")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_events_by_grade: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_by_grade() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_events_by_grade: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_by_grade() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "A treatment variable is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_events_by_grade: Selecting hlt changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_by_grade() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("hlt-dataset_ADAE_singleextract-select", "AESOC") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_events_by_grade: Deselection of hlt changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_by_grade() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("hlt-dataset_ADAE_singleextract-select", NULL) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_events_by_grade: Selecting llt changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_by_grade() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("llt-dataset_ADAE_singleextract-select", "AETERM") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_events_by_grade: Deselection of llt changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_by_grade() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("llt-dataset_ADAE_singleextract-select", NULL) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_events_by_grade: Selecting grade changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_by_grade() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("grade-dataset_ADAE_singleextract-select", "AESEV") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_events_by_grade: Deselection of grade throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_by_grade() + app_driver$set_active_module_input("grade-dataset_ADAE_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("grade-dataset_ADAE_singleextract-select_input .shiny-validation-message"), + "An event grade is required" + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_events_patyear.R b/tests/testthat/test-shinytest2-tm_t_events_patyear.R new file mode 100644 index 0000000000..ccd6e7f01f --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_events_patyear.R @@ -0,0 +1,177 @@ +app_driver_tm_t_events_patyear <- function() { + data <- teal.data::teal_data() + data <- within(data, { + library(dplyr) + ADSL <- tmc_ex_adsl + ADAETTE <- tmc_ex_adaette %>% # nolint object_name + filter(PARAMCD %in% c("AETTE1", "AETTE2", "AETTE3")) %>% + mutate(is_event = CNSR == 0) %>% + mutate(n_events = as.integer(is_event)) + }) + + datanames <- c("ADSL", "ADAETTE") + 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_t_events_patyear( + label = "AE Rate Adjusted for Patient-Years At Risk Table", + dataname = "ADAETTE", + parentname = "ADSL", + arm_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADSL"]], c("ARM", "ARMCD")), + selected = "ARMCD" + ), + add_total = TRUE, + events_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAETTE"]], "n_events"), + selected = "n_events", + fixed = TRUE + ), + paramcd = teal.transform::choices_selected( + choices = teal.transform::value_choices(data[["ADAETTE"]], "PARAMCD", "PARAM"), + selected = "AETTE1" + ), + conf_level = teal.transform::choices_selected( + c(2, 0.95, 0.9, 0.8), 0.95, + keep_order = TRUE + ), + aval_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAETTE"]], "AVAL"), + selected = "AVAL", fixed = TRUE + ), + avalu_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAETTE"]], "AVALU"), + selected = "AVALU", fixed = TRUE + ), + total_label = default_total_label(), + na_level = default_na_str(), + drop_arm_levels = TRUE, + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that("e2e - tm_t_events_patyear: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_patyear() + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() + testthat::expect_true( + app_driver$is_visible(app_driver$active_module_element("patyear_table-table-with-settings")) + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_events_patyear: Starts with specified label, arm_var, paramcd, conf_level, + conf_method, num_pt_year, input_time_unit, add_total, drop_arm_levels.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_patyear() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "AE Rate Adjusted for Patient-Years At Risk Table" + ) + 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_ADAETTE_singleextract-filter1-vals"), + "AETTE1" + ) + testthat::expect_equal( + app_driver$get_active_module_input("conf_level"), + "0.95" + ) + testthat::expect_equal( + app_driver$get_active_module_input("conf_method"), + "Normal (rate)" + ) + testthat::expect_equal( + app_driver$get_active_module_input("num_pt_year"), + "100" + ) + testthat::expect_equal( + app_driver$get_active_module_input("input_time_unit"), + "year" + ) + testthat::expect_true(app_driver$get_active_module_input("add_total")) + testthat::expect_true(app_driver$get_active_module_input("drop_arm_levels")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_events_patyear: Selecting paramcd changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_patyear() + table_before <- app_driver$get_active_module_table_output("patyear_table-table-with-settings") + app_driver$set_active_module_input("paramcd-dataset_ADAETTE_singleextract-filter1-vals", "AETTE2") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("patyear_table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_events_patyear: Deselection of paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_patyear() + app_driver$set_active_module_input("paramcd-dataset_ADAETTE_singleextract-filter1-vals", NULL) + testthat::expect_identical( + app_driver$get_active_module_table_output("patyear_table-table-with-settings"), + data.frame() + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "paramcd-dataset_ADAETTE_singleextract-filter1-vals_input .shiny-validation-message" + ), + "A Event Type Parameter is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_events_patyear: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_patyear() + table_before <- app_driver$get_active_module_table_output("patyear_table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARM") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("patyear_table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_events_patyear: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_patyear() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical( + app_driver$get_active_module_table_output("patyear_table-table-with-settings"), + data.frame() + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "Please select exactly 1 or 2 treatment variables" + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_events_summary.R b/tests/testthat/test-shinytest2-tm_t_events_summary.R new file mode 100644 index 0000000000..054be74fb1 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_events_summary.R @@ -0,0 +1,242 @@ +app_driver_tm_t_events_summary <- function() { + data <- teal.data::teal_data() + data <- within(data, { + library(dplyr) + ADSL <- teal.data::rADSL %>% + mutate( + DTHFL = case_when( + !is.na(DTHDT) ~ "Y", + TRUE ~ "" + ) %>% with_label("Subject Death Flag") + ) + ADAE <- teal.data::rADAE + + add_event_flags <- function(dat) { + dat <- dat %>% + dplyr::mutate( + TMPFL_SER = AESER == "Y", + TMPFL_REL = AEREL == "Y", + TMPFL_GR5 = AETOXGR == "5", + TMP_SMQ01 = !is.na(SMQ01NAM), + TMP_SMQ02 = !is.na(SMQ02NAM), + TMP_CQ01 = !is.na(CQ01NAM) + ) + column_labels <- list( + TMPFL_SER = "Serious AE", + TMPFL_REL = "Related AE", + TMPFL_GR5 = "Grade 5 AE", + TMP_SMQ01 = tern::aesi_label(dat[["SMQ01NAM"]], dat[["SMQ01SC"]]), + TMP_SMQ02 = tern::aesi_label("Y.9.9.9.9/Z.9.9.9.9 AESI"), + TMP_CQ01 = tern::aesi_label(dat[["CQ01NAM"]]) + ) + col_labels(dat)[names(column_labels)] <- as.character(column_labels) + dat + } + + ADAE <- ADAE %>% add_event_flags() + + ae_anl_vars <- names(ADAE)[startsWith(names(ADAE), "TMPFL_")] + aesi_vars <- names(ADAE)[startsWith(names(ADAE), "TMP_")] + }) + + datanames <- c("ADSL", "ADAE") + 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_t_events_summary( + label = "Adverse Events Summary", + dataname = "ADAE", + parentname = "ADSL", + arm_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices("ADSL", c("ARM", "ARMCD")), + selected = "ARM" + ), + flag_var_anl = teal.transform::choices_selected( + choices = teal.transform::variable_choices("ADAE", data[["ae_anl_vars"]]), + selected = data[["ae_anl_vars"]][1], + keep_order = TRUE, + fixed = FALSE + ), + flag_var_aesi = teal.transform::choices_selected( + choices = teal.transform::variable_choices("ADAE", data[["aesi_vars"]]), + selected = data[["aesi_vars"]][1], + keep_order = TRUE, + fixed = FALSE + ), + dthfl_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADSL"]], "DTHFL"), + selected = "DTHFL", fixed = TRUE + ), + dcsreas_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADSL"]], "DCSREAS"), + selected = "DCSREAS", fixed = TRUE + ), + llt = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAE"]], "AEDECOD"), + selected = "AEDECOD", fixed = TRUE + ), + aeseq_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAE"]], "AESEQ"), + selected = "AESEQ", fixed = TRUE + ), + add_total = TRUE, + total_label = default_total_label(), + na_level = default_na_str(), + count_subj = TRUE, + count_pt = TRUE, + count_events = TRUE, + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that("e2e - tm_t_events_summary: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_summary() + 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_t_events_summary: Starts with specified label, arm_var, flag_var_anl, flag_var_aesi, + add_total, count_subj, count_pt, count_events.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_summary() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Adverse Events Summary" + ) + 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("flag_var_anl-dataset_ADAE_singleextract-select"), + "TMPFL_SER" + ) + testthat::expect_equal( + app_driver$get_active_module_input("flag_var_aesi-dataset_ADAE_singleextract-select"), + "TMP_SMQ01" + ) + testthat::expect_true(app_driver$get_active_module_input("add_total")) + testthat::expect_true(app_driver$get_active_module_input("count_subj")) + testthat::expect_true(app_driver$get_active_module_input("count_pt")) + testthat::expect_true(app_driver$get_active_module_input("count_events")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_events_summary: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_summary() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_events_summary: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_summary() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "Please select exactly 1 or 2 treatment variables" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_events_summary: Selecting flag_var_anl changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_summary() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("flag_var_anl-dataset_ADAE_singleextract-select", c("TMPFL_REL", "TMPFL_GR5")) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_events_summary: Deselection of flag_var_anl changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_summary() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("flag_var_anl-dataset_ADAE_singleextract-select", NULL) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + + +testthat::test_that( + "e2e - tm_t_events_summary: Selecting flag_var_aesi changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_summary() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("flag_var_aesi-dataset_ADAE_singleextract-select", c("TMP_SMQ02", "TMP_CQ01")) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_events_summary: Deselection of flag_var_aesi changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_events_summary() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("flag_var_aesi-dataset_ADAE_singleextract-select", NULL) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) diff --git a/tests/testthat/test-shinytest2-tm_t_exposure.R b/tests/testthat/test-shinytest2-tm_t_exposure.R new file mode 100644 index 0000000000..836a94d538 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_exposure.R @@ -0,0 +1,250 @@ +app_driver_tm_t_exposure <- function() { + data <- teal.data::teal_data() + data <- within(data, { + library(dplyr) + ADSL <- teal.data::rADSL + ADEX <- teal.data::rADEX + + set.seed(1, kind = "Mersenne-Twister") + labels <- col_labels(ADEX, fill = FALSE) + ADEX <- ADEX %>% + distinct(USUBJID, .keep_all = TRUE) %>% + mutate( + PARAMCD = "TDURD", + PARAM = "Overall duration (days)", + AVAL = sample(x = seq(1, 200), size = n(), replace = TRUE), + AVALU = "Days" + ) %>% + bind_rows(ADEX) + col_labels(ADEX) <- labels + }) + + datanames <- c("ADSL", "ADEX") + 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_t_exposure( + label = "Duration of Exposure Table", + dataname = "ADEX", + parentname = "ADSL", + paramcd = teal.transform::choices_selected( + choices = teal.transform::value_choices(data[["ADEX"]], "PARAMCD", "PARAM"), + selected = "TDURD" + ), + col_by_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADEX"]], subset = c("SEX", "ARM")), + selected = "SEX" + ), + row_by_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADEX"]], subset = c("RACE", "REGION1", "STRATA1", "SEX")), + selected = "RACE" + ), + parcat = teal.transform::choices_selected( + choices = teal.transform::value_choices(data[["ADEX"]], "PARCAT2"), + selected = "Drug A" + ), + add_total = FALSE, + paramcd_label = "PARAM", + id_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADEX"]], subset = "USUBJID"), + selected = "USUBJID", fixed = TRUE + ), + aval_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADEX"]], subset = "AVAL"), + selected = "AVAL", fixed = TRUE + ), + avalu_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADEX"]], subset = "AVALU"), + selected = "AVALU", fixed = TRUE + ), + total_label = default_total_label(), + add_total_row = TRUE, + total_row_label = "Total number of patients and patient time*", + na_level = default_na_str(), + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ), + filter = teal::teal_slices(teal_slice("ADSL", "SAFFL", selected = "Y")), + ) +} + +testthat::test_that("e2e - tm_t_exposure: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_exposure() + 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_t_exposure: Starts with specified label, paramcd, parcat, + col_by_var, row_by_var, add_total_row, add_total", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_exposure() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Duration of Exposure Table" + ) + testthat::expect_equal( + app_driver$get_active_module_input("paramcd-dataset_ADEX_singleextract-filter1-vals"), + "TDURD" + ) + testthat::expect_equal( + app_driver$get_active_module_input("parcat-dataset_ADEX_singleextract-filter1-vals"), + "Drug A" + ) + testthat::expect_equal( + app_driver$get_active_module_input("col_by_var-dataset_ADSL_singleextract-select"), + "SEX" + ) + testthat::expect_equal( + app_driver$get_active_module_input("row_by_var-dataset_ADEX_singleextract-select"), + "RACE" + ) + testthat::expect_true(app_driver$get_active_module_input("add_total_row")) + testthat::expect_false(app_driver$get_active_module_input("add_total")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_exposure: Selecting paramcd changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_exposure() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("paramcd-dataset_ADEX_singleextract-filter1-vals", "DOSE") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_exposure: Deselection of paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_exposure() + app_driver$set_active_module_input("paramcd-dataset_ADEX_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "paramcd-dataset_ADEX_singleextract-filter1-vals_input .shiny-validation-message" + ), + "Please select a parameter value." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_exposure: Selecting parcat changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_exposure() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("parcat-dataset_ADEX_singleextract-filter1-vals", "Drug B") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_exposure: Deselection of parcat throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_exposure() + app_driver$set_active_module_input("parcat-dataset_ADEX_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "parcat-dataset_ADEX_singleextract-filter1-vals_input .shiny-validation-message" + ), + "Please select a parameter category value." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_exposure: Selecting col_by_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_exposure() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("col_by_var-dataset_ADSL_singleextract-select", "ARM") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_exposure: Deselection of col_by_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_exposure() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("col_by_var-dataset_ADSL_singleextract-select", character(0), wait_ = FALSE) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_exposure: Selecting row_by_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_exposure() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("row_by_var-dataset_ADEX_singleextract-select", "REGION1") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_exposure: Deselection of row_by_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_exposure() + app_driver$set_active_module_input("row_by_var-dataset_ADEX_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "row_by_var-dataset_ADEX_singleextract-select_input .shiny-validation-message" + ), + "Please select a row by variable." + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_logistic.R b/tests/testthat/test-shinytest2-tm_t_logistic.R new file mode 100644 index 0000000000..7968f5ea7c --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_logistic.R @@ -0,0 +1,203 @@ +app_driver_tm_t_logistic <- function() { + data <- teal.data::teal_data() + data <- within(data, { + library(dplyr) + ADSL <- teal.data::rADSL + ADRS <- teal.data::rADRS %>% + filter(PARAMCD %in% c("BESRSPI", "INVET")) + }) + + 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( + ACTARMCD = list( + ref = "ARM B", + comp = c("ARM A", "ARM C") + ), + ARM = list( + ref = "B: Placebo", + comp = c("A: Drug X", "C: Combination") + ) + ) + + init_teal_app_driver( + data = data, + modules = tm_t_logistic( + label = "Logistic Regression", + parentname = "ADSL", + dataname = "ADRS", + arm_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADRS"]], c("ARM", "ARMCD")), + selected = "ARM" + ), + arm_ref_comp = arm_ref_comp, + paramcd = teal.transform::choices_selected( + choices = teal.transform::value_choices(data[["ADRS"]], "PARAMCD", "PARAM"), + selected = "BESRSPI" + ), + cov_var = teal.transform::choices_selected( + choices = c("SEX", "AGE", "BMRKR1", "BMRKR2"), + selected = "SEX" + ), + conf_level = teal.transform::choices_selected(c(2, 0.95, 0.9, 0.8), 0.95, keep_order = TRUE), + avalc_var = teal.transform::choices_selected(teal.transform::variable_choices( + data[["ADRS"]], + "AVALC" + ), "AVALC", fixed = TRUE), + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that("e2e - tm_t_logistic: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_logistic() + 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_t_logistic: Starts with specified label, paramcd, responders, arm_var, buckets, + cov_var, interaction_var, conf_level, combine_comp_arms.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_logistic() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Logistic Regression" + ) + testthat::expect_equal( + app_driver$get_active_module_input("paramcd-dataset_ADRS_singleextract-filter1-vals"), + "BESRSPI" + ) + testthat::expect_equal( + app_driver$get_active_module_input("responders"), + c("CR", "PR") + ) + 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("buckets"), + list( + Ref = list("B: Placebo"), + Comp = list("A: Drug X", "C: Combination") + ) + ) + testthat::expect_equal( + app_driver$get_active_module_input("cov_var-dataset_ADRS_singleextract-select"), + "SEX" + ) + testthat::expect_null(app_driver$get_active_module_input("interaction_var")) + testthat::expect_equal( + app_driver$get_active_module_input("conf_level"), + "0.95" + ) + testthat::expect_false(app_driver$get_active_module_input("combine_comp_arms")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_logistic: Selecting paramcd changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_logistic() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("paramcd-dataset_ADRS_singleextract-filter1-vals", "INVET") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_logistic: Deselection of paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_logistic() + app_driver$set_active_module_input("paramcd-dataset_ADRS_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "paramcd-dataset_ADRS_singleextract-filter1-vals_input .shiny-validation-message" + ), + "`Select Endpoint` field is empty" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_logistic: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_logistic() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_logistic: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_logistic() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "Treatment variable must be selected" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_logistic: Selecting cov_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_logistic() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("cov_var-dataset_ADRS_singleextract-select", c("AGE", "BMRKR1")) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_logistic: Deselection of cov_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_logistic() + app_driver$set_active_module_input("cov_var-dataset_ADRS_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("cov_var-dataset_ADRS_singleextract-select_input .shiny-validation-message"), + "`Covariates` field is empty" + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_mult_events.R b/tests/testthat/test-shinytest2-tm_t_mult_events.R new file mode 100644 index 0000000000..00555591a1 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_mult_events.R @@ -0,0 +1,157 @@ +app_driver_tm_t_mult_events <- function() { + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- teal.data::rADSL + ADCM <- teal.data::rADCM + }) + + datanames <- c("ADSL", "ADCM") + teal.data::datanames(data) <- datanames + keys <- teal.data::default_cdisc_join_keys[datanames] + keys["ADCM", "ADCM"] <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4") + teal.data::join_keys(data) <- keys + + init_teal_app_driver( + data = data, + modules = tm_t_mult_events( + label = "Concomitant Medications by Medication Class and Preferred Name", + dataname = "ADCM", + parentname = "ADSL", + arm_var = teal.transform::choices_selected(c("ARM", "ARMCD"), "ARM"), + seq_var = teal.transform::choices_selected("CMSEQ", selected = "CMSEQ", fixed = TRUE), + hlt = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADCM"]], c("ATC1", "ATC2", "ATC3", "ATC4")), + selected = c("ATC1", "ATC2", "ATC3", "ATC4") + ), + llt = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADCM"]], c("CMDECOD")), + selected = c("CMDECOD") + ), + add_total = TRUE, + event_type = "treatment", + total_label = default_total_label(), + na_level = default_na_str(), + drop_arm_levels = TRUE, + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that("e2e - tm_t_mult_events: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_mult_events() + 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_t_mult_events: Starts with specified label, arm_var, hlt, llt, add_total, drop_arm_levels.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_mult_events() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Concomitant Medications by Medication Class and Preferred Name" + ) + 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("hlt-dataset_ADCM_singleextract-select"), + c("ATC1", "ATC2", "ATC3", "ATC4") + ) + testthat::expect_equal( + app_driver$get_active_module_input("llt-dataset_ADCM_singleextract-select"), + "CMDECOD" + ) + testthat::expect_true(app_driver$get_active_module_input("add_total")) + testthat::expect_true(app_driver$get_active_module_input("drop_arm_levels")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_mult_events: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_mult_events() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_mult_events: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_mult_events() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "Please select a treatment variable" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_mult_events: Selecting hlt changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_mult_events() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("hlt-dataset_ADCM_singleextract-select", c("ATC1", "ATC2")) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_mult_events: Deselection of hlt changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_mult_events() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("hlt-dataset_ADCM_singleextract-select", NULL) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_mult_events: Deselection of llt throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_mult_events() + app_driver$set_active_module_input("llt-dataset_ADCM_singleextract-select", NULL) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("llt-dataset_ADCM_singleextract-select_input .shiny-validation-message"), + "Please select a \"LOW LEVEL TERM\" variable" + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_pp_basic_info.R b/tests/testthat/test-shinytest2-tm_t_pp_basic_info.R new file mode 100644 index 0000000000..9602b061c8 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_pp_basic_info.R @@ -0,0 +1,130 @@ +app_driver_tm_t_pp_basic_info <- function() { + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- teal.data::rADSL + }) + teal.data::datanames(data) <- "ADSL" + teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys["ADSL"] + + init_teal_app_driver( + data = data, + modules = tm_t_pp_basic_info( + label = "Basic Info", + dataname = "ADSL", + patient_col = "USUBJID", + vars = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADSL"]]), + selected = c("ARM", "AGE", "SEX", "COUNTRY", "RACE", "EOSSTT") + ), + pre_output = NULL, + post_output = NULL + ) + ) +} + +testthat::test_that("e2e - tm_t_pp_basic_info: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_basic_info() + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() + testthat::expect_true( + app_driver$is_visible(app_driver$active_module_element("basic_info_table")) + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_t_pp_basic_info: Starts with specified label, patient_id, vars.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_basic_info() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Basic Info" + ) + testthat::expect_equal( + app_driver$get_active_module_input("patient_id"), + "AB12345-CHN-3-id-128" + ) + testthat::expect_equal( + app_driver$get_active_module_input("vars-dataset_ADSL_singleextract-select"), + c("AGE", "SEX", "RACE", "COUNTRY", "ARM", "EOSSTT") + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_basic_info: Selecting patient_id changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_basic_info() + table_before <- app_driver$get_active_module_table_output("basic_info_table") + app_driver$set_active_module_input("patient_id", "AB12345-USA-1-id-261") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("basic_info_table") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_pp_basic_info: Deselection of patient_id throws validation error and table is not visible.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_basic_info() + app_driver$set_active_module_input("patient_id", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("basic_info_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("patient_id_input .shiny-validation-message"), + "Please select a patient" + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_pp_basic_info: Selecting cov_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_basic_info() + table_before <- app_driver$get_active_module_table_output("basic_info_table") + app_driver$set_active_module_input( + "vars-dataset_ADSL_singleextract-select", + c("AGE", "BMRKR1") + ) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("basic_info_table") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_basic_info: Deselection of cov_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_basic_info() + app_driver$set_active_module_input("vars-dataset_ADSL_singleextract-select", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("basic_info_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("vars-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "Please select basic info variables" + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_pp_laboratory.R b/tests/testthat/test-shinytest2-tm_t_pp_laboratory.R new file mode 100644 index 0000000000..c1ed3bcaf1 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_pp_laboratory.R @@ -0,0 +1,370 @@ +app_driver_tm_t_pp_laboratory <- function() { + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- teal.data::rADSL + ADLB <- teal.data::rADLB + }) + + datanames <- c("ADSL", "ADLB") + 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_t_pp_laboratory( + label = "Vitals", + dataname = "ADLB", + parentname = "ADSL", + patient_col = "USUBJID", + paramcd = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], c("PARAMCD", "STUDYID")), + selected = "PARAMCD" + ), + param = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], c("PARAM", "SEX")), + selected = "PARAM" + ), + timepoints = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], c("ADY", "AGE")), + selected = "ADY" + ), + anrind = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], c("ANRIND", "AGEU")), + selected = "ANRIND" + ), + aval_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], c("AVAL", "AGE")), + selected = "AVAL" + ), + avalu_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], c("AVALU", "SEX")), + selected = "AVALU" + ), + pre_output = NULL, + post_output = NULL + ) + ) +} + +testthat::test_that("e2e - tm_t_pp_laboratory: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() + testthat::expect_true( + app_driver$is_visible(app_driver$active_module_element("lab_values_table")) + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Starts with specified label, patient_id, paramcd, param, + timepoints, aval_var, avalu_var, anrind, round_value.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Vitals" + ) + testthat::expect_equal( + app_driver$get_active_module_input("patient_id"), + "AB12345-CHN-3-id-128" + ) + testthat::expect_equal( + app_driver$get_active_module_input("paramcd-dataset_ADLB_singleextract-select"), + "PARAMCD" + ) + testthat::expect_equal( + app_driver$get_active_module_input("param-dataset_ADLB_singleextract-select"), + "PARAM" + ) + testthat::expect_equal( + app_driver$get_active_module_input("timepoints-dataset_ADLB_singleextract-select"), + "ADY" + ) + testthat::expect_equal( + app_driver$get_active_module_input("aval_var-dataset_ADLB_singleextract-select"), + "AVAL" + ) + testthat::expect_equal( + app_driver$get_active_module_input("avalu_var-dataset_ADLB_singleextract-select"), + "AVALU" + ) + testthat::expect_equal( + app_driver$get_active_module_input("anrind-dataset_ADLB_singleextract-select"), + "ANRIND" + ) + testthat::expect_equal( + app_driver$get_active_module_input("round_value"), + "4" + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Selecting patient_id changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + table_before <- app_driver$get_active_module_table_output("lab_values_table", which = 2) + app_driver$set_active_module_input("patient_id", "AB12345-USA-1-id-261") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("lab_values_table", which = 2) + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_laboratory: Deselection of patient_id throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$set_active_module_input("patient_id", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("lab_values_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("patient_id_input .shiny-validation-message"), + "Please select a patient" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Selecting paramcd changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + table_before <- app_driver$get_active_module_table_output("lab_values_table", which = 2) + app_driver$set_active_module_input("paramcd-dataset_ADLB_singleextract-select", "STUDYID") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("lab_values_table", which = 2) + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_laboratory: Deselection of paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$set_active_module_input("paramcd-dataset_ADLB_singleextract-select", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("lab_values_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("paramcd-dataset_ADLB_singleextract-select_input .shiny-validation-message"), + "Please select PARAMCD variable." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Selecting param changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + table_before <- app_driver$get_active_module_table_output("lab_values_table", which = 2) + app_driver$set_active_module_input("param-dataset_ADLB_singleextract-select", "SEX") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("lab_values_table", which = 2) + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Deselection of param throws validation error.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$set_active_module_input("param-dataset_ADLB_singleextract-select", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("lab_values_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("param-dataset_ADLB_singleextract-select_input .shiny-validation-message"), + "Please select PARAM variable." + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Selecting timepoints changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + table_before <- app_driver$get_active_module_table_output("lab_values_table", which = 2) + app_driver$set_active_module_input("timepoints-dataset_ADLB_singleextract-select", "AGE") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("lab_values_table", which = 2) + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_laboratory: Deselection of timepoints throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$set_active_module_input("timepoints-dataset_ADLB_singleextract-select", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("lab_values_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "timepoints-dataset_ADLB_singleextract-select_input .shiny-validation-message" + ), + "Please select timepoints variable." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Selecting avalu changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + table_before <- app_driver$get_active_module_table_output("lab_values_table", which = 2) + app_driver$set_active_module_input("avalu_var-dataset_ADLB_singleextract-select", "SEX") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("lab_values_table", which = 2) + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_laboratory: Deselection of avalu throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$set_active_module_input("avalu_var-dataset_ADLB_singleextract-select", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("lab_values_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "avalu_var-dataset_ADLB_singleextract-select_input .shiny-validation-message" + ), + "Please select AVALU variable." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Selecting aval_var changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + table_before <- app_driver$get_active_module_table_output("lab_values_table", which = 2) + app_driver$set_active_module_input("aval_var-dataset_ADLB_singleextract-select", "AGE") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("lab_values_table", which = 2) + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_laboratory: Deselection of aval_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$set_active_module_input("aval_var-dataset_ADLB_singleextract-select", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("lab_values_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("aval_var-dataset_ADLB_singleextract-select_input .shiny-validation-message"), + "Please select AVAL variable." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_laboratory: Selecting arind changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + table_before <- app_driver$get_active_module_table_output("lab_values_table", which = 2) + app_driver$set_active_module_input("anrind-dataset_ADLB_singleextract-select", "AGEU") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("lab_values_table", which = 2) + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_laboratory: Deselection of arind throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_laboratory() + app_driver$set_active_module_input("anrind-dataset_ADLB_singleextract-select", NULL) + testthat::expect_false( + app_driver$is_visible( + app_driver$active_module_element("lab_values_table"), + visibility_property = TRUE + ) + ) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("anrind-dataset_ADLB_singleextract-select_input .shiny-validation-message"), + "Please select ANRIND variable." + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_pp_medical_history.R b/tests/testthat/test-shinytest2-tm_t_pp_medical_history.R new file mode 100644 index 0000000000..ba4569773b --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_pp_medical_history.R @@ -0,0 +1,201 @@ +app_driver_tm_t_pp_medical_history <- function() { # nolint: object_length + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- tmc_ex_adsl + ADMH <- tmc_ex_admh + }) + datanames <- c("ADSL", "ADMH") + 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_t_pp_medical_history( + label = "Medical History", + dataname = "ADMH", + parentname = "ADSL", + patient_col = "USUBJID", + mhterm = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADMH"]], c("MHTERM", "STUDYID")), + selected = "MHTERM" + ), + mhbodsys = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADMH"]], c("MHBODSYS", "EOSSTT")), + selected = "MHBODSYS" + ), + mhdistat = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADMH"]], c("MHDISTAT", "STUDYID")), + selected = "MHDISTAT" + ), + pre_output = NULL, + post_output = NULL + ) + ) +} + +testthat::test_that( + "e2e - tm_t_pp_medical_history: Module initializes in teal without errors and produces table output.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_medical_history() + 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_t_pp_medical_history: Starts with specified label, patient_id, mhterm, mhbodsys, mhdistat.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_medical_history() + + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Medical History" + ) + testthat::expect_equal( + app_driver$get_active_module_input("patient_id"), + "AB12345-CHN-1-id-1" + ) + testthat::expect_equal( + app_driver$get_active_module_input("mhterm-dataset_ADMH_singleextract-select"), + "MHTERM" + ) + testthat::expect_equal( + app_driver$get_active_module_input("mhbodsys-dataset_ADMH_singleextract-select"), + "MHBODSYS" + ) + testthat::expect_equal( + app_driver$get_active_module_input("mhdistat-dataset_ADMH_singleextract-select"), + "MHDISTAT" + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_pp_medical_history: Selecting patient_id changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_medical_history() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("patient_id", "AB12345-USA-1-id-45") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_medical_history: Deselection of patient_id throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_medical_history() + app_driver$set_active_module_input("patient_id", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("patient_id_input .shiny-validation-message"), + "Please select a patient" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_medical_history: Selecting mhterm changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_medical_history() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("mhterm-dataset_ADMH_singleextract-select", "STUDYID") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_medical_history: Deselection of mhterm throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_medical_history() + app_driver$set_active_module_input("mhterm-dataset_ADMH_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("mhterm-dataset_ADMH_singleextract-select_input .shiny-validation-message"), + "Please select MHTERM variable." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_medical_history: Selecting mhbodsys changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_medical_history() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("mhbodsys-dataset_ADMH_singleextract-select", "EOSSTT") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_medical_history: Deselection of mhbodsys throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_medical_history() + app_driver$set_active_module_input("mhbodsys-dataset_ADMH_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("mhbodsys-dataset_ADMH_singleextract-select_input .shiny-validation-message"), + "Please select MHBODSYS variable." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_medical_history: Selecting mhbodsys changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_medical_history() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("mhdistat-dataset_ADMH_singleextract-select", "STUDYID") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_medical_history: Deselection of mhdistat throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_medical_history() + app_driver$set_active_module_input("mhdistat-dataset_ADMH_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("mhdistat-dataset_ADMH_singleextract-select_input .shiny-validation-message"), + "Please select MHDISTAT variable." + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_pp_prior_medication.R b/tests/testthat/test-shinytest2-tm_t_pp_prior_medication.R new file mode 100644 index 0000000000..fe943d2ed5 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_pp_prior_medication.R @@ -0,0 +1,242 @@ +app_driver_tm_t_pp_prior_medication <- function() { # nolint: object_length + data <- teal.data::teal_data() + data <- within(data, { + library(dplyr) + ADCM <- teal.data::rADCM + ADSL <- teal.data::rADSL %>% + filter(USUBJID %in% ADCM$USUBJID) + ADCM$CMASTDTM <- ADCM$ASTDTM + ADCM$CMAENDTM <- ADCM$AENDTM + }) + + datanames <- c("ADSL", "ADCM") + teal.data::datanames(data) <- datanames + keys <- teal.data::default_cdisc_join_keys[datanames] + keys["ADCM", "ADCM"] <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4") + teal.data::join_keys(data) <- keys + + init_teal_app_driver( + data = data, + modules = tm_t_pp_prior_medication( + label = "Prior Medication", + dataname = "ADCM", + parentname = "ADSL", + patient_col = "USUBJID", + atirel = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADCM"]], c("ATIREL", "SEX")), + selected = "ATIREL" + ), + cmdecod = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADCM"]], c("CMDECOD", "RACE")), + selected = "CMDECOD" + ), + cmindc = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADCM"]], c("CMINDC", "SEX")), + selected = "CMINDC" + ), + cmstdy = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADCM"]], c("ASTDY", "AGE")), + selected = "ASTDY" + ), + pre_output = NULL, + post_output = NULL + ) + ) +} + +testthat::test_that( + "e2e - tm_t_pp_prior_medication: Module initializes in teal without errors and produces table output.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_prior_medication() + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() + testthat::expect_true( + app_driver$is_visible(app_driver$active_module_element("prior_medication_table")) + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_pp_prior_medication: Starts with specified label, patient_id, cmdecod, atirel, cmindc, cmstdy.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_prior_medication() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Prior Medication" + ) + testthat::expect_equal( + app_driver$get_active_module_input("patient_id"), + "AB12345-CHN-3-id-128" + ) + testthat::expect_equal( + app_driver$get_active_module_input("cmdecod-dataset_ADCM_singleextract-select"), + "CMDECOD" + ) + testthat::expect_equal( + app_driver$get_active_module_input("atirel-dataset_ADCM_singleextract-select"), + "ATIREL" + ) + testthat::expect_equal( + app_driver$get_active_module_input("cmindc-dataset_ADCM_singleextract-select"), + "CMINDC" + ) + testthat::expect_equal( + app_driver$get_active_module_input("cmstdy-dataset_ADCM_singleextract-select"), + "ASTDY" + ) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_pp_prior_medication: Selecting patient_id changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_prior_medication() + table_before <- app_driver$get_active_module_table_output("prior_medication_table") + app_driver$set_active_module_input("patient_id", "AB12345-USA-1-id-261") + testthat::expect_false( + identical( + nrow(table_before), + nrow(app_driver$get_active_module_table_output("prior_medication_table")) + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_prior_medication: Deselection of patient_id throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_prior_medication() + app_driver$set_active_module_input("patient_id", NULL) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("patient_id_input .shiny-validation-message"), + "Please select patient id" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_prior_medication: Selecting cmdecod changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_prior_medication() + table_before <- app_driver$get_active_module_table_output("prior_medication_table") + app_driver$set_active_module_input("cmdecod-dataset_ADCM_singleextract-select", "RACE") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("prior_medication_table") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_prior_medication: Deselection of cmdecod throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_prior_medication() + app_driver$set_active_module_input("cmdecod-dataset_ADCM_singleextract-select", NULL) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("cmdecod-dataset_ADCM_singleextract-select_input .shiny-validation-message"), + "A medication decoding variable is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_prior_medication: Selecting atirel changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_prior_medication() + table_before <- app_driver$get_active_module_table_output("prior_medication_table") + app_driver$set_active_module_input("atirel-dataset_ADCM_singleextract-select", "SEX") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("prior_medication_table") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_prior_medication: Deselection of atirel throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_prior_medication() + app_driver$set_active_module_input("atirel-dataset_ADCM_singleextract-select", NULL) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("atirel-dataset_ADCM_singleextract-select_input .shiny-validation-message"), + "An ATIREL variable is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_prior_medication: Selecting cmindc changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_prior_medication() + table_before <- app_driver$get_active_module_table_output("prior_medication_table") + app_driver$set_active_module_input("cmindc-dataset_ADCM_singleextract-select", "SEX") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("prior_medication_table") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_prior_medication: Deselection of cmindc throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_prior_medication() + app_driver$set_active_module_input("cmindc-dataset_ADCM_singleextract-select", NULL) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("cmindc-dataset_ADCM_singleextract-select_input .shiny-validation-message"), + "A CMINDC variable is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_pp_prior_medication: Selecting cmstdy changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_prior_medication() + table_before <- app_driver$get_active_module_table_output("prior_medication_table") + app_driver$set_active_module_input("cmstdy-dataset_ADCM_singleextract-select", "AGE") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("prior_medication_table") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_pp_prior_medication: Deselection of cmstdy throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_pp_prior_medication() + app_driver$set_active_module_input("cmstdy-dataset_ADCM_singleextract-select", NULL) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("cmstdy-dataset_ADCM_singleextract-select_input .shiny-validation-message"), + "A CMSTDY variable is required" + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_shift_by_arm.R b/tests/testthat/test-shinytest2-tm_t_shift_by_arm.R new file mode 100644 index 0000000000..ab0fbd8008 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_shift_by_arm.R @@ -0,0 +1,195 @@ +app_driver_tm_t_shift_by_arm <- function() { + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- tmc_ex_adsl + ADEG <- tmc_ex_adeg + }) + + datanames <- c("ADSL", "ADEG") + 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_t_shift_by_arm( + label = "Shift by Arm Table", + dataname = "ADEG", + parentname = "ADSL", + arm_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADSL"]], subset = c("ARM", "ARMCD")), + selected = "ARM" + ), + paramcd = teal.transform::choices_selected( + teal.transform::value_choices(data[["ADEG"]], "PARAMCD"), + selected = "HR" + ), + visit_var = teal.transform::choices_selected( + teal.transform::value_choices(data[["ADEG"]], "AVISIT"), + selected = "POST-BASELINE MINIMUM" + ), + aval_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADEG"]], subset = "ANRIND"), + selected = "ANRIND", fixed = TRUE + ), + baseline_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADEG"]], subset = "BNRIND"), + selected = "BNRIND", fixed = TRUE + ), + useNA = "ifany", + treatment_flag_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADEG"]], subset = "ONTRTFL"), + selected = "ONTRTFL" + ), + treatment_flag = teal.transform::choices_selected("Y"), + na_level = default_na_str(), + add_total = FALSE, + total_label = default_total_label(), + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that("e2e - tm_t_shift_by_arm: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm() + 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_t_shift_by_arm: Starts with specified label, arm_varparamcd, visit_var, + useNA, treatment_flag_var, add_total.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Shift by Arm Table" + ) + 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("paramcd-dataset_ADEG_singleextract-filter1-vals"), + "HR" + ) + testthat::expect_equal( + app_driver$get_active_module_input("visit_var-dataset_ADEG_singleextract-filter1-vals"), + "POST-BASELINE MINIMUM" + ) + testthat::expect_equal( + app_driver$get_active_module_input("useNA"), + "ifany" + ) + testthat::expect_equal( + app_driver$get_active_module_input("treatment_flag_var-dataset_ADEG_singleextract-select"), + "ONTRTFL" + ) + testthat::expect_false(app_driver$get_active_module_input("add_total")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_shift_by_arm: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_shift_by_arm: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "A treatment variable is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_shift_by_arm: Selecting paramcd changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("paramcd-dataset_ADEG_singleextract-filter1-vals", "QT") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_shift_by_arm: Deselection of paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm() + app_driver$set_active_module_input("paramcd-dataset_ADEG_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "paramcd-dataset_ADEG_singleextract-filter1-vals_input .shiny-validation-message" + ), + "An endpoint is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_shift_by_arm: Selecting visit_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("visit_var-dataset_ADEG_singleextract-filter1-vals", "SCREENING") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_shift_by_arm: Deselection of visit_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm() + app_driver$set_active_module_input("visit_var-dataset_ADEG_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "visit_var-dataset_ADEG_singleextract-filter1-vals_input .shiny-validation-message" + ), + "A visit is required" + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_shift_by_arm_by_worst.R b/tests/testthat/test-shinytest2-tm_t_shift_by_arm_by_worst.R new file mode 100644 index 0000000000..c6c1fe95c8 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_shift_by_arm_by_worst.R @@ -0,0 +1,275 @@ +app_driver_tm_t_shift_by_arm_by_worst <- function() { # nolint: object_length + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- tmc_ex_adsl + ADEG <- tmc_ex_adeg + }) + + datanames <- c("ADSL", "ADEG") + 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_t_shift_by_arm_by_worst( + label = "Shift by Arm Table", + dataname = "ADEG", + parentname = "ADSL", + arm_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADSL"]], subset = c("ARM", "ARMCD")), + selected = "ARM" + ), + paramcd = teal.transform::choices_selected( + teal.transform::value_choices(data[["ADEG"]], "PARAMCD"), + selected = "ECGINTP" + ), + worst_flag_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADEG"]], c("WORS02FL", "WORS01FL")), + selected = "WORS02FL" + ), + worst_flag = teal.transform::choices_selected( + teal.transform::value_choices(data[["ADEG"]], "WORS02FL"), + selected = "Y", fixed = TRUE + ), + aval_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADEG"]], c("REGION1", "AVALC")), + selected = "REGION1" + ), + baseline_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADEG"]], c("AVISIT", "BASEC")), + selected = "AVISIT" + ), + useNA = "ifany", + treatment_flag = teal.transform::choices_selected("Y"), + na_level = default_na_str(), + add_total = FALSE, + total_label = default_total_label(), + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that( + "e2e - tm_t_shift_by_arm_by_worst: Module initializes in teal without errors and produces table output.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm_by_worst() + 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_t_shift_by_arm_by_worst: Starts with specified label, arm_var, paramcd, worst_flag_var, + aval_var, baseline_var, useNA, treatment_flag_var, add_total.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm_by_worst() + + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Shift by Arm Table" + ) + 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("paramcd-dataset_ADEG_singleextract-filter1-vals"), + "ECGINTP" + ) + testthat::expect_equal( + app_driver$get_active_module_input("worst_flag_var-dataset_ADEG_singleextract-select"), + "WORS02FL" + ) + testthat::expect_equal( + app_driver$get_active_module_input("aval_var-dataset_ADEG_singleextract-select"), + "REGION1" + ) + testthat::expect_equal( + app_driver$get_active_module_input("baseline_var-dataset_ADEG_singleextract-select"), + "AVISIT" + ) + testthat::expect_equal( + app_driver$get_active_module_input("useNA"), + "ifany" + ) + testthat::expect_equal( + app_driver$get_active_module_input("treatment_flag_var-dataset_ADEG_singleextract-select"), + "ONTRTFL" + ) + testthat::expect_false(app_driver$get_active_module_input("add_total")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_shift_by_arm_by_worst: Selecting arm_var changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm_by_worst() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_shift_by_arm_by_worst: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm_by_worst() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "A treatment variable is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_shift_by_arm_by_worst: Selecting paramcd changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm_by_worst() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("paramcd-dataset_ADEG_singleextract-filter1-vals", "HR") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_shift_by_arm_by_worst: Deselection of paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm_by_worst() + app_driver$set_active_module_input("paramcd-dataset_ADEG_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "paramcd-dataset_ADEG_singleextract-filter1-vals_input .shiny-validation-message" + ), + "An endpoint is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_shift_by_arm_by_worst: Selecting worst_flag changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm_by_worst() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("worst_flag_var-dataset_ADEG_singleextract-select", "WORS01FL") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_shift_by_arm_by_worst: Deselection of worst_flag throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm_by_worst() + app_driver$set_active_module_input("worst_flag_var-dataset_ADEG_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "worst_flag_var-dataset_ADEG_singleextract-select_input .shiny-validation-message" + ), + "A worst flag variable is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_shift_by_arm_by_worst: Selecting aval_var changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm_by_worst() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("aval_var-dataset_ADEG_singleextract-select", "AVALC") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_shift_by_arm_by_worst: Deselection of aval_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm_by_worst() + app_driver$set_active_module_input("aval_var-dataset_ADEG_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("aval_var-dataset_ADEG_singleextract-select_input .shiny-validation-message"), + "An analysis range indicator required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_shift_by_arm_by_worst: Selecting baseline_var changes the table + and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm_by_worst() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("baseline_var-dataset_ADEG_singleextract-select", "BASEC") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_shift_by_arm_by_worst: Deselection of baseline_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_arm_by_worst() + app_driver$set_active_module_input("baseline_var-dataset_ADEG_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "baseline_var-dataset_ADEG_singleextract-select_input .shiny-validation-message" + ), + "A baseline reference range indicator is required" + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_shift_by_grade.R b/tests/testthat/test-shinytest2-tm_t_shift_by_grade.R new file mode 100644 index 0000000000..794a3e272c --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_shift_by_grade.R @@ -0,0 +1,218 @@ +app_driver_tm_t_shift_by_grade <- function() { + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- teal.data::rADSL + ADLB <- teal.data::rADLB + }) + + datanames <- c("ADSL", "ADLB") + 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_t_shift_by_grade( + label = "Grade Laboratory Abnormality Table", + dataname = "ADLB", + parentname = "ADSL", + visit_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], subset = "AVISIT"), + selected = "AVISIT", fixed = TRUE + ), + arm_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], subset = c("ARM", "ARMCD")), + selected = "ARM" + ), + paramcd = teal.transform::choices_selected( + choices = teal.transform::value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = "ALT" + ), + worst_flag_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices( + data[["ADLB"]], + subset = c("WGRLOVFL", "WGRLOFL", "WGRHIVFL", "WGRHIFL") + ), + selected = c("WGRLOVFL") + ), + worst_flag_indicator = teal.transform::choices_selected( + teal.transform::value_choices(data[["ADLB"]], "WGRLOVFL"), + selected = "Y", fixed = TRUE + ), + anl_toxgrade_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], subset = c("ATOXGR")), + selected = c("ATOXGR"), + fixed = TRUE + ), + base_toxgrade_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], subset = c("BTOXGR")), + selected = c("BTOXGR"), + fixed = TRUE + ), + id_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], subset = "USUBJID"), + selected = "USUBJID", fixed = TRUE + ), + add_total = FALSE, + total_label = default_total_label(), + drop_arm_levels = TRUE, + pre_output = NULL, + post_output = NULL, + na_level = default_na_str(), + code_missing_baseline = FALSE, + basic_table_args = teal.widgets::basic_table_args() + ), + filter = teal::teal_slices(teal_slice("ADSL", "SAFFL", selected = "Y")) + ) +} + +testthat::test_that( + "e2e - tm_t_shift_by_grade: Module initializes in teal without errors and produces table output.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_grade() + 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_t_shift_by_grade: Starts with specified label, arm_var, paramcd, worst_flag_var, anl_toxgrade_var, + base_toxgrade_var, worst_flag_indicator, add_total, drop_arm_levels, code_missing_baseline.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_grade() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Grade Laboratory Abnormality Table" + ) + 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("paramcd-dataset_ADLB_singleextract-filter1-vals"), + "ALT" + ) + testthat::expect_equal( + app_driver$get_active_module_input("worst_flag_var-dataset_ADLB_singleextract-select"), + "WGRLOVFL" + ) + testthat::expect_equal( + app_driver$get_active_module_input("anl_toxgrade_var-dataset_ADLB_singleextract-select"), + "ATOXGR" + ) + testthat::expect_equal( + app_driver$get_active_module_input("base_toxgrade_var-dataset_ADLB_singleextract-select"), + "BTOXGR" + ) + testthat::expect_equal( + app_driver$get_active_module_input("worst_flag_indicator"), + "Y" + ) + testthat::expect_false(app_driver$get_active_module_input("add_total")) + testthat::expect_true(app_driver$get_active_module_input("drop_arm_levels")) + testthat::expect_false(app_driver$get_active_module_input("code_missing_baseline")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_shift_by_grade: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_grade() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_shift_by_grade: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_grade() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "A treatment variable is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_shift_by_grade: Selecting paramcd changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_grade() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("paramcd-dataset_ADLB_singleextract-filter1-vals", "CRP") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_shift_by_grade: Deselection of paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_grade() + app_driver$set_active_module_input("paramcd-dataset_ADLB_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "paramcd-dataset_ADLB_singleextract-filter1-vals_input .shiny-validation-message" + ), + "A laboratory parameter is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_shift_by_grade: Selecting worst_flag changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_grade() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("worst_flag_var-dataset_ADLB_singleextract-select", "WGRLOFL") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_shift_by_grade: Deselection of worst_flag throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_shift_by_grade() + app_driver$set_active_module_input("worst_flag_var-dataset_ADLB_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "worst_flag_var-dataset_ADLB_singleextract-select_input .shiny-validation-message" + ), + "A worst treatment flag is required" + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_smq.R b/tests/testthat/test-shinytest2-tm_t_smq.R new file mode 100644 index 0000000000..4c14aa965e --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_smq.R @@ -0,0 +1,189 @@ +app_driver_tm_t_smq <- function() { + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- teal.data::rADSL + ADAE <- teal.data::rADAE + + names_baskets <- grep("^(SMQ|CQ).*NAM$", names(ADAE), value = TRUE) + names_scopes <- grep("^SMQ.*SC$", names(ADAE), value = TRUE) + + cs_baskets <- choices_selected( + choices = teal.transform::variable_choices(ADAE, subset = names_baskets), + selected = names_baskets + ) + + cs_scopes <- choices_selected( + choices = teal.transform::variable_choices(ADAE, subset = names_scopes), + selected = names_scopes, + fixed = TRUE + ) + }) + + datanames <- c("ADSL", "ADAE") + 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_t_smq( + label = "Adverse Events by SMQ Table", + dataname = "ADAE", + parentname = "ADSL", + arm_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADSL"]], subset = c("ARM", "SEX")), + selected = "ARM" + ), + id_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADSL"]], subset = "USUBJID"), + selected = "USUBJID", fixed = TRUE + ), + add_total = FALSE, + total_label = default_total_label(), + sort_criteria = c("freq_desc", "alpha"), + drop_arm_levels = TRUE, + na_level = default_na_str(), + smq_varlabel = "Standardized MedDRA Query", + baskets = data[["cs_baskets"]], + scopes = data[["cs_scopes"]], + llt = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADAE"]], subset = c("AEDECOD", "SEX")), + selected = "AEDECOD" + ), + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that("e2e - tm_t_smq: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_smq() + 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_t_smq: Starts with specified label, arm_var, llt, baskets, sort_criteria, add_total, drop_arm_levels.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_smq() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Adverse Events by SMQ Table" + ) + 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("llt-dataset_ADAE_singleextract-select"), + "AEDECOD" + ) + testthat::expect_equal( + app_driver$get_active_module_input("baskets-dataset_ADAE_singleextract-select"), + c("SMQ01NAM", "SMQ02NAM", "CQ01NAM") + ) + testthat::expect_equal( + app_driver$get_active_module_input("sort_criteria"), + "freq_desc" + ) + testthat::expect_false(app_driver$get_active_module_input("add_total")) + testthat::expect_true(app_driver$get_active_module_input("drop_arm_levels")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_smq: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_smq() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "SEX") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_smq: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_smq() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "At least one treatment variable is required" + ) + app_driver$stop() +}) + +testthat::test_that("e2e - tm_t_smq: Selecting paramcd changes the table and does not throw validation errors.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_smq() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("llt-dataset_ADAE_singleextract-select", "SEX") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() +}) + +testthat::test_that("e2e - tm_t_smq: Deselection of paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_smq() + app_driver$set_active_module_input("llt-dataset_ADAE_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("llt-dataset_ADAE_singleextract-select_input .shiny-validation-message"), + "A low level term variable is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_smq: Selecting worst_flag changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_smq() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("baskets-dataset_ADAE_singleextract-select", "CQ01NAM") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_smq: Deselection of worst_flag throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_smq() + app_driver$set_active_module_input("baskets-dataset_ADAE_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("baskets-dataset_ADAE_singleextract-select_input .shiny-validation-message"), + "At least one basket is required" + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_summary.R b/tests/testthat/test-shinytest2-tm_t_summary.R new file mode 100644 index 0000000000..77a411c727 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_summary.R @@ -0,0 +1,137 @@ +app_driver_tm_t_summary <- function() { + data <- teal.data::teal_data() %>% + within({ + ADSL <- teal.data::rADSL + ADSL$EOSDY[1] <- NA_integer_ + }) + teal.data::datanames(data) <- "ADSL" + teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys["ADSL"] + + init_teal_app_driver( + data = data, + modules = tm_t_summary( + label = "Demographic Table", + dataname = "ADSL", + arm_var = teal.transform::choices_selected(c("ARM", "ARMCD"), "ARM"), + add_total = TRUE, + summarize_vars = teal.transform::choices_selected( + c("SEX", "RACE", "BMRKR2", "EOSDY", "DCSREAS", "AGE"), + c("SEX", "RACE") + ), + useNA = "ifany", + parentname = "ADSL", + total_label = default_total_label(), + na_level = default_na_str(), + numeric_stats = c( + "n", "mean_sd", "mean_ci", "median", "median_ci", "quantiles", + "range", "geom_mean" + ), + denominator = c("N", "n", "omit"), + drop_arm_levels = TRUE, + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that("e2e - tm_t_summary: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary() + 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_t_summary: Starts with specified label, arm_var, summarize_vars, useNA, denominator.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Demographic Table" + ) + 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("summarize_vars-dataset_ADSL_singleextract-select"), + c("SEX", "RACE") + ) + testthat::expect_equal( + app_driver$get_active_module_input("useNA"), + "ifany" + ) + testthat::expect_equal( + app_driver$get_active_module_input("denominator"), + "N" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_summary: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_summary: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "Please select 1 or 2 column variables" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_summary: Selecting summarize_vars changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("summarize_vars-dataset_ADSL_singleextract-select", c("SEX", "AGE")) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_summary: Deselection of summarize_vars throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary() + app_driver$set_active_module_input("summarize_vars-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "summarize_vars-dataset_ADSL_singleextract-select_input .shiny-validation-message" + ), + "Please select a summarize variable" + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_summary_by.R b/tests/testthat/test-shinytest2-tm_t_summary_by.R new file mode 100644 index 0000000000..47038a4c9f --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_summary_by.R @@ -0,0 +1,241 @@ +app_driver_tm_t_summary_by <- function() { + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- teal.data::rADSL + ADLB <- teal.data::rADLB + }) + + datanames <- c("ADSL", "ADLB") + 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_t_summary_by( + label = "Summary by Row Groups Table", + dataname = "ADLB", + parentname = "ADSL", + arm_var = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADSL"]], c("ARM", "ARMCD")), + selected = "ARM" + ), + add_total = TRUE, + by_vars = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], c("PARAM", "AVISIT")), + selected = c("AVISIT") + ), + summarize_vars = teal.transform::choices_selected( + choices = teal.transform::variable_choices(data[["ADLB"]], c("AVAL", "CHG")), + selected = c("AVAL") + ), + useNA = "ifany", + paramcd = teal.transform::choices_selected( + choices = teal.transform::value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = "ALT" + ), + id_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADLB"]], subset = "USUBJID"), + selected = "USUBJID", fixed = TRUE + ), + total_label = default_total_label(), + parallel_vars = FALSE, + row_groups = FALSE, + na_level = default_na_str(), + numeric_stats = c("n", "mean_sd", "median", "range"), + denominator = teal.transform::choices_selected(c("n", "N", "omit"), "omit", + fixed = TRUE + ), + drop_arm_levels = TRUE, + drop_zero_levels = TRUE, + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that("e2e - tm_t_summary_by: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary_by() + 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_t_summary_by: Starts with specified label, arm_var, paramcd, by_vars, summarize_vars, + useNA, numeric_stats, add_total, parallel_vars, row_groups, drop_zero_levels.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary_by() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Summary by Row Groups Table" + ) + 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("paramcd-dataset_ADLB_singleextract-filter1-vals"), + "ALT" + ) + testthat::expect_equal( + app_driver$get_active_module_input("by_vars-dataset_ADLB_singleextract-select"), + "AVISIT" + ) + testthat::expect_equal( + app_driver$get_active_module_input("summarize_vars-dataset_ADLB_singleextract-select"), + "AVAL" + ) + testthat::expect_equal( + app_driver$get_active_module_input("useNA"), + "ifany" + ) + testthat::expect_equal( + app_driver$get_active_module_input("numeric_stats"), + c("n", "mean_sd", "median", "range") + ) + testthat::expect_true(app_driver$get_active_module_input("add_total")) + testthat::expect_false(app_driver$get_active_module_input("parallel_vars")) + testthat::expect_false(app_driver$get_active_module_input("row_groups")) + testthat::expect_true(app_driver$get_active_module_input("drop_zero_levels")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_summary_by: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary_by() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_summary_by: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary_by() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message"), + "Please select 1 or 2 column variables" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_summary_by: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary_by() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("paramcd-dataset_ADLB_singleextract-filter1-vals", "CRP") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_summary_by: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary_by() + app_driver$set_active_module_input("paramcd-dataset_ADLB_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "paramcd-dataset_ADLB_singleextract-filter1-vals_input .shiny-validation-message" + ), + "Please select a filter." + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_summary_by: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary_by() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("by_vars-dataset_ADLB_singleextract-select", "PARAM") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_summary_by: Deselection of arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary_by() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("by_vars-dataset_ADLB_singleextract-select", NULL) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_summary_by: Selecting summarize_vars changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary_by() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("summarize_vars-dataset_ADLB_singleextract-select", "CHG") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_summary_by: Deselection of summarize_vars throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_summary_by() + app_driver$set_active_module_input("summarize_vars-dataset_ADLB_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "summarize_vars-dataset_ADLB_singleextract-select_input .shiny-validation-message" + ), + "Please select a summarize variable." + ) + app_driver$stop() +}) diff --git a/tests/testthat/test-shinytest2-tm_t_tte.R b/tests/testthat/test-shinytest2-tm_t_tte.R new file mode 100644 index 0000000000..6d43f47770 --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_t_tte.R @@ -0,0 +1,257 @@ +app_driver_tm_t_tte <- function() { + data <- teal.data::teal_data() + data <- within(data, { + ADSL <- teal.data::rADSL + ADTTE <- teal.data::rADTTE + }) + + 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( + ACTARMCD = list( + ref = "ARM B", + comp = c("ARM A", "ARM C") + ), + ARM = list( + ref = "B: Placebo", + comp = c("A: Drug X", "C: Combination") + ) + ) + + init_teal_app_driver( + data = data, + modules = tm_t_tte( + label = "Time To Event Table", + dataname = "ADTTE", + parentname = "ADSL", + arm_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADSL"]], c("ARM", "ARMCD", "ACTARMCD")), + "ARM" + ), + arm_ref_comp = arm_ref_comp, + paramcd = teal.transform::choices_selected( + teal.transform::value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), + "OS" + ), + strata_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADSL"]], c("SEX", "BMRKR2")), + "SEX" + ), + time_points = teal.transform::choices_selected(c(182, 243), 182), + event_desc_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADTTE"]], "EVNTDESC"), + "EVNTDESC", + fixed = TRUE + ), + aval_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADTTE"]], "AVAL"), "AVAL", + fixed = TRUE + ), + cnsr_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADTTE"]], "CNSR"), "CNSR", + fixed = TRUE + ), + conf_level_coxph = teal.transform::choices_selected( + c(0.95, 0.9, 0.8), 0.95, + keep_order = TRUE + ), + conf_level_survfit = teal.transform::choices_selected( + c(0.95, 0.9, 0.8), 0.95, + keep_order = TRUE + ), + time_unit_var = teal.transform::choices_selected( + teal.transform::variable_choices(data[["ADTTE"]], "AVALU"), "AVALU", + fixed = TRUE + ), + add_total = FALSE, + total_label = default_total_label(), + na_level = default_na_str(), + pre_output = NULL, + post_output = NULL, + basic_table_args = teal.widgets::basic_table_args() + ) + ) +} + +testthat::test_that("e2e - tm_t_tte: Module initializes in teal without errors and produces table output.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_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("table-table-with-settings")) + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_tte: Starts with specified label, paramcd, event_desc_var, arm_var, buckets, + strata_var, time_points, pval_method_coxph, ties_coxph, conf_level_coxph, + conf_level_survfit, conf_type_survfit, probs_survfit, compare_arms, combine_comp_arms.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_tte() + testthat::expect_equal( + app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), + "Time To Event Table" + ) + testthat::expect_equal( + app_driver$get_active_module_input("paramcd-dataset_ADTTE_singleextract-filter1-vals"), + "OS" + ) + testthat::expect_equal( + app_driver$get_active_module_input("event_desc_var-dataset_ADTTE_singleextract-select"), + "EVNTDESC" + ) + 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("buckets"), + list( + Ref = list("B: Placebo"), + Comp = list("A: Drug X", "C: Combination") + ) + ) + testthat::expect_equal( + app_driver$get_active_module_input("strata_var-dataset_ADSL_singleextract-select"), + "SEX" + ) + testthat::expect_equal( + app_driver$get_active_module_input("time_points"), + "182" + ) + testthat::expect_equal( + app_driver$get_active_module_input("pval_method_coxph"), + "log-rank" + ) + testthat::expect_equal( + app_driver$get_active_module_input("ties_coxph"), + "exact" + ) + testthat::expect_equal( + app_driver$get_active_module_input("conf_level_coxph"), + "0.95" + ) + testthat::expect_equal( + app_driver$get_active_module_input("conf_level_survfit"), + "0.95" + ) + testthat::expect_equal( + app_driver$get_active_module_input("conf_type_survfit"), + "plain" + ) + testthat::expect_equal( + app_driver$get_active_module_input("probs_survfit"), + c(0.25, 0.75) + ) + testthat::expect_true(app_driver$get_active_module_input("compare_arms")) + testthat::expect_false(app_driver$get_active_module_input("combine_comp_arms")) + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_tte: Selecting paramcd changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_tte() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("paramcd-dataset_ADTTE_singleextract-filter1-vals", "CRSD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_tte: Deselection of paramcd throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_tte() + app_driver$set_active_module_input("paramcd-dataset_ADTTE_singleextract-filter1-vals", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "paramcd-dataset_ADTTE_singleextract-filter1-vals_input .shiny-validation-message" + ), + "An endpoint is required" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_tte: Selecting arm_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_tte() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that("e2e - tm_t_tte: Deselection of arm_var throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_tte() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_identical(app_driver$get_active_module_table_output("table-table-with-settings"), data.frame()) + app_driver$expect_validation_error() + testthat::expect_equal( + app_driver$active_module_element_text( + "arm_var-dataset_ADSL_singleextract-select_input .shiny-validation-message" + ), + "Treatment variable must be selected" + ) + app_driver$stop() +}) + +testthat::test_that( + "e2e - tm_t_tte: Selecting strata_var changes the table and does not throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_tte() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("strata_var-dataset_ADSL_singleextract-select", "BMRKR2") + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +) + +testthat::test_that( + "e2e - tm_t_tte: Deselection of strata_var changes the table and throw validation errors.", + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_t_tte() + table_before <- app_driver$get_active_module_table_output("table-table-with-settings") + app_driver$set_active_module_input("strata_var-dataset_ADSL_singleextract-select", NULL) + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_table_output("table-table-with-settings") + ) + ) + app_driver$expect_no_validation_error() + app_driver$stop() + } +)