From 2be40e3d7541f7c284bcea986576292ea22aad74 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 22 Apr 2024 21:25:30 +0530 Subject: [PATCH 01/23] adding skeleton for shinytest2 --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 75 ++++++++++++++++++++++ 1 file changed, 75 insertions(+) create mode 100644 tests/testthat/test-shinytest2-tm_a_mmrm.R 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..ccd64f7caf --- /dev/null +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -0,0 +1,75 @@ +app_driver_tm_a_mmrm <- function() { + + 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") + + 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() + ) + ) +} + +testthat::test_that("e2e - tm_a_mmrm: Module initializes in teal without errors.", { + skip_if_too_deep(5) + + app_driver <- app_driver_tm_a_mmrm() + 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() +}) From 486d46e9e72b1fc98b973abb61799702fe45aed3 Mon Sep 17 00:00:00 2001 From: unknown Date: Wed, 24 Apr 2024 15:10:12 +0530 Subject: [PATCH 02/23] adding test for default values. --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 80 ++++++++++++++++++++++ 1 file changed, 80 insertions(+) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index ccd64f7caf..b690f196aa 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -73,3 +73,83 @@ testthat::test_that("e2e - tm_a_mmrm: Module initializes in teal without errors. app_driver$stop() }) + +testthat::test_that("e2e - tm_a_mmrm: Module initializes with specified label, x_var, y_var, ADQS filters, color, conf_level and stat", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + + 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() +}) From fa3c3e92025554b49f60959c08d548ef0ffd0397 Mon Sep 17 00:00:00 2001 From: unknown Date: Wed, 24 Apr 2024 20:01:11 +0530 Subject: [PATCH 03/23] adding testfor output types and setting. --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 201 +++++++++++++++------ 1 file changed, 145 insertions(+), 56 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index b690f196aa..8f46d82a9e 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -1,5 +1,4 @@ app_driver_tm_a_mmrm <- function() { - arm_ref_comp <- list( ARMCD = list( ref = "ARM B", @@ -34,7 +33,8 @@ app_driver_tm_a_mmrm <- function() { label = "MMRM", dataname = "ADQS", parentname = ifelse(inherits(arm_var, "data_extract_spec"), - teal.transform::datanames_input(arm_var), "ADSL"), + 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, @@ -45,10 +45,14 @@ app_driver_tm_a_mmrm <- function() { 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), + 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(), @@ -56,7 +60,8 @@ app_driver_tm_a_mmrm <- function() { post_output = NULL, basic_table_args = teal.widgets::basic_table_args(), ggplot2_args = teal.widgets::ggplot2_args() - ) + ), + timeout = 30000 ) } @@ -74,81 +79,165 @@ testthat::test_that("e2e - tm_a_mmrm: Module initializes in teal without errors. app_driver$stop() }) -testthat::test_that("e2e - tm_a_mmrm: Module initializes with specified label, x_var, y_var, ADQS filters, color, conf_level and stat", { +testthat::test_that("e2e - tm_a_mmrm: + Module initializes with specified label, x_var, y_var, ADQS filters, color, conf_level and stat", { skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() - testthat::expect_equal( - app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), - "MMRM" - ) + 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("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_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_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("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")) + 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_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("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("weights_emmeans"), "proportional") - testthat::expect_equal( - app_driver$get_active_module_input("cor_struct"), - "unstructured" - ) + 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("conf_level"), "0.95") - testthat::expect_equal( - app_driver$get_active_module_input("method"), - "Satterthwaite" + 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$click(selector = app_driver$active_module_element("button_start")) + app_driver$expect_no_validation_error() + + table <- app_driver$get_active_module_tws_output("mmrm_table") + col_val <- app_driver$get_active_module_input("buckets") + testthat::expect_true(all(unlist(col_val, use.names = FALSE) %in% colnames(table))) + testthat::expect_gte(nrow(table), 25) + + app_driver$stop() +}) + +testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output settings", { + 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() + + # LS means table (Default) + out_fun <- app_driver$get_active_module_input("output_function") + id <- sprintf("%s_show_relative", out_fun) + testthat::expect_equal(app_driver$get_active_module_input(id), "reduction") + + app_driver$set_active_module_input(id, "increase") + app_driver$expect_no_validation_error() + + # LS means plots + out_fun <- "g_mmrm_lsmeans" + app_driver$set_active_module_input("output_function", out_fun) + app_driver$expect_no_validation_error() + + plot_before <- app_driver$get_active_module_pws_output("mmrm_plot") + testthat::expect_match(plot_before, "data:image/png;base64,") + + testthat::expect_equal(app_driver$get_active_module_input(sprintf("%s_select", out_fun)), c("estimates", "contrasts")) + + testthat::expect_equal(app_driver$get_active_module_input(sprintf("%s_width", out_fun)), 0.6) + + testthat::expect_false(app_driver$get_active_module_input(sprintf("%s_contrasts_show_pval", out_fun))) + + app_driver$set_active_module_input(sprintf("%s_select", out_fun), "estimates") + app_driver$expect_no_validation_error() + app_driver$set_active_module_input(sprintf("%s_select", out_fun), "contrasts") + app_driver$expect_no_validation_error() + + app_driver$set_active_module_input( + sprintf("%s_select", out_fun), + c("estimates", "contrasts") ) + app_driver$expect_no_validation_error() + + + app_driver$set_active_module_input(sprintf("%s_width", out_fun), 0.9) + app_driver$expect_no_validation_error() + + app_driver$set_active_module_input(sprintf("%s_contrasts_show_pval", out_fun), TRUE) + app_driver$expect_no_validation_error() + + plot <- app_driver$get_active_module_pws_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") - testthat::expect_true( - app_driver$get_active_module_input("parallel") + testthat::expect_false( + identical( + plot_before, + plot + ) ) - testthat::expect_equal( - app_driver$get_active_module_input("output_function"), - "t_mmrm_lsmeans" + # Covariance estimate + app_driver$set_active_module_input("output_function", "t_mmrm_cov") + app_driver$expect_no_validation_error() + + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + + # Fixed effects + + app_driver$set_active_module_input("output_function", "t_mmrm_fixed") + app_driver$expect_no_validation_error() + + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + + # Fit statistics + app_driver$set_active_module_input("output_function", "t_mmrm_diagnostic") + app_driver$expect_no_validation_error() + + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + + # Diagnostic plots + app_driver$set_active_module_input("output_function", "g_mmrm_diagnostic") + app_driver$expect_no_validation_error() + + plot_before <- app_driver$get_active_module_pws_output("mmrm_plot") + testthat::expect_match(plot_before, "data:image/png;base64,") + + testthat::expect_equal(app_driver$get_active_module_input("g_mmrm_diagnostic_type"), "fit-residual") + + app_driver$set_active_module_input("g_mmrm_diagnostic_type", "q-q-residual") + + plot <- app_driver$get_active_module_pws_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") + + testthat::expect_false( + identical( + plot_before, + plot + ) ) app_driver$stop() From 4a3800dced4ba2cc02463cd8f216d75cd4344963 Mon Sep 17 00:00:00 2001 From: unknown Date: Thu, 25 Apr 2024 12:41:57 +0530 Subject: [PATCH 04/23] updated output setting tests --- tests/testthat/helper-TealAppDriver.R | 5 + tests/testthat/test-shinytest2-tm_a_mmrm.R | 154 +++++++++------------ 2 files changed, 68 insertions(+), 91 deletions(-) diff --git a/tests/testthat/helper-TealAppDriver.R b/tests/testthat/helper-TealAppDriver.R index b28850e396..8008997986 100644 --- a/tests/testthat/helper-TealAppDriver.R +++ b/tests/testthat/helper-TealAppDriver.R @@ -23,3 +23,8 @@ init_teal_app_driver <- function(...) { .package = "teal" ) } + +set_input_and_validate <- function(app_driver, input_id, value) { + app_driver$set_active_module_input(input_id, value) + app_driver$expect_no_validation_error() +} diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index 8f46d82a9e..af21914243 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -147,98 +147,70 @@ testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output app_driver$click(selector = app_driver$active_module_element("button_start")) app_driver$expect_no_validation_error() - # LS means table (Default) - out_fun <- app_driver$get_active_module_input("output_function") - id <- sprintf("%s_show_relative", out_fun) - testthat::expect_equal(app_driver$get_active_module_input(id), "reduction") - - app_driver$set_active_module_input(id, "increase") - app_driver$expect_no_validation_error() - - # LS means plots - out_fun <- "g_mmrm_lsmeans" - app_driver$set_active_module_input("output_function", out_fun) - app_driver$expect_no_validation_error() - - plot_before <- app_driver$get_active_module_pws_output("mmrm_plot") - testthat::expect_match(plot_before, "data:image/png;base64,") - - testthat::expect_equal(app_driver$get_active_module_input(sprintf("%s_select", out_fun)), c("estimates", "contrasts")) - - testthat::expect_equal(app_driver$get_active_module_input(sprintf("%s_width", out_fun)), 0.6) - - testthat::expect_false(app_driver$get_active_module_input(sprintf("%s_contrasts_show_pval", out_fun))) - - app_driver$set_active_module_input(sprintf("%s_select", out_fun), "estimates") - app_driver$expect_no_validation_error() - app_driver$set_active_module_input(sprintf("%s_select", out_fun), "contrasts") - app_driver$expect_no_validation_error() - - app_driver$set_active_module_input( - sprintf("%s_select", out_fun), - c("estimates", "contrasts") - ) - app_driver$expect_no_validation_error() - - - app_driver$set_active_module_input(sprintf("%s_width", out_fun), 0.9) - app_driver$expect_no_validation_error() - - app_driver$set_active_module_input(sprintf("%s_contrasts_show_pval", out_fun), TRUE) - app_driver$expect_no_validation_error() - - plot <- app_driver$get_active_module_pws_output("mmrm_plot") - testthat::expect_match(plot, "data:image/png;base64,") - - testthat::expect_false( - identical( - plot_before, - plot - ) - ) - - # Covariance estimate - app_driver$set_active_module_input("output_function", "t_mmrm_cov") - app_driver$expect_no_validation_error() - - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - - # Fixed effects - - app_driver$set_active_module_input("output_function", "t_mmrm_fixed") - app_driver$expect_no_validation_error() - - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - - # Fit statistics - app_driver$set_active_module_input("output_function", "t_mmrm_diagnostic") - app_driver$expect_no_validation_error() - - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - - # Diagnostic plots - app_driver$set_active_module_input("output_function", "g_mmrm_diagnostic") - app_driver$expect_no_validation_error() - - plot_before <- app_driver$get_active_module_pws_output("mmrm_plot") - testthat::expect_match(plot_before, "data:image/png;base64,") - - testthat::expect_equal(app_driver$get_active_module_input("g_mmrm_diagnostic_type"), "fit-residual") - - app_driver$set_active_module_input("g_mmrm_diagnostic_type", "q-q-residual") - - plot <- app_driver$get_active_module_pws_output("mmrm_plot") - testthat::expect_match(plot, "data:image/png;base64,") - - testthat::expect_false( - identical( - plot_before, - plot + # Check and set different outputs and validate their effects + output_functions <- c("g_mmrm_lsmeans", "t_mmrm_lsmeans", "t_mmrm_cov", "t_mmrm_fixed", "t_mmrm_diagnostic", "g_mmrm_diagnostic") + for (func in output_functions) { + #browser() + set_input_and_validate(app_driver, "output_function", func) + + # Test default behavior or specific behavior based on the function + switch(func, + t_mmrm_lsmeans = { + testthat::expect_equal(app_driver$get_active_module_input("t_mmrm_lsmeans_show_relative"), "reduction") + set_input_and_validate(app_driver, "t_mmrm_lsmeans_show_relative", "increase") + }, + g_mmrm_lsmeans = { + plot_before <- app_driver$get_active_module_pws_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_pws_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") + + testthat::expect_false(identical(plot_before, plot)) + }, + t_mmrm_cov = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + }, + t_mmrm_fixed = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + }, + t_mmrm_diagnostic = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + }, + g_mmrm_diagnostic = { + plot_before <- app_driver$get_active_module_pws_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_pws_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") + + testthat::expect_false(identical(plot_before, plot)) + } ) - ) + } app_driver$stop() }) From c4cfb7be682a1fea10dfaec98b4babfc57d1a204 Mon Sep 17 00:00:00 2001 From: unknown Date: Thu, 25 Apr 2024 13:24:36 +0530 Subject: [PATCH 05/23] adding validation checks --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 87 +++++++++++++++++++++- 1 file changed, 84 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index af21914243..1c6f969d25 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -80,7 +80,7 @@ testthat::test_that("e2e - tm_a_mmrm: Module initializes in teal without errors. }) testthat::test_that("e2e - tm_a_mmrm: - Module initializes with specified label, x_var, y_var, ADQS filters, color, conf_level and stat", { + Module initializes with specified label, x_var, y_var, ADQS filters, color, conf_level and stat.", { skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() @@ -126,7 +126,7 @@ testthat::test_that("e2e - tm_a_mmrm: app_driver$stop() }) -testthat::test_that("e2e - tm_a_mmrm: Click on fit model shows table for default selection", { +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$click(selector = app_driver$active_module_element("button_start")) @@ -140,7 +140,7 @@ testthat::test_that("e2e - tm_a_mmrm: Click on fit model shows table for default app_driver$stop() }) -testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output settings", { +testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output settings.", { skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() @@ -214,3 +214,84 @@ testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output app_driver$stop() }) + +testthat::test_that("e2e - tm_a_mmrm: + Deselection of x_var, y_var, ADQS filters, color, conf_level and stat throws validation error.", { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + + + app_driver$set_active_module_input("aval_var-dataset_ADQS_singleextract-select", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("aval_var", "select_input", "ADQS") + ) + ), + "Analysis Variable' field is not selected" + ) + + app_driver$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("paramcd", "filter1-vals_input", "ADQS") + ) + ), + "Select Endpoint' field is not selected" + ) + + app_driver$set_active_module_input("visit_var-dataset_ADQS_singleextract-select", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("visit_var", "select_input", "ADQS") + ) + ), + "Visit Variable' field is not selected" + ) + + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("arm_var", "select_input", "ADSL") + ) + ), + "Treatment variable must be selected" + ) + + app_driver$set_active_module_input("id_var-dataset_ADQS_singleextract-select", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("id_var", "select_input", "ADQS") + ) + ), + "Subject Identifier' field is not selected" + ) + + app_driver$set_active_module_input("conf_level", numeric(0L)) + app_driver$expect_validation_error() + 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$stop() + }) From 0caab5d928bb482024364e8d7a6db177f7f44238 Mon Sep 17 00:00:00 2001 From: unknown Date: Thu, 25 Apr 2024 13:26:13 +0530 Subject: [PATCH 06/23] fix styling --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 250 ++++++++++----------- 1 file changed, 124 insertions(+), 126 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index 1c6f969d25..e8c27da4d8 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -150,65 +150,63 @@ testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output # Check and set different outputs and validate their effects output_functions <- c("g_mmrm_lsmeans", "t_mmrm_lsmeans", "t_mmrm_cov", "t_mmrm_fixed", "t_mmrm_diagnostic", "g_mmrm_diagnostic") for (func in output_functions) { - #browser() set_input_and_validate(app_driver, "output_function", func) - # Test default behavior or specific behavior based on the function switch(func, - t_mmrm_lsmeans = { - testthat::expect_equal(app_driver$get_active_module_input("t_mmrm_lsmeans_show_relative"), "reduction") - set_input_and_validate(app_driver, "t_mmrm_lsmeans_show_relative", "increase") - }, - g_mmrm_lsmeans = { - plot_before <- app_driver$get_active_module_pws_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_pws_output("mmrm_plot") - testthat::expect_match(plot, "data:image/png;base64,") - - testthat::expect_false(identical(plot_before, plot)) - }, - t_mmrm_cov = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - }, - t_mmrm_fixed = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - }, - t_mmrm_diagnostic = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - }, - g_mmrm_diagnostic = { - plot_before <- app_driver$get_active_module_pws_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_pws_output("mmrm_plot") - testthat::expect_match(plot, "data:image/png;base64,") - - testthat::expect_false(identical(plot_before, plot)) - } + t_mmrm_lsmeans = { + testthat::expect_equal(app_driver$get_active_module_input("t_mmrm_lsmeans_show_relative"), "reduction") + set_input_and_validate(app_driver, "t_mmrm_lsmeans_show_relative", "increase") + }, + g_mmrm_lsmeans = { + plot_before <- app_driver$get_active_module_pws_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_pws_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") + + testthat::expect_false(identical(plot_before, plot)) + }, + t_mmrm_cov = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + }, + t_mmrm_fixed = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + }, + t_mmrm_diagnostic = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + }, + g_mmrm_diagnostic = { + plot_before <- app_driver$get_active_module_pws_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_pws_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") + + testthat::expect_false(identical(plot_before, plot)) + } ) } @@ -217,81 +215,81 @@ testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output testthat::test_that("e2e - tm_a_mmrm: Deselection of x_var, y_var, ADQS filters, color, conf_level and stat throws validation error.", { - skip_if_too_deep(5) - app_driver <- app_driver_tm_a_mmrm() + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() - app_driver$set_active_module_input("aval_var-dataset_ADQS_singleextract-select", character(0L)) - app_driver$expect_validation_error() - testthat::expect_match( - app_driver$active_module_element_text( - sprintf( - "%s .shiny-validation-message", - ns_dataset("aval_var", "select_input", "ADQS") - ) - ), - "Analysis Variable' field is not selected" - ) + app_driver$set_active_module_input("aval_var-dataset_ADQS_singleextract-select", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("aval_var", "select_input", "ADQS") + ) + ), + "Analysis Variable' field is not selected" + ) - app_driver$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", character(0L)) - app_driver$expect_validation_error() - testthat::expect_match( - app_driver$active_module_element_text( - sprintf( - "%s .shiny-validation-message", - ns_dataset("paramcd", "filter1-vals_input", "ADQS") - ) - ), - "Select Endpoint' field is not selected" - ) + app_driver$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("paramcd", "filter1-vals_input", "ADQS") + ) + ), + "Select Endpoint' field is not selected" + ) - app_driver$set_active_module_input("visit_var-dataset_ADQS_singleextract-select", character(0L)) - app_driver$expect_validation_error() - testthat::expect_match( - app_driver$active_module_element_text( - sprintf( - "%s .shiny-validation-message", - ns_dataset("visit_var", "select_input", "ADQS") - ) - ), - "Visit Variable' field is not selected" - ) + app_driver$set_active_module_input("visit_var-dataset_ADQS_singleextract-select", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("visit_var", "select_input", "ADQS") + ) + ), + "Visit Variable' field is not selected" + ) - app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", character(0L)) - app_driver$expect_validation_error() - testthat::expect_match( - app_driver$active_module_element_text( - sprintf( - "%s .shiny-validation-message", - ns_dataset("arm_var", "select_input", "ADSL") - ) - ), - "Treatment variable must be selected" - ) + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("arm_var", "select_input", "ADSL") + ) + ), + "Treatment variable must be selected" + ) - app_driver$set_active_module_input("id_var-dataset_ADQS_singleextract-select", character(0L)) - app_driver$expect_validation_error() - testthat::expect_match( - app_driver$active_module_element_text( - sprintf( - "%s .shiny-validation-message", - ns_dataset("id_var", "select_input", "ADQS") - ) - ), - "Subject Identifier' field is not selected" - ) + app_driver$set_active_module_input("id_var-dataset_ADQS_singleextract-select", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("id_var", "select_input", "ADQS") + ) + ), + "Subject Identifier' field is not selected" + ) - app_driver$set_active_module_input("conf_level", numeric(0L)) - app_driver$expect_validation_error() - 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$set_active_module_input("conf_level", numeric(0L)) + app_driver$expect_validation_error() + 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$stop() - }) + app_driver$stop() +}) From b6ec3f91a7f9f4fc0e774e601abf2cdeb7c9207a Mon Sep 17 00:00:00 2001 From: unknown Date: Thu, 25 Apr 2024 13:47:42 +0530 Subject: [PATCH 07/23] renaming the method --- tests/testthat/helper-TealAppDriver.R | 7 +++++- tests/testthat/test-shinytest2-tm_a_mmrm.R | 29 ++++++++++++++++------ 2 files changed, 27 insertions(+), 9 deletions(-) diff --git a/tests/testthat/helper-TealAppDriver.R b/tests/testthat/helper-TealAppDriver.R index 8008997986..7d95f8ebb3 100644 --- a/tests/testthat/helper-TealAppDriver.R +++ b/tests/testthat/helper-TealAppDriver.R @@ -24,7 +24,12 @@ init_teal_app_driver <- function(...) { ) } -set_input_and_validate <- function(app_driver, input_id, value) { +test_no_validation_error <- function(app_driver, input_id, value) { app_driver$set_active_module_input(input_id, value) app_driver$expect_no_validation_error() } + + +ns_dataset <- function(prefix, suffix, dataset, extract = "singleextract") { + sprintf("%s-dataset_%s_%s-%s", prefix, dataset, extract, suffix) +} diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index e8c27da4d8..a57704677d 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -1,4 +1,4 @@ -app_driver_tm_a_mmrm <- function() { +app_driver_tm_a_mmrm <- function() { # nolint: object_length. arm_ref_comp <- list( ARMCD = list( ref = "ARM B", @@ -79,8 +79,12 @@ testthat::test_that("e2e - tm_a_mmrm: Module initializes in teal without errors. app_driver$stop() }) -testthat::test_that("e2e - tm_a_mmrm: - Module initializes with specified label, x_var, y_var, ADQS filters, color, conf_level and stat.", { +testthat::test_that( + paste0( + "e2e - tm_a_mmrm: Module initializes with specified label,analysis variable, select endpoint,", + "visit variable, covariates,select treatment variable, subject identifier, weights for ls means,", + "correlation structure, adjustment method and confidence level" + ), { skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() @@ -148,14 +152,20 @@ testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output app_driver$expect_no_validation_error() # Check and set different outputs and validate their effects - output_functions <- c("g_mmrm_lsmeans", "t_mmrm_lsmeans", "t_mmrm_cov", "t_mmrm_fixed", "t_mmrm_diagnostic", "g_mmrm_diagnostic") + output_functions <- c("g_mmrm_lsmeans", + "t_mmrm_lsmeans", + "t_mmrm_cov", + "t_mmrm_fixed", + "t_mmrm_diagnostic", + "g_mmrm_diagnostic") + for (func in output_functions) { - set_input_and_validate(app_driver, "output_function", func) + test_no_validation_error(app_driver, "output_function", func) switch(func, t_mmrm_lsmeans = { testthat::expect_equal(app_driver$get_active_module_input("t_mmrm_lsmeans_show_relative"), "reduction") - set_input_and_validate(app_driver, "t_mmrm_lsmeans_show_relative", "increase") + test_no_validation_error(app_driver, "t_mmrm_lsmeans_show_relative", "increase") }, g_mmrm_lsmeans = { plot_before <- app_driver$get_active_module_pws_output("mmrm_plot") @@ -213,8 +223,11 @@ testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output app_driver$stop() }) -testthat::test_that("e2e - tm_a_mmrm: - Deselection of x_var, y_var, ADQS filters, color, conf_level and stat throws validation error.", { +testthat::test_that( + paste0( + "e2e - tm_a_mmrm: Deselection of analysis variable, select endpoint,", + "visit variable, select treatment variable, subject identifier and confidence level" + ), { skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() From e38ee2ae954313e1b8d0cdd39811e42bfbd6fc05 Mon Sep 17 00:00:00 2001 From: unknown Date: Thu, 25 Apr 2024 14:58:36 +0530 Subject: [PATCH 08/23] adding tests for cncoding changes --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 64 ++++++++++++++++++++++ 1 file changed, 64 insertions(+) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index a57704677d..eabc4754b4 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -306,3 +306,67 @@ testthat::test_that( app_driver$stop() }) + +testthat::test_that("e2e - tm_a_mmrm: Validate output on different selection.", { + #skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + + test_no_validation_error(app_driver, "aval_var-dataset_ADQS_singleextract-select", "CHG") + test_no_validation_error(app_driver, "paramcd-dataset_ADQS_singleextract-filter1-vals", "BFIALL") + test_no_validation_error(app_driver, "visit_var-dataset_ADQS_singleextract-select", "AVISITN") + test_no_validation_error(app_driver, "cov_var-dataset_ADQS_singleextract-select", "AGE") + test_no_validation_error(app_driver, "arm_var-dataset_ADSL_singleextract-select", "ARMCD") + test_no_validation_error(app_driver, "combine_comp_arms", TRUE) + test_no_validation_error(app_driver, "id_var-dataset_ADQS_singleextract-select", "SUBJID") + test_no_validation_error(app_driver, "weights_emmeans", "equal") + test_no_validation_error(app_driver, "cor_struct", "ante-dependence") + test_no_validation_error(app_driver, "conf_level", "0.8") + test_no_validation_error(app_driver, "method", "Kenward-Roger") + + app_driver$click(selector = app_driver$active_module_element("button_start")) + app_driver$expect_no_validation_error() + + # Check and set different outputs and validate their effects + output_functions <- c("g_mmrm_lsmeans", + "t_mmrm_lsmeans", + "t_mmrm_cov", + "t_mmrm_fixed", + "t_mmrm_diagnostic", + "g_mmrm_diagnostic") + + for (func in output_functions) { + test_no_validation_error(app_driver, "output_function", func) + + switch(func, + t_mmrm_lsmeans = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + + }, + g_mmrm_lsmeans = { + plot <- app_driver$get_active_module_pws_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") + + }, + t_mmrm_cov = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + }, + t_mmrm_fixed = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + }, + t_mmrm_diagnostic = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + }, + g_mmrm_diagnostic = { + plot <- app_driver$get_active_module_pws_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") + } + ) + } + + app_driver$stop() +}) + From e15fb4f7d3ac402e083bfa5358b2878bc2c09ced Mon Sep 17 00:00:00 2001 From: unknown Date: Thu, 25 Apr 2024 14:59:37 +0530 Subject: [PATCH 09/23] rm comment --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index eabc4754b4..249532608e 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -308,7 +308,7 @@ testthat::test_that( }) testthat::test_that("e2e - tm_a_mmrm: Validate output on different selection.", { - #skip_if_too_deep(5) + skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() test_no_validation_error(app_driver, "aval_var-dataset_ADQS_singleextract-select", "CHG") From 6612fbdfd670bd57f0eb814f76f722f1c053c5c0 Mon Sep 17 00:00:00 2001 From: unknown Date: Thu, 25 Apr 2024 16:33:18 +0530 Subject: [PATCH 10/23] fixing styling issue. --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 285 +++++++++++---------- 1 file changed, 145 insertions(+), 140 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index 249532608e..be084f17f4 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -84,51 +84,53 @@ testthat::test_that( "e2e - tm_a_mmrm: Module initializes with specified label,analysis variable, select endpoint,", "visit variable, covariates,select treatment variable, subject identifier, weights for ls means,", "correlation structure, adjustment method and confidence level" - ), { - skip_if_too_deep(5) - app_driver <- app_driver_tm_a_mmrm() + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() - testthat::expect_equal(app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"), "MMRM") + 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("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("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_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_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("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_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_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("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("weights_emmeans"), "proportional") - testthat::expect_equal(app_driver$get_active_module_input("cor_struct"), "unstructured") + 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("conf_level"), "0.95") - testthat::expect_equal(app_driver$get_active_module_input("method"), "Satterthwaite") + testthat::expect_equal(app_driver$get_active_module_input("method"), "Satterthwaite") - testthat::expect_true(app_driver$get_active_module_input("parallel")) + testthat::expect_true(app_driver$get_active_module_input("parallel")) - testthat::expect_equal(app_driver$get_active_module_input("output_function"), "t_mmrm_lsmeans") + testthat::expect_equal(app_driver$get_active_module_input("output_function"), "t_mmrm_lsmeans") - app_driver$stop() -}) + app_driver$stop() + } +) testthat::test_that("e2e - tm_a_mmrm: Click on fit model shows table for default selection.", { skip_if_too_deep(5) @@ -152,12 +154,14 @@ testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output app_driver$expect_no_validation_error() # Check and set different outputs and validate their effects - output_functions <- c("g_mmrm_lsmeans", - "t_mmrm_lsmeans", - "t_mmrm_cov", - "t_mmrm_fixed", - "t_mmrm_diagnostic", - "g_mmrm_diagnostic") + output_functions <- c( + "g_mmrm_lsmeans", + "t_mmrm_lsmeans", + "t_mmrm_cov", + "t_mmrm_fixed", + "t_mmrm_diagnostic", + "g_mmrm_diagnostic" + ) for (func in output_functions) { test_no_validation_error(app_driver, "output_function", func) @@ -227,85 +231,87 @@ testthat::test_that( paste0( "e2e - tm_a_mmrm: Deselection of analysis variable, select endpoint,", "visit variable, select treatment variable, subject identifier and confidence level" - ), { - skip_if_too_deep(5) - app_driver <- app_driver_tm_a_mmrm() - - - app_driver$set_active_module_input("aval_var-dataset_ADQS_singleextract-select", character(0L)) - app_driver$expect_validation_error() - testthat::expect_match( - app_driver$active_module_element_text( - sprintf( - "%s .shiny-validation-message", - ns_dataset("aval_var", "select_input", "ADQS") - ) - ), - "Analysis Variable' field is not selected" - ) + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + + + app_driver$set_active_module_input("aval_var-dataset_ADQS_singleextract-select", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("aval_var", "select_input", "ADQS") + ) + ), + "Analysis Variable' field is not selected" + ) - app_driver$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", character(0L)) - app_driver$expect_validation_error() - testthat::expect_match( - app_driver$active_module_element_text( - sprintf( - "%s .shiny-validation-message", - ns_dataset("paramcd", "filter1-vals_input", "ADQS") - ) - ), - "Select Endpoint' field is not selected" - ) + app_driver$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("paramcd", "filter1-vals_input", "ADQS") + ) + ), + "Select Endpoint' field is not selected" + ) - app_driver$set_active_module_input("visit_var-dataset_ADQS_singleextract-select", character(0L)) - app_driver$expect_validation_error() - testthat::expect_match( - app_driver$active_module_element_text( - sprintf( - "%s .shiny-validation-message", - ns_dataset("visit_var", "select_input", "ADQS") - ) - ), - "Visit Variable' field is not selected" - ) + app_driver$set_active_module_input("visit_var-dataset_ADQS_singleextract-select", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("visit_var", "select_input", "ADQS") + ) + ), + "Visit Variable' field is not selected" + ) - app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", character(0L)) - app_driver$expect_validation_error() - testthat::expect_match( - app_driver$active_module_element_text( - sprintf( - "%s .shiny-validation-message", - ns_dataset("arm_var", "select_input", "ADSL") - ) - ), - "Treatment variable must be selected" - ) + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("arm_var", "select_input", "ADSL") + ) + ), + "Treatment variable must be selected" + ) - app_driver$set_active_module_input("id_var-dataset_ADQS_singleextract-select", character(0L)) - app_driver$expect_validation_error() - testthat::expect_match( - app_driver$active_module_element_text( - sprintf( - "%s .shiny-validation-message", - ns_dataset("id_var", "select_input", "ADQS") - ) - ), - "Subject Identifier' field is not selected" - ) + app_driver$set_active_module_input("id_var-dataset_ADQS_singleextract-select", character(0L)) + app_driver$expect_validation_error() + testthat::expect_match( + app_driver$active_module_element_text( + sprintf( + "%s .shiny-validation-message", + ns_dataset("id_var", "select_input", "ADQS") + ) + ), + "Subject Identifier' field is not selected" + ) - app_driver$set_active_module_input("conf_level", numeric(0L)) - app_driver$expect_validation_error() - 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$set_active_module_input("conf_level", numeric(0L)) + app_driver$expect_validation_error() + 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$stop() -}) + app_driver$stop() + } +) testthat::test_that("e2e - tm_a_mmrm: Validate output on different selection.", { skip_if_too_deep(5) @@ -327,46 +333,45 @@ testthat::test_that("e2e - tm_a_mmrm: Validate output on different selection.", app_driver$expect_no_validation_error() # Check and set different outputs and validate their effects - output_functions <- c("g_mmrm_lsmeans", - "t_mmrm_lsmeans", - "t_mmrm_cov", - "t_mmrm_fixed", - "t_mmrm_diagnostic", - "g_mmrm_diagnostic") + output_functions <- c( + "g_mmrm_lsmeans", + "t_mmrm_lsmeans", + "t_mmrm_cov", + "t_mmrm_fixed", + "t_mmrm_diagnostic", + "g_mmrm_diagnostic" + ) for (func in output_functions) { test_no_validation_error(app_driver, "output_function", func) switch(func, - t_mmrm_lsmeans = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - - }, - g_mmrm_lsmeans = { - plot <- app_driver$get_active_module_pws_output("mmrm_plot") - testthat::expect_match(plot, "data:image/png;base64,") - - }, - t_mmrm_cov = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - }, - t_mmrm_fixed = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - }, - t_mmrm_diagnostic = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - }, - g_mmrm_diagnostic = { - plot <- app_driver$get_active_module_pws_output("mmrm_plot") - testthat::expect_match(plot, "data:image/png;base64,") - } + t_mmrm_lsmeans = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + }, + g_mmrm_lsmeans = { + plot <- app_driver$get_active_module_pws_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") + }, + t_mmrm_cov = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + }, + t_mmrm_fixed = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + }, + t_mmrm_diagnostic = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + }, + g_mmrm_diagnostic = { + plot <- app_driver$get_active_module_pws_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") + } ) } app_driver$stop() }) - From 2d68bb059d3eec8aee95a8818ca1c1de74c7ccf1 Mon Sep 17 00:00:00 2001 From: unknown Date: Thu, 25 Apr 2024 20:34:54 +0530 Subject: [PATCH 11/23] fixing test --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index be084f17f4..c37a485e74 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -100,7 +100,7 @@ testthat::test_that( 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_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") From 2ad7f7c0fcb674e3525c1c31cc88e8f2b25c89ad Mon Sep 17 00:00:00 2001 From: unknown Date: Fri, 26 Apr 2024 13:07:24 +0530 Subject: [PATCH 12/23] fix ci error --- tests/testthat/helper-TealAppDriver.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/helper-TealAppDriver.R b/tests/testthat/helper-TealAppDriver.R index 42e42822d9..14f55da1f5 100644 --- a/tests/testthat/helper-TealAppDriver.R +++ b/tests/testthat/helper-TealAppDriver.R @@ -31,7 +31,7 @@ test_no_validation_error <- function(app_driver, input_id, value) { ns_dataset <- function(prefix, suffix, dataset, extract = "singleextract") { sprintf("%s-dataset_%s_%s-%s", prefix, dataset, extract, suffix) - +} # returns base 64 encoded image active_module_pws_output <- function(app_driver) { app_driver$get_attr( From c983346b525e0c4e258d2890d901e3b1e921dbc9 Mon Sep 17 00:00:00 2001 From: unknown Date: Fri, 26 Apr 2024 17:11:22 +0530 Subject: [PATCH 13/23] removing the helper fun --- tests/testthat/helper-TealAppDriver.R | 8 ---- tests/testthat/test-shinytest2-tm_a_mmrm.R | 43 +++++++++++++++------- 2 files changed, 29 insertions(+), 22 deletions(-) diff --git a/tests/testthat/helper-TealAppDriver.R b/tests/testthat/helper-TealAppDriver.R index 14f55da1f5..ec11c05462 100644 --- a/tests/testthat/helper-TealAppDriver.R +++ b/tests/testthat/helper-TealAppDriver.R @@ -24,14 +24,6 @@ init_teal_app_driver <- function(...) { ) } -test_no_validation_error <- function(app_driver, input_id, value) { - app_driver$set_active_module_input(input_id, value) - app_driver$expect_no_validation_error() -} - -ns_dataset <- function(prefix, suffix, dataset, extract = "singleextract") { - sprintf("%s-dataset_%s_%s-%s", prefix, dataset, extract, suffix) -} # returns base 64 encoded image active_module_pws_output <- function(app_driver) { app_driver$get_attr( diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index c37a485e74..904127bed5 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -65,6 +65,10 @@ app_driver_tm_a_mmrm <- function() { # nolint: object_length. ) } +ns_dataset <- function(prefix, suffix, dataset, extract = "singleextract") { + sprintf("%s-dataset_%s_%s-%s", prefix, dataset, extract, suffix) +} + testthat::test_that("e2e - tm_a_mmrm: Module initializes in teal without errors.", { skip_if_too_deep(5) @@ -164,12 +168,12 @@ testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output ) for (func in output_functions) { - test_no_validation_error(app_driver, "output_function", func) + app_driver$set_active_module_input("output_function", func) switch(func, t_mmrm_lsmeans = { testthat::expect_equal(app_driver$get_active_module_input("t_mmrm_lsmeans_show_relative"), "reduction") - test_no_validation_error(app_driver, "t_mmrm_lsmeans_show_relative", "increase") + app_driver$set_active_module_input("t_mmrm_lsmeans_show_relative", "increase") }, g_mmrm_lsmeans = { plot_before <- app_driver$get_active_module_pws_output("mmrm_plot") @@ -317,17 +321,28 @@ testthat::test_that("e2e - tm_a_mmrm: Validate output on different selection.", skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() - test_no_validation_error(app_driver, "aval_var-dataset_ADQS_singleextract-select", "CHG") - test_no_validation_error(app_driver, "paramcd-dataset_ADQS_singleextract-filter1-vals", "BFIALL") - test_no_validation_error(app_driver, "visit_var-dataset_ADQS_singleextract-select", "AVISITN") - test_no_validation_error(app_driver, "cov_var-dataset_ADQS_singleextract-select", "AGE") - test_no_validation_error(app_driver, "arm_var-dataset_ADSL_singleextract-select", "ARMCD") - test_no_validation_error(app_driver, "combine_comp_arms", TRUE) - test_no_validation_error(app_driver, "id_var-dataset_ADQS_singleextract-select", "SUBJID") - test_no_validation_error(app_driver, "weights_emmeans", "equal") - test_no_validation_error(app_driver, "cor_struct", "ante-dependence") - test_no_validation_error(app_driver, "conf_level", "0.8") - test_no_validation_error(app_driver, "method", "Kenward-Roger") + app_driver$set_active_module_input("aval_var-dataset_ADQS_singleextract-select", "CHG") + app_driver$expect_no_validation_error() + app_driver$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", "BFIALL") + app_driver$expect_no_validation_error() + app_driver$set_active_module_input("visit_var-dataset_ADQS_singleextract-select", "AVISITN") + app_driver$expect_no_validation_error() + app_driver$set_active_module_input("cov_var-dataset_ADQS_singleextract-select", "AGE") + app_driver$expect_no_validation_error() + app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") + app_driver$expect_no_validation_error() + app_driver$set_active_module_input("combine_comp_arms", TRUE) + app_driver$expect_no_validation_error() + app_driver$set_active_module_input("id_var-dataset_ADQS_singleextract-select", "SUBJID") + app_driver$expect_no_validation_error() + app_driver$set_active_module_input("weights_emmeans", "equal") + app_driver$expect_no_validation_error() + app_driver$set_active_module_input("cor_struct", "ante-dependence") + app_driver$expect_no_validation_error() + app_driver$set_active_module_input("conf_level", "0.8") + app_driver$expect_no_validation_error() + app_driver$set_active_module_input("method", "Kenward-Roger") + app_driver$expect_no_validation_error() app_driver$click(selector = app_driver$active_module_element("button_start")) app_driver$expect_no_validation_error() @@ -343,7 +358,7 @@ testthat::test_that("e2e - tm_a_mmrm: Validate output on different selection.", ) for (func in output_functions) { - test_no_validation_error(app_driver, "output_function", func) + app_driver$set_active_module_input("output_function", func) switch(func, t_mmrm_lsmeans = { From 14ac82926dffcf62253fb83b5139b01fa52455c7 Mon Sep 17 00:00:00 2001 From: unknown Date: Fri, 26 Apr 2024 19:16:15 +0530 Subject: [PATCH 14/23] using ns_des_input --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index 904127bed5..9f97d4592d 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -65,10 +65,6 @@ app_driver_tm_a_mmrm <- function() { # nolint: object_length. ) } -ns_dataset <- function(prefix, suffix, dataset, extract = "singleextract") { - sprintf("%s-dataset_%s_%s-%s", prefix, dataset, extract, suffix) -} - testthat::test_that("e2e - tm_a_mmrm: Module initializes in teal without errors.", { skip_if_too_deep(5) @@ -169,11 +165,13 @@ testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output for (func in output_functions) { app_driver$set_active_module_input("output_function", func) + app_driver$expect_no_validation_error() switch(func, t_mmrm_lsmeans = { 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() }, g_mmrm_lsmeans = { plot_before <- app_driver$get_active_module_pws_output("mmrm_plot") @@ -247,7 +245,7 @@ testthat::test_that( app_driver$active_module_element_text( sprintf( "%s .shiny-validation-message", - ns_dataset("aval_var", "select_input", "ADQS") + ns_des_input("aval_var", "ADQS", "select_input") ) ), "Analysis Variable' field is not selected" @@ -259,7 +257,7 @@ testthat::test_that( app_driver$active_module_element_text( sprintf( "%s .shiny-validation-message", - ns_dataset("paramcd", "filter1-vals_input", "ADQS") + ns_des_input("paramcd", "ADQS", "filter1-vals_input") ) ), "Select Endpoint' field is not selected" @@ -271,7 +269,7 @@ testthat::test_that( app_driver$active_module_element_text( sprintf( "%s .shiny-validation-message", - ns_dataset("visit_var", "select_input", "ADQS") + ns_des_input("visit_var", "ADQS", "select_input") ) ), "Visit Variable' field is not selected" @@ -283,7 +281,7 @@ testthat::test_that( app_driver$active_module_element_text( sprintf( "%s .shiny-validation-message", - ns_dataset("arm_var", "select_input", "ADSL") + ns_des_input("arm_var", "ADSL", "select_input") ) ), "Treatment variable must be selected" @@ -295,7 +293,7 @@ testthat::test_that( app_driver$active_module_element_text( sprintf( "%s .shiny-validation-message", - ns_dataset("id_var", "select_input", "ADQS") + ns_des_input("id_var", "ADQS", "select_input") ) ), "Subject Identifier' field is not selected" From b8bf9387d6719a391540ae259d9e8441f44857b0 Mon Sep 17 00:00:00 2001 From: unknown Date: Tue, 30 Apr 2024 13:08:43 +0530 Subject: [PATCH 15/23] @vedha suggestions for description and order of func --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index 9f97d4592d..5cdc52ec0c 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -65,7 +65,7 @@ app_driver_tm_a_mmrm <- function() { # nolint: object_length. ) } -testthat::test_that("e2e - tm_a_mmrm: Module initializes in teal without errors.", { +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() @@ -81,9 +81,9 @@ testthat::test_that("e2e - tm_a_mmrm: Module initializes in teal without errors. testthat::test_that( paste0( - "e2e - tm_a_mmrm: Module initializes with specified label,analysis variable, select endpoint,", - "visit variable, covariates,select treatment variable, subject identifier, weights for ls means,", - "correlation structure, adjustment method and confidence level" + "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) @@ -155,8 +155,8 @@ testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output # Check and set different outputs and validate their effects output_functions <- c( - "g_mmrm_lsmeans", "t_mmrm_lsmeans", + "g_mmrm_lsmeans", "t_mmrm_cov", "t_mmrm_fixed", "t_mmrm_diagnostic", @@ -164,7 +164,7 @@ testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output ) for (func in output_functions) { - app_driver$set_active_module_input("output_function", func) + app_driver$set_active_module_input("output_function", func, wait_ = FALSE) app_driver$expect_no_validation_error() switch(func, @@ -231,8 +231,8 @@ testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output testthat::test_that( paste0( - "e2e - tm_a_mmrm: Deselection of analysis variable, select endpoint,", - "visit variable, select treatment variable, subject identifier and confidence level" + "e2e - tm_a_mmrm: Deselection of aval_var, paramcd,", + "visit_var, arm_var, id_var and conf_level" ), { skip_if_too_deep(5) @@ -347,8 +347,8 @@ testthat::test_that("e2e - tm_a_mmrm: Validate output on different selection.", # Check and set different outputs and validate their effects output_functions <- c( - "g_mmrm_lsmeans", "t_mmrm_lsmeans", + "g_mmrm_lsmeans", "t_mmrm_cov", "t_mmrm_fixed", "t_mmrm_diagnostic", @@ -356,7 +356,7 @@ testthat::test_that("e2e - tm_a_mmrm: Validate output on different selection.", ) for (func in output_functions) { - app_driver$set_active_module_input("output_function", func) + app_driver$set_active_module_input("output_function", func, wait_ = FALSE) switch(func, t_mmrm_lsmeans = { From 38f3ebfb2994cf7b62cc388daaeb711be373dce1 Mon Sep 17 00:00:00 2001 From: unknown Date: Tue, 30 Apr 2024 13:23:59 +0530 Subject: [PATCH 16/23] @vedhav suggestions --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 26 ++++++++-------------- 1 file changed, 9 insertions(+), 17 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index 5cdc52ec0c..bec81be92d 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -146,7 +146,11 @@ testthat::test_that("e2e - tm_a_mmrm: Click on fit model shows table for default app_driver$stop() }) -testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output settings.", { +testthat::test_that( + paste0( + "e2e - tm_a_mmrm: Output type selection shows dynamic output settings; changing", + "settings throws no validation errors and verify visibility of generated plots or tables." + ), { skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() @@ -199,14 +203,8 @@ testthat::test_that("e2e - tm_a_mmrm: Output type selection shows dynamic output testthat::expect_false(identical(plot_before, plot)) }, - t_mmrm_cov = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - }, - t_mmrm_fixed = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - }, + t_mmrm_cov = , + t_mmrm_fixed = , t_mmrm_diagnostic = { table <- app_driver$get_active_module_tws_output("mmrm_table") testthat::expect_gt(nrow(table), 1) @@ -367,14 +365,8 @@ testthat::test_that("e2e - tm_a_mmrm: Validate output on different selection.", plot <- app_driver$get_active_module_pws_output("mmrm_plot") testthat::expect_match(plot, "data:image/png;base64,") }, - t_mmrm_cov = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - }, - t_mmrm_fixed = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - }, + t_mmrm_cov = , + t_mmrm_fixed = , t_mmrm_diagnostic = { table <- app_driver$get_active_module_tws_output("mmrm_table") testthat::expect_gt(nrow(table), 1) From 31fc40c59eed4f6fdfbbae175baefea7c3ed6aa5 Mon Sep 17 00:00:00 2001 From: unknown Date: Tue, 30 Apr 2024 18:12:05 +0530 Subject: [PATCH 17/23] iteration over selection --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 304 +++++++++++---------- 1 file changed, 166 insertions(+), 138 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index bec81be92d..b12e853989 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -65,19 +65,25 @@ app_driver_tm_a_mmrm <- function() { # nolint: object_length. ) } -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) +testthat::test_that( + paste0( + "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() - app_driver$expect_no_shiny_error() - app_driver$expect_no_validation_error() + app_driver <- app_driver_tm_a_mmrm() + app_driver$expect_no_shiny_error() + app_driver$expect_no_validation_error() - null_text <- app_driver$active_module_element_text("null_input_msg") + 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'") + testthat::expect_match(null_text, "Please first specify 'Model Settings' and press 'Fit Model'") - app_driver$stop() -}) + app_driver$stop() + } +) testthat::test_that( paste0( @@ -150,82 +156,84 @@ testthat::test_that( paste0( "e2e - tm_a_mmrm: Output type selection shows dynamic output settings; changing", "settings throws no validation errors and verify visibility of generated plots or 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() - - # Check and set different outputs and validate their effects - output_functions <- c( - "t_mmrm_lsmeans", - "g_mmrm_lsmeans", - "t_mmrm_cov", - "t_mmrm_fixed", - "t_mmrm_diagnostic", - "g_mmrm_diagnostic" - ) + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() - for (func in output_functions) { - app_driver$set_active_module_input("output_function", func, wait_ = FALSE) + app_driver$click(selector = app_driver$active_module_element("button_start")) app_driver$expect_no_validation_error() - switch(func, - t_mmrm_lsmeans = { - 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() - }, - g_mmrm_lsmeans = { - plot_before <- app_driver$get_active_module_pws_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_pws_output("mmrm_plot") - testthat::expect_match(plot, "data:image/png;base64,") - - testthat::expect_false(identical(plot_before, plot)) - }, - t_mmrm_cov = , - t_mmrm_fixed = , - t_mmrm_diagnostic = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - }, - g_mmrm_diagnostic = { - plot_before <- app_driver$get_active_module_pws_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() + # Check and set different outputs and validate their effects + output_functions <- c( + "t_mmrm_lsmeans", + "g_mmrm_lsmeans", + "t_mmrm_cov", + "t_mmrm_fixed", + "t_mmrm_diagnostic", + "g_mmrm_diagnostic" + ) - plot <- app_driver$get_active_module_pws_output("mmrm_plot") - testthat::expect_match(plot, "data:image/png;base64,") + for (func in output_functions) { + app_driver$set_active_module_input("output_function", func, wait_ = FALSE) + app_driver$expect_no_validation_error() + + switch(func, + t_mmrm_lsmeans = { + 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() + }, + g_mmrm_lsmeans = { + plot_before <- app_driver$get_active_module_pws_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_pws_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") + + testthat::expect_false(identical(plot_before, plot)) + }, + t_mmrm_cov = , + t_mmrm_fixed = , + t_mmrm_diagnostic = { + table <- app_driver$get_active_module_tws_output("mmrm_table") + testthat::expect_gt(nrow(table), 1) + }, + g_mmrm_diagnostic = { + plot_before <- app_driver$get_active_module_pws_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_pws_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") + + testthat::expect_false(identical(plot_before, plot)) + } + ) + } - testthat::expect_false(identical(plot_before, plot)) - } - ) + app_driver$stop() } - - app_driver$stop() -}) +) testthat::test_that( paste0( @@ -313,70 +321,90 @@ testthat::test_that( } ) -testthat::test_that("e2e - tm_a_mmrm: Validate output on different selection.", { - skip_if_too_deep(5) - app_driver <- app_driver_tm_a_mmrm() - - app_driver$set_active_module_input("aval_var-dataset_ADQS_singleextract-select", "CHG") - app_driver$expect_no_validation_error() - app_driver$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", "BFIALL") - app_driver$expect_no_validation_error() - app_driver$set_active_module_input("visit_var-dataset_ADQS_singleextract-select", "AVISITN") - app_driver$expect_no_validation_error() - app_driver$set_active_module_input("cov_var-dataset_ADQS_singleextract-select", "AGE") - app_driver$expect_no_validation_error() - app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-select", "ARMCD") - app_driver$expect_no_validation_error() - app_driver$set_active_module_input("combine_comp_arms", TRUE) - app_driver$expect_no_validation_error() - app_driver$set_active_module_input("id_var-dataset_ADQS_singleextract-select", "SUBJID") - app_driver$expect_no_validation_error() - app_driver$set_active_module_input("weights_emmeans", "equal") - app_driver$expect_no_validation_error() - app_driver$set_active_module_input("cor_struct", "ante-dependence") - app_driver$expect_no_validation_error() - app_driver$set_active_module_input("conf_level", "0.8") - app_driver$expect_no_validation_error() - app_driver$set_active_module_input("method", "Kenward-Roger") - app_driver$expect_no_validation_error() +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" +) - app_driver$click(selector = app_driver$active_module_element("button_start")) - app_driver$expect_no_validation_error() +output_functions <- c( + "t_mmrm_lsmeans", + "g_mmrm_lsmeans", + "t_mmrm_cov", + "t_mmrm_fixed", + "t_mmrm_diagnostic", + "g_mmrm_diagnostic" +) - # Check and set different outputs and validate their effects - output_functions <- c( - "t_mmrm_lsmeans", - "g_mmrm_lsmeans", - "t_mmrm_cov", - "t_mmrm_fixed", - "t_mmrm_diagnostic", - "g_mmrm_diagnostic" +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 - for (func in output_functions) { +# Iterate over each output function +for (func in output_functions) { + testthat::test_that(paste0("e2e - tm_a_mmrm: Validate output on different selection on method ", func), { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + app_driver$click(selector = app_driver$active_module_element("button_start")) + # 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_pws_output("mmrm_plot") + } else { + table_before <- app_driver$get_active_module_tws_output("mmrm_table") + } - switch(func, - t_mmrm_lsmeans = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - }, - g_mmrm_lsmeans = { - plot <- app_driver$get_active_module_pws_output("mmrm_plot") - testthat::expect_match(plot, "data:image/png;base64,") - }, - t_mmrm_cov = , - t_mmrm_fixed = , - t_mmrm_diagnostic = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - }, - g_mmrm_diagnostic = { - plot <- app_driver$get_active_module_pws_output("mmrm_plot") - testthat::expect_match(plot, "data:image/png;base64,") + # 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$stop() -}) + 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_pws_output("mmrm_plot") + ), + info = print(paste(func, "===", input_name)) + ) + plot_before <- app_driver$get_active_module_pws_output("mmrm_plot") + } else { + testthat::expect_false( + identical( + table_before, + app_driver$get_active_module_tws_output("mmrm_table") + ) + ) + } + } + app_driver$stop() + }) +} From 32f1b6f1d432419040b04efa86f1507720d74959 Mon Sep 17 00:00:00 2001 From: unknown Date: Tue, 30 Apr 2024 19:08:40 +0530 Subject: [PATCH 18/23] adding validation test for deselection --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 310 ++++++++++++++------- 1 file changed, 214 insertions(+), 96 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index b12e853989..8c56092b4e 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -65,6 +65,15 @@ app_driver_tm_a_mmrm <- function() { # nolint: object_length. ) } +output_functions <- c( + "t_mmrm_lsmeans", + "g_mmrm_lsmeans", + "t_mmrm_cov", + "t_mmrm_fixed", + "t_mmrm_diagnostic", + "g_mmrm_diagnostic" +) + testthat::test_that( paste0( "e2e - tm_a_mmrm: Module initializes in teal without errors ", @@ -164,16 +173,6 @@ testthat::test_that( app_driver$click(selector = app_driver$active_module_element("button_start")) app_driver$expect_no_validation_error() - # Check and set different outputs and validate their effects - output_functions <- c( - "t_mmrm_lsmeans", - "g_mmrm_lsmeans", - "t_mmrm_cov", - "t_mmrm_fixed", - "t_mmrm_diagnostic", - "g_mmrm_diagnostic" - ) - for (func in output_functions) { app_driver$set_active_module_input("output_function", func, wait_ = FALSE) app_driver$expect_no_validation_error() @@ -235,91 +234,219 @@ testthat::test_that( } ) -testthat::test_that( - paste0( - "e2e - tm_a_mmrm: Deselection of aval_var, paramcd,", - "visit_var, arm_var, id_var and conf_level" - ), - { - skip_if_too_deep(5) - app_driver <- app_driver_tm_a_mmrm() +for (func in output_functions) { + testthat::test_that( + paste0( + "e2e - tm_a_mmrm: Deselection of aval_var in method ", + func + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + app_driver$click(selector = app_driver$active_module_element("button_start")) + # 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)) - app_driver$expect_validation_error() - 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$set_active_module_input("paramcd-dataset_ADQS_singleextract-filter1-vals", character(0L)) - app_driver$expect_validation_error() - 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$set_active_module_input("visit_var-dataset_ADQS_singleextract-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("visit_var", "ADQS", "select_input") - ) - ), - "Visit Variable' field is not selected" - ) + 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_pws_output("mmrm_plot"), character(0)) + } else { + testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), character(0)) + } - app_driver$set_active_module_input("arm_var-dataset_ADSL_singleextract-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("arm_var", "ADSL", "select_input") - ) - ), - "Treatment variable must be selected" - ) + 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() - app_driver$set_active_module_input("id_var-dataset_ADQS_singleextract-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("id_var", "ADQS", "select_input") - ) - ), - "Subject Identifier' field is not selected" - ) + }) - app_driver$set_active_module_input("conf_level", numeric(0L)) - app_driver$expect_validation_error() - testthat::expect_match( - app_driver$active_module_element_text( - sprintf( - "%s .shiny-validation-message", - "conf_level_input" - ) - ), - "Confidence Level' field is not selected" - ) + testthat::test_that( + paste0( + "e2e - tm_a_mmrm: Deselection paramcd in method ", + func + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() - app_driver$stop() - } -) + app_driver$click(selector = app_driver$active_module_element("button_start")) + # 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_pws_output("mmrm_plot"), character(0)) + } else { + testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), character(0)) + } + + 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( + paste0( + "e2e - tm_a_mmrm: Deselection of visit_var in method ", + func + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + + app_driver$click(selector = app_driver$active_module_element("button_start")) + # 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_pws_output("mmrm_plot"), character(0)) + } else { + testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), character(0)) + } + + 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( + paste0( + "e2e - tm_a_mmrm: Deselection of arm_var in method ", + func + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + + app_driver$click(selector = app_driver$active_module_element("button_start")) + # 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_pws_output("mmrm_plot"), character(0)) + } else { + testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), character(0)) + } + + 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( + paste0( + "e2e - tm_a_mmrm: Deselection of id_var in method ", + func + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + + app_driver$click(selector = app_driver$active_module_element("button_start")) + # 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_pws_output("mmrm_plot"), character(0)) + } else { + testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), character(0)) + } + + 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( + paste0( + "e2e - tm_a_mmrm: Deselection of conf_level in method ", + func + ), + { + skip_if_too_deep(5) + app_driver <- app_driver_tm_a_mmrm() + + app_driver$click(selector = app_driver$active_module_element("button_start")) + # 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_pws_output("mmrm_plot"), character(0)) + } else { + testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), character(0)) + } + + 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", @@ -335,15 +462,6 @@ input_list <- list( "method" = "Kenward-Roger" ) -output_functions <- c( - "t_mmrm_lsmeans", - "g_mmrm_lsmeans", - "t_mmrm_cov", - "t_mmrm_fixed", - "t_mmrm_diagnostic", - "g_mmrm_diagnostic" -) - non_responsive_conditions <- list( "g_mmrm_lsmeans" = c("id_var-dataset_ADQS_singleextract-select"), "g_mmrm_diagnostic" = c( From 3ca5ec13f38801f98c5ec8ac0b2d130bae47001c Mon Sep 17 00:00:00 2001 From: unknown Date: Tue, 30 Apr 2024 19:25:09 +0530 Subject: [PATCH 19/23] @vedhav suggestions on validation error tests --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 50 +++++++++++----------- 1 file changed, 24 insertions(+), 26 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index 8c56092b4e..dd3d9aadbe 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -237,7 +237,7 @@ testthat::test_that( for (func in output_functions) { testthat::test_that( paste0( - "e2e - tm_a_mmrm: Deselection of aval_var in method ", + "e2e - tm_a_mmrm: Deselection of aval_var throws validation error in method", func ), { @@ -249,13 +249,11 @@ for (func in output_functions) { 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_pws_output("mmrm_plot"), character(0)) } else { - testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), character(0)) + testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), data.frame()) } testthat::expect_match( @@ -269,12 +267,12 @@ for (func in output_functions) { ) app_driver$expect_validation_error() app_driver$stop() - - }) + } + ) testthat::test_that( paste0( - "e2e - tm_a_mmrm: Deselection paramcd in method ", + "e2e - tm_a_mmrm: Deselection paramcd throws validation error in method", func ), { @@ -290,7 +288,7 @@ for (func in output_functions) { if (grepl("^g_", func)) { testthat::expect_identical(app_driver$get_active_module_pws_output("mmrm_plot"), character(0)) } else { - testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), character(0)) + testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), data.frame()) } testthat::expect_match( @@ -304,12 +302,12 @@ for (func in output_functions) { ) app_driver$expect_validation_error() app_driver$stop() - - }) + } + ) testthat::test_that( paste0( - "e2e - tm_a_mmrm: Deselection of visit_var in method ", + "e2e - tm_a_mmrm: Deselection of visit_var throws validation error in method", func ), { @@ -325,7 +323,7 @@ for (func in output_functions) { if (grepl("^g_", func)) { testthat::expect_identical(app_driver$get_active_module_pws_output("mmrm_plot"), character(0)) } else { - testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), character(0)) + testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), data.frame()) } testthat::expect_match( @@ -339,12 +337,12 @@ for (func in output_functions) { ) app_driver$expect_validation_error() app_driver$stop() - - }) + } + ) testthat::test_that( paste0( - "e2e - tm_a_mmrm: Deselection of arm_var in method ", + "e2e - tm_a_mmrm: Deselection of arm_var throws validation error in method", func ), { @@ -360,7 +358,7 @@ for (func in output_functions) { if (grepl("^g_", func)) { testthat::expect_identical(app_driver$get_active_module_pws_output("mmrm_plot"), character(0)) } else { - testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), character(0)) + testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), data.frame()) } testthat::expect_match( @@ -374,12 +372,12 @@ for (func in output_functions) { ) app_driver$expect_validation_error() app_driver$stop() - - }) + } + ) testthat::test_that( paste0( - "e2e - tm_a_mmrm: Deselection of id_var in method ", + "e2e - tm_a_mmrm: Deselection of id_var throws validation error in method", func ), { @@ -395,7 +393,7 @@ for (func in output_functions) { if (grepl("^g_", func)) { testthat::expect_identical(app_driver$get_active_module_pws_output("mmrm_plot"), character(0)) } else { - testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), character(0)) + testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), data.frame()) } testthat::expect_match( @@ -409,12 +407,12 @@ for (func in output_functions) { ) app_driver$expect_validation_error() app_driver$stop() - - }) + } + ) testthat::test_that( paste0( - "e2e - tm_a_mmrm: Deselection of conf_level in method ", + "e2e - tm_a_mmrm: Deselection of conf_level throws validation error in method", func ), { @@ -430,7 +428,7 @@ for (func in output_functions) { if (grepl("^g_", func)) { testthat::expect_identical(app_driver$get_active_module_pws_output("mmrm_plot"), character(0)) } else { - testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), character(0)) + testthat::expect_identical(app_driver$get_active_module_tws_output("mmrm_table"), data.frame()) } testthat::expect_match( @@ -444,8 +442,8 @@ for (func in output_functions) { ) app_driver$expect_validation_error() app_driver$stop() - - }) + } + ) } input_list <- list( From fedf2709f3fcbcb071afad1d502f85189ea573ee Mon Sep 17 00:00:00 2001 From: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Date: Fri, 3 May 2024 20:04:36 +0530 Subject: [PATCH 20/23] Add `fit_model` to `app_driver_tm_a_mmrm` (#1176) Add `fit_model` to `app_driver_tm_a_mmrm` so that the click automatically happens when the app driver is created --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 28 +++++++--------------- 1 file changed, 8 insertions(+), 20 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index dd3d9aadbe..de81b32e11 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -1,4 +1,4 @@ -app_driver_tm_a_mmrm <- function() { # nolint: object_length. +app_driver_tm_a_mmrm <- function(fit_model = TRUE) { # nolint: object_length. arm_ref_comp <- list( ARMCD = list( ref = "ARM B", @@ -27,7 +27,7 @@ app_driver_tm_a_mmrm <- function() { # nolint: object_length. arm_var <- choices_selected(c("ARM", "ARMCD"), "ARM") - init_teal_app_driver( + app_driver <- init_teal_app_driver( data = data, modules = tm_a_mmrm( label = "MMRM", @@ -63,6 +63,10 @@ app_driver_tm_a_mmrm <- function() { # nolint: object_length. ), timeout = 30000 ) + if (fit_model) { + app_driver$click(selector = app_driver$active_module_element("button_start")) + } + app_driver } output_functions <- c( @@ -82,7 +86,7 @@ testthat::test_that( { skip_if_too_deep(5) - app_driver <- app_driver_tm_a_mmrm() + app_driver <- app_driver_tm_a_mmrm(FALSE) app_driver$expect_no_shiny_error() app_driver$expect_no_validation_error() @@ -102,7 +106,7 @@ testthat::test_that( ), { skip_if_too_deep(5) - app_driver <- app_driver_tm_a_mmrm() + 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") @@ -150,7 +154,6 @@ testthat::test_that( 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$click(selector = app_driver$active_module_element("button_start")) app_driver$expect_no_validation_error() table <- app_driver$get_active_module_tws_output("mmrm_table") @@ -169,8 +172,6 @@ testthat::test_that( { 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() for (func in output_functions) { @@ -243,8 +244,6 @@ for (func in output_functions) { { skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() - - app_driver$click(selector = app_driver$active_module_element("button_start")) # Set initial output function app_driver$set_active_module_input("output_function", func, wait_ = FALSE) app_driver$expect_no_validation_error() @@ -278,8 +277,6 @@ for (func in output_functions) { { skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() - - app_driver$click(selector = app_driver$active_module_element("button_start")) # Set initial output function app_driver$set_active_module_input("output_function", func, wait_ = FALSE) app_driver$expect_no_validation_error() @@ -313,8 +310,6 @@ for (func in output_functions) { { skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() - - app_driver$click(selector = app_driver$active_module_element("button_start")) # Set initial output function app_driver$set_active_module_input("output_function", func, wait_ = FALSE) app_driver$expect_no_validation_error() @@ -348,8 +343,6 @@ for (func in output_functions) { { skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() - - app_driver$click(selector = app_driver$active_module_element("button_start")) # Set initial output function app_driver$set_active_module_input("output_function", func, wait_ = FALSE) app_driver$expect_no_validation_error() @@ -383,8 +376,6 @@ for (func in output_functions) { { skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() - - app_driver$click(selector = app_driver$active_module_element("button_start")) # Set initial output function app_driver$set_active_module_input("output_function", func, wait_ = FALSE) app_driver$expect_no_validation_error() @@ -418,8 +409,6 @@ for (func in output_functions) { { skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() - - app_driver$click(selector = app_driver$active_module_element("button_start")) # Set initial output function app_driver$set_active_module_input("output_function", func, wait_ = FALSE) app_driver$expect_no_validation_error() @@ -480,7 +469,6 @@ for (func in output_functions) { testthat::test_that(paste0("e2e - tm_a_mmrm: Validate output on different selection on method ", func), { skip_if_too_deep(5) app_driver <- app_driver_tm_a_mmrm() - app_driver$click(selector = app_driver$active_module_element("button_start")) # Set initial output function app_driver$set_active_module_input("output_function", func, wait_ = FALSE) app_driver$expect_no_validation_error() From a95c3479a0d4638413bc8e5c21a42ec976cc443b Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 6 May 2024 14:00:06 +0530 Subject: [PATCH 21/23] @vedhav suggestion --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 124 ++++++++++++--------- 1 file changed, 72 insertions(+), 52 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index de81b32e11..a1fe07a8d1 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -166,74 +166,94 @@ testthat::test_that("e2e - tm_a_mmrm: Click on fit model shows table for default testthat::test_that( paste0( - "e2e - tm_a_mmrm: Output type selection shows dynamic output settings; changing", - "settings throws no validation errors and verify visibility of generated plots or tables." + "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() - for (func in output_functions) { - app_driver$set_active_module_input("output_function", func, wait_ = FALSE) - 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() - switch(func, - t_mmrm_lsmeans = { - 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() - }, - g_mmrm_lsmeans = { - plot_before <- app_driver$get_active_module_pws_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() + 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() + }) - app_driver$set_active_module_input("g_mmrm_lsmeans_width", 0.9) - app_driver$expect_no_validation_error() +testthat::test_that( + paste0( + "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$set_active_module_input("g_mmrm_lsmeans_contrasts_show_pval", TRUE) - app_driver$expect_no_validation_error() + app_driver$click(selector = app_driver$active_module_element("button_start")) + app_driver$expect_no_validation_error() - plot <- app_driver$get_active_module_pws_output("mmrm_plot") - testthat::expect_match(plot, "data:image/png;base64,") + app_driver$set_active_module_input("output_function", "g_mmrm_lsmeans", wait_ = FALSE) + app_driver$expect_no_validation_error() - testthat::expect_false(identical(plot_before, plot)) - }, - t_mmrm_cov = , - t_mmrm_fixed = , - t_mmrm_diagnostic = { - table <- app_driver$get_active_module_tws_output("mmrm_table") - testthat::expect_gt(nrow(table), 1) - }, - g_mmrm_diagnostic = { - plot_before <- app_driver$get_active_module_pws_output("mmrm_plot") - testthat::expect_match(plot_before, "data:image/png;base64,") + plot_before <- app_driver$get_active_module_pws_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() + 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() - plot <- app_driver$get_active_module_pws_output("mmrm_plot") - testthat::expect_match(plot, "data:image/png;base64,") + app_driver$set_active_module_input( + "g_mmrm_lsmeans_select", + c("estimates", "contrasts") + ) + app_driver$expect_no_validation_error() - testthat::expect_false(identical(plot_before, plot)) - } - ) - } + 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_pws_output("mmrm_plot") + testthat::expect_match(plot, "data:image/png;base64,") + + testthat::expect_false(identical(plot_before, plot)) app_driver$stop() - } -) + }) + +testthat::test_that( + paste0( + "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_pws_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_pws_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( From 43cd1677864c4707e4b563e8ef98051a3bcf1bcf Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 6 May 2024 14:02:29 +0530 Subject: [PATCH 22/23] @vedhav suggestions. --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index a1fe07a8d1..9f5a2772d2 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -159,7 +159,7 @@ testthat::test_that("e2e - tm_a_mmrm: Click on fit model shows table for default table <- app_driver$get_active_module_tws_output("mmrm_table") col_val <- app_driver$get_active_module_input("buckets") testthat::expect_true(all(unlist(col_val, use.names = FALSE) %in% colnames(table))) - testthat::expect_gte(nrow(table), 25) + testthat::expect_equal(nrow(table), 25) app_driver$stop() }) From 680bb70bdcaff454fc6a404fb2e1f819b95b28fa Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 6 May 2024 15:44:50 +0530 Subject: [PATCH 23/23] fix styling --- tests/testthat/test-shinytest2-tm_a_mmrm.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_a_mmrm.R b/tests/testthat/test-shinytest2-tm_a_mmrm.R index 9f5a2772d2..72f452252a 100644 --- a/tests/testthat/test-shinytest2-tm_a_mmrm.R +++ b/tests/testthat/test-shinytest2-tm_a_mmrm.R @@ -183,7 +183,8 @@ testthat::test_that( app_driver$set_active_module_input("t_mmrm_lsmeans_show_relative", "increase") app_driver$expect_no_validation_error() app_driver$stop() - }) + } +) testthat::test_that( paste0( @@ -225,7 +226,8 @@ testthat::test_that( testthat::expect_false(identical(plot_before, plot)) app_driver$stop() - }) + } +) testthat::test_that( paste0( @@ -253,7 +255,8 @@ testthat::test_that( testthat::expect_false(identical(plot_before, plot)) app_driver$stop() - }) + } +) for (func in output_functions) { testthat::test_that(