Skip to content

Commit

Permalink
Wave 1 - tm_a_gee shinytests (#1127)
Browse files Browse the repository at this point in the history
Part of #1108 

We can move `active_module_tws_output` to be a method of
`teal:::TealAppDriver`

---------

Signed-off-by: Marcin <[email protected]>
Co-authored-by: kartikeya kirar <[email protected]>
  • Loading branch information
m7pr and kartikeyakirar authored Apr 25, 2024
1 parent a9b4008 commit 79a849c
Show file tree
Hide file tree
Showing 3 changed files with 297 additions and 1 deletion.
2 changes: 2 additions & 0 deletions .github/workflows/check.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -10,9 +10,11 @@ on:
- ready_for_review
branches:
- main
- shinytest2@main
push:
branches:
- main
- shinytest2@main
workflow_dispatch:

jobs:
Expand Down
2 changes: 1 addition & 1 deletion R/tm_a_gee.R
Original file line number Diff line number Diff line change
Expand Up @@ -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(
Expand Down
294 changes: 294 additions & 0 deletions tests/testthat/test-shinytest2-tm_a_gee.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,294 @@
app_driver_tm_a_gee <- function() {
data <- teal.data::teal_data()
data <- within(data, {
library(dplyr)
ADSL <- tmc_ex_adsl
ADQS <- tmc_ex_adqs %>%
filter(ABLFL != "Y" & ABLFL2 != "Y") %>%
mutate(
AVISIT = as.factor(AVISIT),
AVISITN = rank(AVISITN) %>%
as.factor() %>%
as.numeric() %>%
as.factor(),
AVALBIN = AVAL < 50 # Just as an example to get a binary endpoint.
) %>%
droplevels()
})
datanames <- c("ADSL", "ADQS")
teal.data::datanames(data) <- datanames
teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[datanames]

init_teal_app_driver(
data = data,
modules = tm_a_gee(
label = "GEE",
dataname = "ADQS",
aval_var = teal.transform::choices_selected("AVALBIN", fixed = TRUE),
id_var = teal.transform::choices_selected(c("USUBJID", "SUBJID"), "USUBJID"),
arm_var = teal.transform::choices_selected(c("ARM", "ARMCD"), "ARM"),
visit_var = teal.transform::choices_selected(c("AVISIT", "AVISITN"), "AVISIT"),
paramcd = teal.transform::choices_selected(
choices = teal.transform::value_choices(data[["ADQS"]], "PARAMCD", "PARAM"),
selected = "FKSI-FWB"
),
cov_var = teal.transform::choices_selected(c("BASE", "AGE", "SEX", "BASE:AVISIT"), NULL),
conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8, -1), 0.95, keep_order = TRUE)
)
)
}

testthat::test_that("e2e - tm_a_gee: Module initializes in teal without errors and produces table output.", {
skip_if_too_deep(5)

app_driver <- app_driver_tm_a_gee()
app_driver$expect_no_shiny_error()
app_driver$expect_no_validation_error()
testthat::expect_true(app_driver$is_visible(app_driver$active_module_element("table-table-with-settings")))
app_driver$stop()
})

testthat::test_that(
"e2e - tm_a_gee: Starts with specified label, id_var, arm_var, visit_var, paramcd, cov_var,
conf_level and conf_struct.",
{
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()

testthat::expect_equal(
app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"),
"GEE"
)

testthat::expect_equal(
app_driver$get_active_module_input("aval_var-dataset_ADQS_singleextract-select"),
"AVALBIN"
)

testthat::expect_equal(
app_driver$get_active_module_input("id_var-dataset_ADQS_singleextract-select"),
"USUBJID"
)

testthat::expect_equal(
app_driver$get_active_module_input("arm_var-dataset_ADSL_singleextract-select"),
"ARM"
)

testthat::expect_equal(
app_driver$get_active_module_input("visit_var-dataset_ADQS_singleextract-select"),
"AVISIT"
)
testthat::expect_equal(
app_driver$get_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals"),
"FKSI-FWB"
)

testthat::expect_equal(
app_driver$get_active_module_input("cov_var-dataset_ADQS_singleextract-select"),
NULL
)

testthat::expect_equal(app_driver$get_active_module_input("conf_level"), "0.95")

testthat::expect_equal(app_driver$get_active_module_input("cor_struct"), "unstructured")

radio_buttons <- app_driver$active_module_element_text("output_table")
testthat::expect_match(
radio_buttons,
"Output Type.*LS means.*Covariance.*Coefficients",
fixed = FALSE
)
app_driver$stop()
}
)

testthat::test_that("e2e - tm_a_gee: Selection of id_var changes the table and does not throw validation errors.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
table_before <- app_driver$get_active_module_tws_output("table")
app_driver$set_active_module_input("id_var-dataset_ADQS_singleextract-select", "SUBJID")
testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table")))
app_driver$expect_no_validation_error()
app_driver$stop()
})

testthat::test_that("e2e - tm_a_gee: Deselection of id_var throws validation error.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
app_driver$set_active_module_input("id_var-dataset_ADQS_singleextract-select", character(0))
testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame())
app_driver$expect_validation_error()
testthat::expect_equal(
app_driver$active_module_element_text("id_var-dataset_ADQS_singleextract-select_input > div > span"),
"A Subject identifier is required"
)
app_driver$stop()
})

testthat::test_that("e2e - tm_a_gee: Change in arm_var changes the table and does not throw validation errors.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()

table_before <- app_driver$get_active_module_tws_output("table")
app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD")
testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table")))
app_driver$expect_no_validation_error()
app_driver$stop()
})

testthat::test_that("e2e - tm_a_gee: Deselection of arm_var throws validation error.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", character(0))
testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame())
app_driver$expect_validation_error()
testthat::expect_equal(
app_driver$active_module_element_text("arm_var-dataset_ADSL_singleextract-select_input > div > span"),
"A treatment variable is required"
)
app_driver$stop()
})


testthat::test_that("e2e - tm_a_gee: Selection of visit_var changes the table and does not throw validation errors.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
table_before <- app_driver$get_active_module_tws_output("table")
app_driver$set_active_module_input("visit_var-dataset_ADQS_singleextract-select", "AVISITN")
testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table")))
app_driver$expect_no_validation_error()
app_driver$stop()
})

testthat::test_that("e2e - tm_a_gee: Deselection of visit_var throws validation error.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
app_driver$set_active_module_input("visit_var-dataset_ADQS_singleextract-select", character(0))
testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame())
app_driver$expect_validation_error()
testthat::expect_equal(
app_driver$active_module_element_text("visit_var-dataset_ADQS_singleextract-select_input > div > span"),
"A visit variable is required"
)
app_driver$stop()
})

testthat::test_that("e2e - tm_a_gee: Selection of paramcd changes the table and does not throw validation errors.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
table_before <- app_driver$get_active_module_tws_output("table")
app_driver$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", "BFIALL")
testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table")))
app_driver$expect_no_validation_error()
app_driver$stop()
})

testthat::test_that("e2e - tm_a_gee: Deselection of paramcd throws validation error.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
app_driver$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", character(0))
testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame())
app_driver$expect_validation_error()
testthat::expect_equal(
app_driver$active_module_element_text("paramcd-dataset_ADQS_singleextract-filter1-vals_input > div > span"),
"An endpoint is required"
)
app_driver$stop()
})

testthat::test_that("e2e - tm_a_gee: Selection of cov_var changes the table and does not throw validation errors.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
table_before <- app_driver$get_active_module_tws_output("table")
app_driver$set_active_module_input("cov_var-dataset_ADQS_singleextract-select", "BASE")
testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table")))
app_driver$expect_no_validation_error()
app_driver$stop()
})

testthat::test_that("e2e - tm_a_gee: Deselection of cov_var throws validation error.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
app_driver$set_active_module_input("cov_var-dataset_ADQS_singleextract-select", character(0))
testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame())
app_driver$expect_validation_error()
testthat::expect_equal(
app_driver$active_module_element_text("cov_var-dataset_ADQS_singleextract-select_input > div > span"),
"An endpoint is required"
)
app_driver$stop()
})

testthat::test_that("e2e - tm_a_gee: Selection of conf_level changes the table and does not throw validation errors.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
table_before <- app_driver$get_active_module_tws_output("table")
app_driver$set_active_module_input("conf_level", 0.90)
testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table")))
app_driver$expect_no_validation_error()
app_driver$stop()
})

testthat::test_that("e2e - tm_a_gee: Selection of conf_level out of [0,1] range throws validation error.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
table_before <- app_driver$get_active_module_tws_output("table")
app_driver$set_active_module_input("conf_level", -1)
testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame())
app_driver$expect_validation_error()
testthat::expect_equal(
app_driver$active_module_element_text("conf_level_input > div > span"),
"Confidence level must be between 0 and 1"
)
app_driver$stop()
})

testthat::test_that("e2e - tm_a_gee: Deselection of conf_level throws validation error.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
app_driver$set_active_module_input("conf_level", character(0))
testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame())
app_driver$expect_validation_error()
testthat::expect_equal(
app_driver$active_module_element_text("conf_level_input > div > span"),
"Please choose a confidence level"
)
app_driver$stop()
})


testthat::test_that("e2e - tm_a_gee: Selection of cor_struct changes the table and does not throw validation errors.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
table_before <- app_driver$get_active_module_tws_output("table")
app_driver$set_active_module_input("cor_struct", "auto-regressive")
testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table")))
app_driver$expect_no_validation_error()
app_driver$stop()
})

testthat::test_that("e2e - tm_a_gee: Deselection of cor_struct throws validation error.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
app_driver$set_active_module_input("cor_struct", character(0))
testthat::expect_identical(app_driver$get_active_module_tws_output("table"), data.frame())
# TO BE FIXED - there is no error displayed
app_driver$expect_validation_error()
testthat::expect_equal(
app_driver$active_module_element_text("cov_struct_input > div > span"),
"Please choose a correlation structure"
)
app_driver$stop()
})


testthat::test_that("e2e - tm_a_gee: Selection of output_table changes the table and doesn't throw validation error.", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_a_gee()
table_before <- app_driver$get_active_module_tws_output("table")
app_driver$set_active_module_input("output_table", "t_gee_cov")
testthat::expect_false(identical(table_before, app_driver$get_active_module_tws_output("table")))
app_driver$expect_no_validation_error()
app_driver$stop()
})

0 comments on commit 79a849c

Please sign in to comment.