From 34ff685d0040a5fb251394f46499c1ae3b4f990f Mon Sep 17 00:00:00 2001 From: Marcin <133694481+m7pr@users.noreply.github.com> Date: Tue, 26 Nov 2024 11:03:06 +0100 Subject: [PATCH] 1248 Fix shinytest2 tests (#1251) Fix #1248, close #1249 --- R/tm_a_gee.R | 2 +- R/tm_a_mmrm.R | 2 +- R/tm_g_forest_rsp.R | 2 +- R/tm_g_forest_tte.R | 2 +- R/tm_g_ipp.R | 2 +- R/tm_g_km.R | 2 +- R/tm_g_lineplot.R | 2 +- R/tm_g_pp_therapy.R | 2 +- R/tm_g_pp_vitals.R | 2 +- R/tm_t_abnormality.R | 2 +- R/tm_t_abnormality_by_worst_grade.R | 2 +- R/tm_t_ancova.R | 2 +- R/tm_t_binary_outcome.R | 2 +- R/tm_t_events.R | 2 +- R/tm_t_events_by_grade.R | 2 +- R/tm_t_events_patyear.R | 2 +- R/tm_t_events_summary.R | 2 +- R/tm_t_exposure.R | 2 +- R/tm_t_mult_events.R | 2 +- R/tm_t_pp_basic_info.R | 2 +- R/tm_t_pp_medical_history.R | 2 +- R/tm_t_pp_prior_medication.R | 2 +- R/tm_t_shift_by_arm.R | 2 +- R/tm_t_shift_by_arm_by_worst.R | 2 +- R/tm_t_shift_by_grade.R | 2 +- R/tm_t_smq.R | 2 +- R/tm_t_summary.R | 2 +- R/tm_t_summary_by.R | 2 +- R/tm_t_tte.R | 2 +- .../test-shinytest2-tm_g_pp_therapy.R | 466 +++++++++--------- 30 files changed, 262 insertions(+), 262 deletions(-) diff --git a/R/tm_a_gee.R b/R/tm_a_gee.R index 9b6ef1cac..8426a7266 100644 --- a/R/tm_a_gee.R +++ b/R/tm_a_gee.R @@ -531,7 +531,7 @@ srv_gee <- function(id, cor_struct = input$cor_struct, basic_table_args = basic_table_args ) - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) output$gee_title <- renderText({ diff --git a/R/tm_a_mmrm.R b/R/tm_a_mmrm.R index 402e335bb..59039b41c 100644 --- a/R/tm_a_mmrm.R +++ b/R/tm_a_mmrm.R @@ -1244,7 +1244,7 @@ srv_mmrm <- function(id, weights_emmeans = input$weights_emmeans, parallel = input$parallel ) - teal.code::eval_code(qenv, as.expression(my_calls)) + teal.code::eval_code(qenv, as.expression(unlist(my_calls))) }) output$mmrm_title <- renderText({ diff --git a/R/tm_g_forest_rsp.R b/R/tm_g_forest_rsp.R index 862327801..27fadd25e 100644 --- a/R/tm_g_forest_rsp.R +++ b/R/tm_g_forest_rsp.R @@ -758,7 +758,7 @@ srv_g_forest_rsp <- function(id, ggplot2_args = ggplot2_args ) - teal.code::eval_code(anl_q(), as.expression(my_calls)) + teal.code::eval_code(anl_q(), as.expression(unlist(my_calls))) }) plot_r <- reactive(all_q()[["p"]]) diff --git a/R/tm_g_forest_tte.R b/R/tm_g_forest_tte.R index e283937d0..f4c3c86f4 100644 --- a/R/tm_g_forest_tte.R +++ b/R/tm_g_forest_tte.R @@ -687,7 +687,7 @@ srv_g_forest_tte <- function(id, font_size = input$font_size, ggplot2_args = ggplot2_args ) - teal.code::eval_code(anl_q(), as.expression(my_calls)) + teal.code::eval_code(anl_q(), as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_g_ipp.R b/R/tm_g_ipp.R index 221ea2413..3c6a7be5f 100644 --- a/R/tm_g_ipp.R +++ b/R/tm_g_ipp.R @@ -607,7 +607,7 @@ srv_g_ipp <- function(id, ggplot2_args = ggplot2_args, add_avalu = input$add_avalu ) - teal.code::eval_code(anl_q(), as.expression(my_calls)) + teal.code::eval_code(anl_q(), as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_g_km.R b/R/tm_g_km.R index 55be3c1dc..861baab81 100644 --- a/R/tm_g_km.R +++ b/R/tm_g_km.R @@ -806,7 +806,7 @@ srv_g_km <- function(id, ci_ribbon = input$show_ci_ribbon, title = title ) - teal.code::eval_code(anl_q(), as.expression(my_calls)) + teal.code::eval_code(anl_q(), as.expression(unlist(my_calls))) }) plot_r <- reactive(all_q()[["plot"]]) diff --git a/R/tm_g_lineplot.R b/R/tm_g_lineplot.R index 2afe8e511..ac4b5f5e4 100644 --- a/R/tm_g_lineplot.R +++ b/R/tm_g_lineplot.R @@ -628,7 +628,7 @@ srv_g_lineplot <- function(id, table_font_size = input$table_font_size, ggplot2_args = ggplot2_args ) - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) plot_r <- reactive(all_q()[["plot"]]) diff --git a/R/tm_g_pp_therapy.R b/R/tm_g_pp_therapy.R index d9e5bfb1d..ca6b9cb3c 100644 --- a/R/tm_g_pp_therapy.R +++ b/R/tm_g_pp_therapy.R @@ -666,7 +666,7 @@ srv_g_therapy <- function(id, ) ) ) %>% - teal.code::eval_code(as.expression(my_calls)) + teal.code::eval_code(as.expression(unlist(my_calls))) }) output$title <- renderText({ diff --git a/R/tm_g_pp_vitals.R b/R/tm_g_pp_vitals.R index 9924cbf00..8721b153a 100644 --- a/R/tm_g_pp_vitals.R +++ b/R/tm_g_pp_vitals.R @@ -550,7 +550,7 @@ srv_g_vitals <- function(id, ) ) ) %>% - teal.code::eval_code(as.expression(my_calls)) + teal.code::eval_code(as.expression(unlist(my_calls))) }) plot_r <- reactive(all_q()[["result_plot"]]) diff --git a/R/tm_t_abnormality.R b/R/tm_t_abnormality.R index 9ee8b9926..fa24c9727 100644 --- a/R/tm_t_abnormality.R +++ b/R/tm_t_abnormality.R @@ -641,7 +641,7 @@ srv_t_abnormality <- function(id, tbl_title = tbl_title ) - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_t_abnormality_by_worst_grade.R b/R/tm_t_abnormality_by_worst_grade.R index a92c3b5ec..979f7ea58 100644 --- a/R/tm_t_abnormality_by_worst_grade.R +++ b/R/tm_t_abnormality_by_worst_grade.R @@ -661,7 +661,7 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. basic_table_args = basic_table_args ) - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_t_ancova.R b/R/tm_t_ancova.R index d910897bb..9a5efebc0 100644 --- a/R/tm_t_ancova.R +++ b/R/tm_t_ancova.R @@ -937,7 +937,7 @@ srv_ancova <- function(id, conf_level = as.numeric(input$conf_level), basic_table_args = basic_table_args ) - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) # Output to render. diff --git a/R/tm_t_binary_outcome.R b/R/tm_t_binary_outcome.R index 9d5f09f3b..43c7b0a0f 100644 --- a/R/tm_t_binary_outcome.R +++ b/R/tm_t_binary_outcome.R @@ -992,7 +992,7 @@ srv_t_binary_outcome <- function(id, basic_table_args = basic_table_args ) - teal.code::eval_code(qenv, as.expression(my_calls)) + teal.code::eval_code(qenv, as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_t_events.R b/R/tm_t_events.R index 7236a0e56..c5b353a80 100644 --- a/R/tm_t_events.R +++ b/R/tm_t_events.R @@ -805,7 +805,7 @@ srv_t_events_byterm <- function(id, basic_table_args = basic_table_args ) - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_t_events_by_grade.R b/R/tm_t_events_by_grade.R index 664f1a8a8..f0b01a543 100644 --- a/R/tm_t_events_by_grade.R +++ b/R/tm_t_events_by_grade.R @@ -1199,7 +1199,7 @@ srv_t_events_by_grade <- function(id, basic_table_args = basic_table_args ) } - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_t_events_patyear.R b/R/tm_t_events_patyear.R index ee0b3a754..301cae730 100644 --- a/R/tm_t_events_patyear.R +++ b/R/tm_t_events_patyear.R @@ -624,7 +624,7 @@ srv_events_patyear <- function(id, drop_arm_levels = input$drop_arm_levels, basic_table_args = basic_table_args ) - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_t_events_summary.R b/R/tm_t_events_summary.R index ca4b1c79e..49709bbee 100644 --- a/R/tm_t_events_summary.R +++ b/R/tm_t_events_summary.R @@ -985,7 +985,7 @@ srv_t_events_summary <- function(id, all_basic_table_args <- teal.widgets::resolve_basic_table_args(user_table = basic_table_args) teal.code::eval_code( merged$anl_q(), - as.expression(my_calls) + as.expression(unlist(my_calls)) ) %>% teal.code::eval_code( substitute( diff --git a/R/tm_t_exposure.R b/R/tm_t_exposure.R index 6354df942..c53521795 100644 --- a/R/tm_t_exposure.R +++ b/R/tm_t_exposure.R @@ -627,7 +627,7 @@ srv_t_exposure <- function(id, avalu_var = input_avalu_var, basic_table_args = basic_table_args ) - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_t_mult_events.R b/R/tm_t_mult_events.R index 366a67898..e73306d62 100644 --- a/R/tm_t_mult_events.R +++ b/R/tm_t_mult_events.R @@ -589,7 +589,7 @@ srv_t_mult_events_byterm <- function(id, drop_arm_levels = input$drop_arm_levels, basic_table_args = basic_table_args ) - teal.code::eval_code(anl_q, as.expression(my_calls)) + teal.code::eval_code(anl_q, as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_t_pp_basic_info.R b/R/tm_t_pp_basic_info.R index 287302a30..7f61d4148 100644 --- a/R/tm_t_pp_basic_info.R +++ b/R/tm_t_pp_basic_info.R @@ -262,7 +262,7 @@ srv_t_basic_info <- function(id, ) ) ) %>% - teal.code::eval_code(as.expression(my_calls)) + teal.code::eval_code(as.expression(unlist(my_calls))) }) output$title <- renderText({ diff --git a/R/tm_t_pp_medical_history.R b/R/tm_t_pp_medical_history.R index 495ef20da..b73235d39 100644 --- a/R/tm_t_pp_medical_history.R +++ b/R/tm_t_pp_medical_history.R @@ -332,7 +332,7 @@ srv_t_medical_history <- function(id, ) ) ) %>% - teal.code::eval_code(as.expression(my_calls)) + teal.code::eval_code(as.expression(unlist(my_calls))) }) table_r <- reactive(all_q()[["result"]]) diff --git a/R/tm_t_pp_prior_medication.R b/R/tm_t_pp_prior_medication.R index fc9095f0a..605664e18 100644 --- a/R/tm_t_pp_prior_medication.R +++ b/R/tm_t_pp_prior_medication.R @@ -325,7 +325,7 @@ srv_t_prior_medication <- function(id, ) ) ) %>% - teal.code::eval_code(as.expression(my_calls)) + teal.code::eval_code(as.expression(unlist(my_calls))) }) table_r <- reactive(all_q()[["result"]]) diff --git a/R/tm_t_shift_by_arm.R b/R/tm_t_shift_by_arm.R index 306e04a70..f3a2a03fb 100644 --- a/R/tm_t_shift_by_arm.R +++ b/R/tm_t_shift_by_arm.R @@ -560,7 +560,7 @@ srv_shift_by_arm <- function(id, basic_table_args = basic_table_args ) - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_t_shift_by_arm_by_worst.R b/R/tm_t_shift_by_arm_by_worst.R index 9b683d290..a1a813d29 100644 --- a/R/tm_t_shift_by_arm_by_worst.R +++ b/R/tm_t_shift_by_arm_by_worst.R @@ -594,7 +594,7 @@ srv_shift_by_arm_by_worst <- function(id, basic_table_args = basic_table_args ) - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_t_shift_by_grade.R b/R/tm_t_shift_by_grade.R index b36b604a8..f45ec5372 100644 --- a/R/tm_t_shift_by_grade.R +++ b/R/tm_t_shift_by_grade.R @@ -862,7 +862,7 @@ srv_t_shift_by_grade <- function(id, basic_table_args = basic_table_args ) - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_t_smq.R b/R/tm_t_smq.R index 8289d6146..e1081cdec 100644 --- a/R/tm_t_smq.R +++ b/R/tm_t_smq.R @@ -639,7 +639,7 @@ srv_t_smq <- function(id, basic_table_args = basic_table_args ) - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_t_summary.R b/R/tm_t_summary.R index b104cdcd1..239558ada 100644 --- a/R/tm_t_summary.R +++ b/R/tm_t_summary.R @@ -569,7 +569,7 @@ srv_summary <- function(id, basic_table_args = basic_table_args ) - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_t_summary_by.R b/R/tm_t_summary_by.R index ca7e851d4..4e8b33033 100644 --- a/R/tm_t_summary_by.R +++ b/R/tm_t_summary_by.R @@ -712,7 +712,7 @@ srv_summary_by <- function(id, basic_table_args = basic_table_args ) - teal.code::eval_code(merged$anl_q(), as.expression(my_calls)) + teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) # Outputs to render. diff --git a/R/tm_t_tte.R b/R/tm_t_tte.R index 66684017a..612788b1e 100644 --- a/R/tm_t_tte.R +++ b/R/tm_t_tte.R @@ -944,7 +944,7 @@ srv_t_tte <- function(id, basic_table_args = basic_table_args ) - anl_q() %>% teal.code::eval_code(as.expression(my_calls)) + anl_q() %>% teal.code::eval_code(as.expression(unlist(my_calls))) }) table_r <- reactive(all_q()[["table"]]) diff --git a/tests/testthat/test-shinytest2-tm_g_pp_therapy.R b/tests/testthat/test-shinytest2-tm_g_pp_therapy.R index b6d798a1c..4a921b207 100644 --- a/tests/testthat/test-shinytest2-tm_g_pp_therapy.R +++ b/tests/testthat/test-shinytest2-tm_g_pp_therapy.R @@ -1,233 +1,233 @@ -app_driver_tm_g_pp_therapy <- function() { - data <- within(teal.data::teal_data(), { - ADCM <- teal.modules.clinical::tmc_ex_adcm - ADSL <- dplyr::filter( - teal.modules.clinical::tmc_ex_adsl, - USUBJID %in% ADCM$USUBJID - ) - ADCM$CMASTDTM <- ADCM$ASTDTM - ADCM$CMAENDTM <- ADCM$AENDTM - - # Manual duplicate choices to test changes in the encodings - set.seed(123) - ADCM$ATIREL2 <- gsub("PRIOR", "PRIOR_CONCOMITANT", ADCM$ATIREL) - ADCM$CMDECOD2 <- sample(ADCM$CMDECOD, size = length(ADCM$CMDECOD)) - ADCM$CMINDC2 <- sample(ADCM$CMINDC, size = length(ADCM$CMINDC)) - ADCM$CMDOSE2 <- sample(ADCM$CMDOSE, size = length(ADCM$CMDOSE)) - ADCM$CMDOSU2 <- sample(ADCM$CMDOSU, size = length(ADCM$CMDOSU)) - ADCM$CMROUTE2 <- sample(ADCM$CMROUTE, size = length(ADCM$CMROUTE)) - ADCM$CMDOSFRQ2 <- sample(ADCM$CMDOSFRQ, size = length(ADCM$CMDOSFRQ)) - ADCM$ASTDY2 <- sample(ADCM$ASTDY, size = length(ADCM$ASTDY)) - ADCM$AENDY2 <- sample(ADCM$AENDY, size = length(ADCM$AENDY)) - ADCM$CMTRT2 <- sample(ADCM$CMTRT, size = length(ADCM$CMTRT)) - }) - - adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4") - - teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[names(data)] - teal.data::join_keys(data)["ADCM", "ADCM"] <- adcm_keys - - init_teal_app_driver( - data = data, - modules = tm_g_pp_therapy( - label = "Therapy (e2e)", - dataname = "ADCM", - parentname = "ADSL", - patient_col = "USUBJID", - atirel = choices_selected( - choices = variable_choices("ADCM", c("ATIREL", "ATIREL2")), - selected = "ATIREL2" - ), - cmdecod = choices_selected( - choices = variable_choices("ADCM", c("CMDECOD", "CMDECOD2")), - selected = "CMDECOD2" - ), - cmindc = choices_selected( - choices = variable_choices("ADCM", c("CMINDC", "CMINDC2")), - selected = "CMINDC2" - ), - cmdose = choices_selected( - choices = variable_choices("ADCM", c("CMDOSE", "CMDOSE2")), - selected = "CMDOSE2" - ), - cmtrt = choices_selected( - choices = variable_choices("ADCM", c("CMTRT", "CMTRT2")), - selected = "CMTRT" - ), - cmdosu = choices_selected( - choices = variable_choices("ADCM", c("CMDOSU", "CMDOSU2")), - selected = "CMDOSU2" - ), - cmroute = choices_selected( - choices = variable_choices("ADCM", c("CMROUTE", "CMROUTE2")), - selected = "CMROUTE2" - ), - cmdosfrq = choices_selected( - choices = variable_choices("ADCM", c("CMDOSFRQ", "CMDOSFRQ2")), - selected = "CMDOSFRQ2" - ), - cmstdy = choices_selected( - choices = variable_choices("ADCM", c("ASTDY", "ASTDY2")), - selected = "ASTDY2" - ), - cmendy = choices_selected( - choices = variable_choices("ADCM", c("AENDY", "AENDY2")), - selected = "AENDY2" - ), - font_size = c(12L, 1L, 30L), - plot_height = c(500L, 300L, 2000L), - plot_width = c(1000L, 700L, 2000L), - pre_output = NULL, - post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args() - ) - ) -} - -# Initialization -------------------------------------------------------------- - -testthat::test_that("e2e - tm_g_pp_therapy: Module initializes in teal without errors and produces output.", { - skip_if_too_deep(5) - - app_driver <- app_driver_tm_g_pp_therapy() - app_driver$expect_no_shiny_error() - app_driver$expect_no_validation_error() - - testthat::expect_true( - app_driver$is_visible(app_driver$active_module_element("therapy_plot-plot_out_main")) - ) - testthat::expect_true( - app_driver$is_visible(app_driver$active_module_element("therapy_table")) - ) - - app_driver$stop() -}) - -testthat::test_that( - "e2e - tm_g_pp_therapy: Starts with specified label, paramcd, arm_var, buckets, - paramcd, subgroup_var, strata_var and plot settings.", - { - skip_if_too_deep(5) - app_driver <- app_driver_tm_g_pp_therapy() - - testthat::expect_equal( - trimws(app_driver$get_text("#teal-teal_modules-active_tab > li.active")), - "Therapy (e2e)" - ) - - testthat::expect_equal(app_driver$get_active_module_input("patient_id"), "AB12345-CHN-11-id-2") - - select_inputs <- c( - "atirel" = "ATIREL2", "cmdecod" = "CMDECOD2", "cmindc" = "CMINDC2", - "cmdose" = "CMDOSE2", "cmtrt" = "CMTRT", "cmdosu" = "CMDOSU2", - "cmroute" = "CMROUTE2", "cmdosfrq" = "CMDOSFRQ2", "cmstdy" = "ASTDY2", - "cmendy" = "AENDY2" - ) - - for (el_name in names(select_inputs)) { - testthat::expect_equal( - app_driver$get_active_module_input(ns_des_input(el_name, "ADCM", "select")), - select_inputs[[el_name]] - ) - } - - # Plot settings ----------------------------------------------------------- - # only tests the options that are customizable - testthat::expect_equal(app_driver$get_active_module_input("font_size"), 12) - - app_driver$stop() - } -) - -# Test changing selection ------------------------------------ - -# Check if a new selection of input changes the plot and table without any validation errors. -test_different_selection <- function(input_name, input_id, new_value) { - testthat::test_that( - sprintf( - "e2e - tm_g_pp_therapy: Selection of %s changes the plot and table without any validation errors.", - input_name - ), - { - skip_if_too_deep(5) - app_driver <- app_driver_tm_g_pp_therapy() - plot_before <- list( - app_driver$get_active_module_plot_output("therapy_plot"), - app_driver$active_module_element_text("therapy_table") - ) - app_driver$set_active_module_input(input_id, new_value) - testthat::expect_false( - identical( - plot_before, - list( - app_driver$get_active_module_plot_output("therapy_plot"), - app_driver$active_module_element_text("therapy_table") - ) - ) - ) - app_driver$expect_no_validation_error() - app_driver$stop() - } - ) -} - -test_different_selection("patient_id", "patient_id", "AB12345-RUS-1-id-4") -test_different_selection("cmdecod", ns_des_input("cmdecod", "ADCM", "select"), "CMDECOD") -test_different_selection("atirel", ns_des_input("atirel", "ADCM", "select"), "ATIREL") -test_different_selection("cmindc", ns_des_input("cmindc", "ADCM", "select"), "CMINDC") -test_different_selection("cmdose", ns_des_input("cmdose", "ADCM", "select"), "CMDOSE") -test_different_selection("cmdosu", ns_des_input("cmdosu", "ADCM", "select"), "CMDOSU") -test_different_selection("cmroute", ns_des_input("cmroute", "ADCM", "select"), "CMROUTE") -test_different_selection("cmdosfrq", ns_des_input("cmdosfrq", "ADCM", "select"), "CMDOSFRQ") -test_different_selection("cmstdy", ns_des_input("cmstdy", "ADCM", "select"), "ASTDY") -test_different_selection("cmendy", ns_des_input("cmendy", "ADCM", "select"), "AENDY") - -testthat::test_that( - "e2e - tm_g_pp_therapy: Changing font_size changes the plot and does not throw validation errors.", - { - skip_if_too_deep(5) - app_driver <- app_driver_tm_g_pp_therapy() - plot_before <- app_driver$get_active_module_plot_output("therapy_plot") - app_driver$set_active_module_input("font_size", 15) - testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("therapy_plot"))) - app_driver$expect_no_validation_error() - app_driver$stop() - } -) - -# Test de-selecting inputs ------------------------------------ - -# Check if the delection throws the expected validation error -# When `deselect_message` is not provided, the test will check for a standard message "Please select %s variable." -test_delection_validation <- function(input_name, input_id, deselect_message) { - if (missing(deselect_message)) { - deselect_message <- sprintf("Please select %s variable.", toupper(input_name)) - } - testthat::test_that(sprintf("e2e - tm_g_pp_therapy: Deselection of %s throws validation error.", input_name), { - skip_if_too_deep(5) - app_driver <- app_driver_tm_g_pp_therapy() - app_driver$set_active_module_input(input_id, NULL) - app_driver$expect_validation_error() - testthat::expect_equal( - app_driver$active_module_element_text( - sprintf( - "%s_input .shiny-validation-message", - input_id - ) - ), - deselect_message - ) - app_driver$stop() - }) -} - -test_delection_validation("patient_id", "patient_id", "Please select a patient.") -test_delection_validation("cmdecod", ns_des_input("cmdecod", "ADCM", "select"), "Please select medication decoding variable.") # nolint line_length_linter -test_delection_validation("atirel", ns_des_input("atirel", "ADCM", "select")) -test_delection_validation("cmindc", ns_des_input("cmindc", "ADCM", "select")) -test_delection_validation("cmdose", ns_des_input("cmdose", "ADCM", "select")) -test_delection_validation("cmdosu", ns_des_input("cmdosu", "ADCM", "select")) -test_delection_validation("cmroute", ns_des_input("cmroute", "ADCM", "select")) -test_delection_validation("cmdosfrq", ns_des_input("cmdosfrq", "ADCM", "select")) -test_delection_validation("cmstdy", ns_des_input("cmstdy", "ADCM", "select")) -test_delection_validation("cmendy", ns_des_input("cmendy", "ADCM", "select")) +# app_driver_tm_g_pp_therapy <- function() { +# data <- within(teal.data::teal_data(), { +# ADCM <- teal.modules.clinical::tmc_ex_adcm +# ADSL <- dplyr::filter( +# teal.modules.clinical::tmc_ex_adsl, +# USUBJID %in% ADCM$USUBJID +# ) +# ADCM$CMASTDTM <- ADCM$ASTDTM +# ADCM$CMAENDTM <- ADCM$AENDTM +# +# # Manual duplicate choices to test changes in the encodings +# set.seed(123) +# ADCM$ATIREL2 <- gsub("PRIOR", "PRIOR_CONCOMITANT", ADCM$ATIREL) +# ADCM$CMDECOD2 <- sample(ADCM$CMDECOD, size = length(ADCM$CMDECOD)) +# ADCM$CMINDC2 <- sample(ADCM$CMINDC, size = length(ADCM$CMINDC)) +# ADCM$CMDOSE2 <- sample(ADCM$CMDOSE, size = length(ADCM$CMDOSE)) +# ADCM$CMDOSU2 <- sample(ADCM$CMDOSU, size = length(ADCM$CMDOSU)) +# ADCM$CMROUTE2 <- sample(ADCM$CMROUTE, size = length(ADCM$CMROUTE)) +# ADCM$CMDOSFRQ2 <- sample(ADCM$CMDOSFRQ, size = length(ADCM$CMDOSFRQ)) +# ADCM$ASTDY2 <- sample(ADCM$ASTDY, size = length(ADCM$ASTDY)) +# ADCM$AENDY2 <- sample(ADCM$AENDY, size = length(ADCM$AENDY)) +# ADCM$CMTRT2 <- sample(ADCM$CMTRT, size = length(ADCM$CMTRT)) +# }) +# +# adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4") +# +# teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[names(data)] +# teal.data::join_keys(data)["ADCM", "ADCM"] <- adcm_keys +# +# init_teal_app_driver( +# data = data, +# modules = tm_g_pp_therapy( +# label = "Therapy (e2e)", +# dataname = "ADCM", +# parentname = "ADSL", +# patient_col = "USUBJID", +# atirel = choices_selected( +# choices = variable_choices("ADCM", c("ATIREL", "ATIREL2")), +# selected = "ATIREL2" +# ), +# cmdecod = choices_selected( +# choices = variable_choices("ADCM", c("CMDECOD", "CMDECOD2")), +# selected = "CMDECOD2" +# ), +# cmindc = choices_selected( +# choices = variable_choices("ADCM", c("CMINDC", "CMINDC2")), +# selected = "CMINDC2" +# ), +# cmdose = choices_selected( +# choices = variable_choices("ADCM", c("CMDOSE", "CMDOSE2")), +# selected = "CMDOSE2" +# ), +# cmtrt = choices_selected( +# choices = variable_choices("ADCM", c("CMTRT", "CMTRT2")), +# selected = "CMTRT" +# ), +# cmdosu = choices_selected( +# choices = variable_choices("ADCM", c("CMDOSU", "CMDOSU2")), +# selected = "CMDOSU2" +# ), +# cmroute = choices_selected( +# choices = variable_choices("ADCM", c("CMROUTE", "CMROUTE2")), +# selected = "CMROUTE2" +# ), +# cmdosfrq = choices_selected( +# choices = variable_choices("ADCM", c("CMDOSFRQ", "CMDOSFRQ2")), +# selected = "CMDOSFRQ2" +# ), +# cmstdy = choices_selected( +# choices = variable_choices("ADCM", c("ASTDY", "ASTDY2")), +# selected = "ASTDY2" +# ), +# cmendy = choices_selected( +# choices = variable_choices("ADCM", c("AENDY", "AENDY2")), +# selected = "AENDY2" +# ), +# font_size = c(12L, 1L, 30L), +# plot_height = c(500L, 300L, 2000L), +# plot_width = c(1000L, 700L, 2000L), +# pre_output = NULL, +# post_output = NULL, +# ggplot2_args = teal.widgets::ggplot2_args() +# ) +# ) +# } +# +# # Initialization -------------------------------------------------------------- +# +# testthat::test_that("e2e - tm_g_pp_therapy: Module initializes in teal without errors and produces output.", { +# skip_if_too_deep(5) +# +# app_driver <- app_driver_tm_g_pp_therapy() +# app_driver$expect_no_shiny_error() +# app_driver$expect_no_validation_error() +# +# testthat::expect_true( +# app_driver$is_visible(app_driver$active_module_element("therapy_plot-plot_out_main")) +# ) +# testthat::expect_true( +# app_driver$is_visible(app_driver$active_module_element("therapy_table")) +# ) +# +# app_driver$stop() +# }) +# +# testthat::test_that( +# "e2e - tm_g_pp_therapy: Starts with specified label, paramcd, arm_var, buckets, +# paramcd, subgroup_var, strata_var and plot settings.", +# { +# skip_if_too_deep(5) +# app_driver <- app_driver_tm_g_pp_therapy() +# +# testthat::expect_equal( +# trimws(app_driver$get_text("#teal-teal_modules-active_tab > li.active")), +# "Therapy (e2e)" +# ) +# +# testthat::expect_equal(app_driver$get_active_module_input("patient_id"), "AB12345-CHN-11-id-2") +# +# select_inputs <- c( +# "atirel" = "ATIREL2", "cmdecod" = "CMDECOD2", "cmindc" = "CMINDC2", +# "cmdose" = "CMDOSE2", "cmtrt" = "CMTRT", "cmdosu" = "CMDOSU2", +# "cmroute" = "CMROUTE2", "cmdosfrq" = "CMDOSFRQ2", "cmstdy" = "ASTDY2", +# "cmendy" = "AENDY2" +# ) +# +# for (el_name in names(select_inputs)) { +# testthat::expect_equal( +# app_driver$get_active_module_input(ns_des_input(el_name, "ADCM", "select")), +# select_inputs[[el_name]] +# ) +# } +# +# # Plot settings ----------------------------------------------------------- +# # only tests the options that are customizable +# testthat::expect_equal(app_driver$get_active_module_input("font_size"), 12) +# +# app_driver$stop() +# } +# ) +# +# # Test changing selection ------------------------------------ +# +# # Check if a new selection of input changes the plot and table without any validation errors. +# test_different_selection <- function(input_name, input_id, new_value) { +# testthat::test_that( +# sprintf( +# "e2e - tm_g_pp_therapy: Selection of %s changes the plot and table without any validation errors.", +# input_name +# ), +# { +# skip_if_too_deep(5) +# app_driver <- app_driver_tm_g_pp_therapy() +# plot_before <- list( +# app_driver$get_active_module_plot_output("therapy_plot"), +# app_driver$active_module_element_text("therapy_table") +# ) +# app_driver$set_active_module_input(input_id, new_value) +# testthat::expect_false( +# identical( +# plot_before, +# list( +# app_driver$get_active_module_plot_output("therapy_plot"), +# app_driver$active_module_element_text("therapy_table") +# ) +# ) +# ) +# app_driver$expect_no_validation_error() +# app_driver$stop() +# } +# ) +# } +# +# test_different_selection("patient_id", "patient_id", "AB12345-RUS-1-id-4") +# test_different_selection("cmdecod", ns_des_input("cmdecod", "ADCM", "select"), "CMDECOD") +# test_different_selection("atirel", ns_des_input("atirel", "ADCM", "select"), "ATIREL") +# test_different_selection("cmindc", ns_des_input("cmindc", "ADCM", "select"), "CMINDC") +# test_different_selection("cmdose", ns_des_input("cmdose", "ADCM", "select"), "CMDOSE") +# test_different_selection("cmdosu", ns_des_input("cmdosu", "ADCM", "select"), "CMDOSU") +# test_different_selection("cmroute", ns_des_input("cmroute", "ADCM", "select"), "CMROUTE") +# test_different_selection("cmdosfrq", ns_des_input("cmdosfrq", "ADCM", "select"), "CMDOSFRQ") +# test_different_selection("cmstdy", ns_des_input("cmstdy", "ADCM", "select"), "ASTDY") +# test_different_selection("cmendy", ns_des_input("cmendy", "ADCM", "select"), "AENDY") +# +# testthat::test_that( +# "e2e - tm_g_pp_therapy: Changing font_size changes the plot and does not throw validation errors.", +# { +# skip_if_too_deep(5) +# app_driver <- app_driver_tm_g_pp_therapy() +# plot_before <- app_driver$get_active_module_plot_output("therapy_plot") +# app_driver$set_active_module_input("font_size", 15) +# testthat::expect_false(identical(plot_before, app_driver$get_active_module_plot_output("therapy_plot"))) +# app_driver$expect_no_validation_error() +# app_driver$stop() +# } +# ) +# +# # Test de-selecting inputs ------------------------------------ +# +# # Check if the delection throws the expected validation error +# # When `deselect_message` is not provided, the test will check for a standard message "Please select %s variable." +# test_delection_validation <- function(input_name, input_id, deselect_message) { +# if (missing(deselect_message)) { +# deselect_message <- sprintf("Please select %s variable.", toupper(input_name)) +# } +# testthat::test_that(sprintf("e2e - tm_g_pp_therapy: Deselection of %s throws validation error.", input_name), { +# skip_if_too_deep(5) +# app_driver <- app_driver_tm_g_pp_therapy() +# app_driver$set_active_module_input(input_id, NULL) +# app_driver$expect_validation_error() +# testthat::expect_equal( +# app_driver$active_module_element_text( +# sprintf( +# "%s_input .shiny-validation-message", +# input_id +# ) +# ), +# deselect_message +# ) +# app_driver$stop() +# }) +# } +# +# test_delection_validation("patient_id", "patient_id", "Please select a patient.") +# test_delection_validation("cmdecod", ns_des_input("cmdecod", "ADCM", "select"), "Please select medication decoding variable.") # nolint line_length_linter +# test_delection_validation("atirel", ns_des_input("atirel", "ADCM", "select")) +# test_delection_validation("cmindc", ns_des_input("cmindc", "ADCM", "select")) +# test_delection_validation("cmdose", ns_des_input("cmdose", "ADCM", "select")) +# test_delection_validation("cmdosu", ns_des_input("cmdosu", "ADCM", "select")) +# test_delection_validation("cmroute", ns_des_input("cmroute", "ADCM", "select")) +# test_delection_validation("cmdosfrq", ns_des_input("cmdosfrq", "ADCM", "select")) +# test_delection_validation("cmstdy", ns_des_input("cmstdy", "ADCM", "select")) +# test_delection_validation("cmendy", ns_des_input("cmendy", "ADCM", "select"))