From 4525b8aee881e3182d3c595d16ee856375f1e498 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 6 Dec 2022 09:53:27 +0000 Subject: [PATCH 01/69] add shinyvalidate to DESC file --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 4ab6569ff0..8671e680bc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -48,6 +48,7 @@ Imports: scales, shiny, shinyjs, + shinyvalidate, shinyWidgets, stats, styler, From f7f34ddf518caeea2ec9e8656afaddf1a6e4df34 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 6 Dec 2022 09:59:01 +0000 Subject: [PATCH 02/69] NEWS --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 692b23bfca..e200b2756c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,6 +9,7 @@ * Replaced `synthetic_cdisc_data` with refactored `synthetic_cdisc_dataset` function to speed up dataset loading in tests/examples. * Added new GEE module `tm_a_gee`. * Added interface for selecting an interaction term to `tm_t_ancova`. +* Updated `shiny::validate` calls to `shinyvalidate` for better UI experience. ### Miscellaneous * Package now uses `scda.2022` rather than `scda.2021` in SUGGESTS. From 64cafdeed1b100ce6dded9b6e339e7c43b8a1096 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 6 Dec 2022 10:30:15 +0000 Subject: [PATCH 03/69] tm_g_ci --- R/tm_g_ci.R | 54 +++++++++++++++++++++++++++++------------------------ 1 file changed, 30 insertions(+), 24 deletions(-) diff --git a/R/tm_g_ci.R b/R/tm_g_ci.R index 72acc1dddb..87b71d5f70 100644 --- a/R/tm_g_ci.R +++ b/R/tm_g_ci.R @@ -377,10 +377,35 @@ srv_g_ci <- function(id, # nolint checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list(x_var = x_var, y_var = y_var, color = color), - join_keys = get_join_keys(data) + datasets = data, + select_validation_rule = list( + x_var = shinyvalidate::sv_required("Select a treatment (x axis)"), + y_var = shinyvalidate::sv_required("Select an analyzed value (y axis)") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level")) + iv$add_rule( + "conf_level", + shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between 0 and 1") + ) + selector_list()$x_var()$iv$enable() + selector_list()$y_var()$iv$enable() + iv$add_validator(selector_list()$x_var()$iv) + iv$add_validator(selector_list()$y_var()$iv) + iv$enable() + iv + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + join_keys = get_join_keys(data), + selector_list = selector_list ) anl_q <- reactive( @@ -390,29 +415,10 @@ srv_g_ci <- function(id, # nolint ) ) - validate_data <- shiny::reactive({ - shiny::validate( - shiny::need( - length(anl_inputs()$columns_source$x_var) > 0, - "Select a treatment (x axis)." - ) - ) - shiny::validate( - shiny::need( - length(anl_inputs()$columns_source$y_var) > 0, - "Select an analyzed value (y axis)." - ) - ) + all_q <- shiny::reactive({ + teal::validate_inputs(iv_r()) teal::validate_has_data(anl_q()[["ANL"]], min_nrow = 2) - shiny::validate(shiny::need( - input$conf_level >= 0 && input$conf_level <= 1, - "Please choose a confidence level between 0 and 1" - )) - }) - - all_q <- shiny::reactive({ - validate_data() x <- anl_inputs()$columns_source$x_var y <- anl_inputs()$columns_source$y_var color <- anl_inputs()$columns_source$color From f673677846ac0e6f2ab99a095971dba09a717d1f Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 6 Dec 2022 11:25:24 +0000 Subject: [PATCH 04/69] use helper function from teal.transform --- R/tm_g_ci.R | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/R/tm_g_ci.R b/R/tm_g_ci.R index 87b71d5f70..7dffc313f9 100644 --- a/R/tm_g_ci.R +++ b/R/tm_g_ci.R @@ -394,12 +394,7 @@ srv_g_ci <- function(id, # nolint "conf_level", shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between 0 and 1") ) - selector_list()$x_var()$iv$enable() - selector_list()$y_var()$iv$enable() - iv$add_validator(selector_list()$x_var()$iv) - iv$add_validator(selector_list()$y_var()$iv) - iv$enable() - iv + teal.transform::compose_and_enable_validators(iv, selector_list, c("x_var", "y_var")) }) anl_inputs <- teal.transform::merge_expression_srv( From 97c77e32d93c6d80f7989a140ff3e0c2bb1430b7 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 6 Dec 2022 12:04:15 +0000 Subject: [PATCH 05/69] lineplot --- R/tm_g_lineplot.R | 48 +++++++++++++++++++++++++++++------------------ 1 file changed, 30 insertions(+), 18 deletions(-) diff --git a/R/tm_g_lineplot.R b/R/tm_g_lineplot.R index 25b9131d2f..b19d71dec6 100644 --- a/R/tm_g_lineplot.R +++ b/R/tm_g_lineplot.R @@ -309,7 +309,7 @@ tm_g_lineplot <- function(label, strata = cs_to_des_select(strata, dataname = parentname), param = cs_to_des_filter(param, dataname = dataname), x = cs_to_des_select(x, dataname = dataname, multiple = FALSE), - y = cs_to_des_select(y, dataname = dataname), + y = cs_to_des_select(y, dataname = dataname, multiple = FALSE), y_unit = cs_to_des_select(y_unit, dataname = dataname), paramcd = cs_to_des_select(paramcd, dataname = dataname) ) @@ -518,10 +518,35 @@ srv_g_lineplot <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list(x = x, y = y, strata = strata, paramcd = paramcd, y_unit = y_unit, param = param), + datasets = data, + select_validation_rule = list( + x = shinyvalidate::sv_required("Please select a single time variable"), + y = shinyvalidate::sv_required("Please select a single analysis variable"), + strata = shinyvalidate::sv_required("Please select a treatment variable") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level")) + iv$add_rule( + "conf_level", + shinyvalidate::sv_between( + 0, 1, message_fmt = "Please choose a confidence level between 0 and 1", inclusive = c(FALSE, FALSE) + ) + ) + iv$add_rule("interval", shinyvalidate::sv_required("Please select an interval for the midpoint statistic")) + iv$add_rule("whiskers", shinyvalidate::sv_required("At least one of the whiskers must be selected")) + teal.transform::compose_and_enable_validators(iv, selector_list, c("x", "y", "strata")) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, join_keys = get_join_keys(data), + selector_list = selector_list, merge_function = "dplyr::inner_join" ) @@ -533,6 +558,8 @@ srv_g_lineplot <- function(id, merged <- list(anl_input_r = anl_inputs, anl_q = anl_q) validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) + adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] @@ -557,22 +584,7 @@ srv_g_lineplot <- function(id, validate_args <- append(validate_args, list(min_n_levels_armvar = NULL)) } - # Validate whiskers - shiny::validate(shiny::need(length(input$whiskers) > 0, "At least one of the whiskers must be selected.")) - - # Validate interval - shiny::validate(shiny::need(length(input$interval) > 0, "Need to select an interval for the midpoint statistic.")) - do.call(what = "validate_standard_inputs", validate_args) - - shiny::validate(shiny::need( - input$conf_level > 0 && input$conf_level < 1, - "Please choose a confidence level between 0 and 1" - )) - - shiny::validate(shiny::need(checkmate::test_string(input_y), "Analysis variable should be a single column.")) - shiny::validate(shiny::need(checkmate::test_string(input_x_var), "Time variable should be a single column.")) - NULL }) From d80b6b8d2fd4b939a857568b7ef5ae76bd83ad74 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 6 Dec 2022 14:09:05 +0000 Subject: [PATCH 06/69] tm_t_events --- R/tm_t_events.R | 55 +++++++++++++++++++++++++++++++------------------ 1 file changed, 35 insertions(+), 20 deletions(-) diff --git a/R/tm_t_events.R b/R/tm_t_events.R index 0773addc0a..d0b7ff67ed 100644 --- a/R/tm_t_events.R +++ b/R/tm_t_events.R @@ -639,11 +639,40 @@ srv_t_events_byterm <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list(arm_var = arm_var, hlt = hlt, llt = llt), - merge_function = "dplyr::inner_join", - join_keys = get_join_keys(data) + datasets = data, + select_validation_rule = list( + arm_var = ~ if (length(.) != 1 && length(.) != 2) + "Please select 1 or 2 treatment variable values", + hlt = ~ if (length(as.vector(merged$anl_input_r()$columns_source$llt)) + length(.) == 0) + "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables.", + llt = ~ if (length(as.vector(merged$anl_input_r()$columns_source$hlt)) + length(.) == 0) + "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables." + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("prune_freq", shinyvalidate::sv_required("Please provide an Incidence Rate between 0 and 100 (%).")) + iv$add_rule( + "prune_freq", + shinyvalidate::sv_between(0, 100, message_fmt = "Please provide an Incidence Rate between 0 and 100 (%).") + ) + iv$add_rule("prune_diff", shinyvalidate::sv_required("Please provide a Difference Rate between 0 and 100 (%).")) + iv$add_rule( + "prune_diff", + shinyvalidate::sv_between(0, 100, message_fmt = "Please provide a Difference Rate between 0 and 100 (%).") + ) + teal.transform::compose_and_enable_validators(iv, selector_list, c("arm_var", "hlt", "llt")) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + join_keys = get_join_keys(data), + selector_list = selector_list, + merge_function = "dplyr::inner_join" ) adsl_inputs <- teal.transform::merge_expression_module( @@ -666,6 +695,8 @@ srv_t_events_byterm <- function(id, ) validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) + adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] @@ -676,8 +707,6 @@ srv_t_events_byterm <- function(id, ) shiny::validate( - shiny::need(input_arm_var, "Please select a treatment variable"), - shiny::need(length(input_arm_var) <= 2, "Please limit treatment variables within two"), if (length(input_arm_var) >= 1) { shiny::need(is.factor(adsl_filtered[[input_arm_var[[1]]]]), "Treatment variable is not a factor.") }, @@ -690,20 +719,6 @@ srv_t_events_byterm <- function(id, ) } ) - teal::validate_has_elements( - input_level_term, - "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables." - ) - shiny::validate( - shiny::need( - input$prune_freq >= 0 && input$prune_freq <= 100, - "Please provide an Incidence Rate between 0 and 100 (%)." - ), - shiny::need( - input$prune_diff >= 0 && input$prune_diff <= 100, - "Please provide a Difference Rate between 0 and 100 (%)." - ) - ) # validate inputs validate_standard_inputs( From e6c115074f881983ae6646c60e786d0634f7f71d Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Wed, 7 Dec 2022 10:32:29 +0000 Subject: [PATCH 07/69] update ci --- R/tm_g_ci.R | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/R/tm_g_ci.R b/R/tm_g_ci.R index 7dffc313f9..b1cdf7014b 100644 --- a/R/tm_g_ci.R +++ b/R/tm_g_ci.R @@ -329,7 +329,7 @@ ui_g_ci <- function(id, ...) { # nolint ), teal.transform::data_extract_ui( id = ns("y_var"), - label = "Analyzed Value (y axis)", + label = "Analysis Value (y axis)", data_extract_spec = args$y_var ), teal.transform::data_extract_ui( @@ -383,7 +383,7 @@ srv_g_ci <- function(id, # nolint datasets = data, select_validation_rule = list( x_var = shinyvalidate::sv_required("Select a treatment (x axis)"), - y_var = shinyvalidate::sv_required("Select an analyzed value (y axis)") + y_var = shinyvalidate::sv_required("Select an analysis value (y axis)") ) ) @@ -418,6 +418,13 @@ srv_g_ci <- function(id, # nolint y <- anl_inputs()$columns_source$y_var color <- anl_inputs()$columns_source$color + shiny::validate( + shiny::need( + !all(is.na(anl_q()[["ANL"]][[y]])), + "No valid data. Please check the filtering option for analysis value (y axis)" + ) + ) + x_label <- column_annotation_label(data[[attr(x, "dataname")]](), x) y_label <- column_annotation_label(data[[attr(y, "dataname")]](), y) color_label <- if (length(color)) { From 4b5353b452df0d4ed4f3bd2f9e74e3db4603fcaa Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Wed, 7 Dec 2022 10:33:00 +0000 Subject: [PATCH 08/69] Update NEWS.md Co-authored-by: Mahmoud Hallal <86970066+mhallal1@users.noreply.github.com> Signed-off-by: Nikolas Burkoff --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index e200b2756c..3dadd1a106 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,7 +9,7 @@ * Replaced `synthetic_cdisc_data` with refactored `synthetic_cdisc_dataset` function to speed up dataset loading in tests/examples. * Added new GEE module `tm_a_gee`. * Added interface for selecting an interaction term to `tm_t_ancova`. -* Updated `shiny::validate` calls to `shinyvalidate` for better UI experience. +* Updated encodings input checks to use `shinyvalidate::InputValidator` instead of `shiny::validate` for better UI experience. ### Miscellaneous * Package now uses `scda.2022` rather than `scda.2021` in SUGGESTS. From 7c29dce0fc2e07880883e9a36d35ce5d63862134 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Wed, 7 Dec 2022 10:54:30 +0000 Subject: [PATCH 09/69] pp basic info --- R/tm_t_pp_basic_info.R | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/R/tm_t_pp_basic_info.R b/R/tm_t_pp_basic_info.R index 6a9ea757a3..b9d8e54bae 100644 --- a/R/tm_t_pp_basic_info.R +++ b/R/tm_t_pp_basic_info.R @@ -194,10 +194,24 @@ srv_t_basic_info <- function(id, ) # Basic Info tab ---- - anl_inputs <- teal.transform::merge_expression_module( + selector_list <- teal.transform::data_extract_multiple_srv( + data_extract = list(vars = vars), + datasets = data, + select_validation_rule = list( + vars = shinyvalidate::sv_required("Please select basic info variables") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient")) + teal.transform::compose_and_enable_validators(iv, selector_list, "vars") + }) + + anl_inputs <- teal.transform::merge_expression_srv( datasets = data, join_keys = get_join_keys(data), - data_extract = list(vars = vars), + selector_list = selector_list, merge_function = "dplyr::left_join" ) @@ -207,14 +221,7 @@ srv_t_basic_info <- function(id, }) all_q <- shiny::reactive({ - shiny::validate(shiny::need(patient_id(), "Please select a patient.")) - shiny::validate( - shiny::need( - anl_inputs()$columns_source$vars, - "Please select basic info variables." - ) - ) - + teal::validate_inputs(iv_r()) my_calls <- template_basic_info( dataname = "ANL", vars = anl_inputs()$columns_source$vars From 8422f6e46b45784da0ec43c6134b081ee584b434 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Wed, 7 Dec 2022 11:19:14 +0000 Subject: [PATCH 10/69] fix arm_ref_comp example --- R/arm_ref_comp.R | 4 ++-- man/arm_ref_comp_observer.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/arm_ref_comp.R b/R/arm_ref_comp.R index 2aca41b5d8..e0c43847c9 100644 --- a/R/arm_ref_comp.R +++ b/R/arm_ref_comp.R @@ -24,8 +24,8 @@ #' @keywords internal #' #' @examples -#' ds <- teal:::get_dummy_datasets() #' +#' adsl <- data.frame(ARM = c("ARM 1", "ARM2"), ARMCD = c("ARM A", "ARMB")) #' arm_ref_comp <- list(ARMCD = list(ref = "ARM A", comp = c("ARM B"))) #' arm_var <- choices_selected(c("ARM", "ARMCD"), "ARM") #' if (interactive()) { @@ -46,7 +46,7 @@ #' input, #' output, #' id_arm_var = "arm", -#' datasets = ds, +#' data = adsl, #' arm_ref_comp = arm_ref_comp, #' module = "example" #' ) diff --git a/man/arm_ref_comp_observer.Rd b/man/arm_ref_comp_observer.Rd index abc5b808a0..79c84b4909 100644 --- a/man/arm_ref_comp_observer.Rd +++ b/man/arm_ref_comp_observer.Rd @@ -54,8 +54,8 @@ stop the whole observer if FALSE.} Updates the reference and comparison Treatments when the selected Treatment variable changes } \examples{ -ds <- teal:::get_dummy_datasets() +adsl <- data.frame(ARM = c("ARM 1", "ARM2"), ARMCD = c("ARM A", "ARMB")) arm_ref_comp <- list(ARMCD = list(ref = "ARM A", comp = c("ARM B"))) arm_var <- choices_selected(c("ARM", "ARMCD"), "ARM") if (interactive()) { @@ -76,7 +76,7 @@ if (interactive()) { input, output, id_arm_var = "arm", - datasets = ds, + data = adsl, arm_ref_comp = arm_ref_comp, module = "example" ) From 3b3d1ab5637a7f4bd0786d67a8e01c36c4eb26d2 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Wed, 7 Dec 2022 13:14:37 +0000 Subject: [PATCH 11/69] arm_ref_comp_observer --- DESCRIPTION | 2 +- R/arm_ref_comp.R | 76 ++++++++++++++++++++++-------------- man/arm_ref_comp_observer.Rd | 68 ++++++++++++++++++++------------ 3 files changed, 90 insertions(+), 56 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8671e680bc..606d68bfc9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -90,4 +90,4 @@ Encoding: UTF-8 Language: en-US LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.1 +RoxygenNote: 7.2.2 diff --git a/R/arm_ref_comp.R b/R/arm_ref_comp.R index e0c43847c9..a3561b20a8 100644 --- a/R/arm_ref_comp.R +++ b/R/arm_ref_comp.R @@ -20,39 +20,52 @@ #' stop the whole observer if FALSE. #' @param input_id (`character`) unique id that the buckets will be referenced with. #' @param output_id (`character`) name of the UI id that the output will be written to. -#' +#' @return Returns a `shinyvalidate::InputValidator` which checks that there is at least one reference +#' and comparison arm #' @keywords internal #' #' @examples #' -#' adsl <- data.frame(ARM = c("ARM 1", "ARM2"), ARMCD = c("ARM A", "ARMB")) #' arm_ref_comp <- list(ARMCD = list(ref = "ARM A", comp = c("ARM B"))) -#' arm_var <- choices_selected(c("ARM", "ARMCD"), "ARM") -#' if (interactive()) { -#' shinyApp( -#' ui = fluidPage( -#' teal.widgets::optionalSelectInput( -#' "arm", -#' "Treatment Variable", -#' choices = arm_var$choices, -#' selected = arm_var$selected -#' ), -#' shiny::uiOutput("arms_buckets"), +#' arm_var <- choices_selected(c("ARM", "ARMCD"), "ARMCD") +#' +#' adsl <- data.frame(ARM = c("ARM 1", "ARM2"), ARMCD = c("ARM A", "ARMB")) +#' +#' shiny::shinyApp( +#' ui = fluidPage( +#' teal.widgets::optionalSelectInput( +#' "arm", +#' "Treatment Variable", +#' choices = arm_var$choices, +#' selected = arm_var$selected #' ), -#' server = function(input, output, session) { -#' shiny::isolate({ -#' teal.modules.clinical:::arm_ref_comp_observer( -#' session, -#' input, -#' output, -#' id_arm_var = "arm", -#' data = adsl, -#' arm_ref_comp = arm_ref_comp, -#' module = "example" -#' ) -#' }) -#' } -#' ) +#' shiny::uiOutput("arms_buckets"), +#' shiny::textOutput("result") +#' ), +#' server = function(input, output, session) { +#' +#' iv_arm_ref <- teal.modules.clinical:::arm_ref_comp_observer( +#' session, +#' input, +#' output, +#' id_arm_var = "arm", +#' data = adsl, +#' arm_ref_comp = arm_ref_comp, +#' module = "example" +#' ) +#' +#' output$result <- shiny::renderText({ +#' iv <- shinyvalidate::InputValidator$new() +#' iv$add_validator(iv_arm_ref) +#' iv$enable() +#' teal::validate_inputs(iv) +#' "Valid selection has been made!" +#' }) +#' +#' } +#' ) +#' if (interactive()) { +#' shiny::shinyApp(ui, server) #' } arm_ref_comp_observer <- function(session, input, @@ -66,8 +79,12 @@ arm_ref_comp_observer <- function(session, on_off = shiny::reactive(TRUE), input_id = "buckets", output_id = "arms_buckets") { - # uses observe because observeEvent evaluates only when on_off() is switched - # not necessarily when variables are dropped + + iv <- shinyvalidate::InputValidator$new() + iv$add_rule(input_id, function(data) if (length(data[[id_ref]]) == 0) "A reference arm must be selected") + iv$add_rule(input_id, function(data) if (length(data[[id_comp]]) == 0) "A comparison arm must be selected") + + output[[output_id]] <- shiny::renderUI({ if (!is.null(on_off()) && on_off()) { df <- if (shiny::is.reactive(data)) { @@ -112,6 +129,7 @@ arm_ref_comp_observer <- function(session, ) } }) + return(iv) } #' Check if the Treatment variable is reference or compare diff --git a/man/arm_ref_comp_observer.Rd b/man/arm_ref_comp_observer.Rd index 79c84b4909..ed1b54988e 100644 --- a/man/arm_ref_comp_observer.Rd +++ b/man/arm_ref_comp_observer.Rd @@ -49,40 +49,56 @@ stop the whole observer if FALSE.} \item{output_id}{(\code{character}) name of the UI id that the output will be written to.} } +\value{ +Returns a \code{shinyvalidate::InputValidator} which checks that there is at least one reference +and comparison arm +} \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} Updates the reference and comparison Treatments when the selected Treatment variable changes } \examples{ -adsl <- data.frame(ARM = c("ARM 1", "ARM2"), ARMCD = c("ARM A", "ARMB")) arm_ref_comp <- list(ARMCD = list(ref = "ARM A", comp = c("ARM B"))) -arm_var <- choices_selected(c("ARM", "ARMCD"), "ARM") -if (interactive()) { - shinyApp( - ui = fluidPage( - teal.widgets::optionalSelectInput( - "arm", - "Treatment Variable", - choices = arm_var$choices, - selected = arm_var$selected - ), - shiny::uiOutput("arms_buckets"), +arm_var <- choices_selected(c("ARM", "ARMCD"), "ARMCD") + +adsl <- data.frame(ARM = c("ARM 1", "ARM2"), ARMCD = c("ARM A", "ARMB")) + +shiny::shinyApp( + ui = fluidPage( + teal.widgets::optionalSelectInput( + "arm", + "Treatment Variable", + choices = arm_var$choices, + selected = arm_var$selected ), - server = function(input, output, session) { - shiny::isolate({ - teal.modules.clinical:::arm_ref_comp_observer( - session, - input, - output, - id_arm_var = "arm", - data = adsl, - arm_ref_comp = arm_ref_comp, - module = "example" - ) - }) - } - ) + shiny::uiOutput("arms_buckets"), + shiny::textOutput("result") + ), + server = function(input, output, session) { + + iv_arm_ref <- teal.modules.clinical:::arm_ref_comp_observer( + session, + input, + output, + id_arm_var = "arm", + data = adsl, + arm_ref_comp = arm_ref_comp, + module = "example" + ) + + output$result <- shiny::renderText({ + iv <- shinyvalidate::InputValidator$new() + iv$add_validator(iv_arm_ref) + iv$enable() + teal::validate_inputs(iv) + "Valid selection has been made!" + }) + + } +) +if (interactive()) { + shiny::shinyApp(ui, server) } } \keyword{internal} From c918a787581c4063d5a53464e2fbfb2655b98b10 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Wed, 7 Dec 2022 13:19:32 +0000 Subject: [PATCH 12/69] arm ref comp in coxreg --- R/tm_t_coxreg.R | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index 4dc65fb357..046ed599e7 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -756,7 +756,7 @@ srv_t_coxreg <- function(id, shiny::moduleServer(id, function(input, output, session) { # Observer to update reference and comparison arm input options. - arm_ref_comp_observer( + iv_arm_ref <- arm_ref_comp_observer( session, input, output, @@ -766,9 +766,7 @@ srv_t_coxreg <- function(id, module = "tm_t_coxreg" ) - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, - join_keys = get_join_keys(data), + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, paramcd = paramcd, @@ -777,6 +775,20 @@ srv_t_coxreg <- function(id, cnsr_var = cnsr_var, cov_var = cov_var ), + datasets = data, + select_validation_rule = NULL + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_validator(iv_arm_ref) + teal.transform::compose_and_enable_validators(iv, selector_list, NULL) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + join_keys = get_join_keys(data), + selector_list = selector_list, merge_function = "dplyr::inner_join" ) @@ -818,6 +830,8 @@ srv_t_coxreg <- function(id, ## Prepare the call evaluation environment ---- validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) + adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] From 0b95894c10b449c831c186b4afa5fcd88372f733 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Wed, 7 Dec 2022 13:58:30 +0000 Subject: [PATCH 13/69] tm_g_forest_tte --- R/tm_g_forest_tte.R | 41 +++++++++++++++++++++++++++-------------- 1 file changed, 27 insertions(+), 14 deletions(-) diff --git a/R/tm_g_forest_tte.R b/R/tm_g_forest_tte.R index 33fcbf79f7..58ec8171be 100644 --- a/R/tm_g_forest_tte.R +++ b/R/tm_g_forest_tte.R @@ -484,7 +484,7 @@ srv_g_forest_tte <- function(id, shiny::moduleServer(id, function(input, output, session) { # Setup arm variable selection, default reference arms, and default # comparison arms for encoding panel - arm_ref_comp_observer( + iv_arm_ref <- arm_ref_comp_observer( session, input, output, @@ -494,8 +494,7 @@ srv_g_forest_tte <- function(id, module = "tm_g_forest_tte" ) - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, paramcd = paramcd, @@ -505,7 +504,31 @@ srv_g_forest_tte <- function(id, cnsr_var = cnsr_var, time_unit_var = time_unit_var ), + datasets = data, + select_validation_rule = list( + aval_var = shinyvalidate::sv_required("An analysis variable is required"), + cnsr_var = shinyvalidate::sv_required("A censor variable is required"), + arm_var = shinyvalidate::sv_required("A treatment variable is required") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule( + "conf_level", + shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between 0 and 1") + ) + iv$add_validator(iv_arm_ref) + teal.transform::compose_and_enable_validators( + iv, selector_list, c("aval_var", "cnsr_var", "arm_var") + ) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, join_keys = get_join_keys(data), + selector_list = selector_list, merge_function = "dplyr::inner_join" ) @@ -523,6 +546,7 @@ srv_g_forest_tte <- function(id, }) validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) qenv <- anl_q() adsl_filtered <- qenv[[parentname]] anl_filtered <- qenv[[dataname]] @@ -574,21 +598,10 @@ srv_g_forest_tte <- function(id, do.call(what = "validate_standard_inputs", validate_args) - shiny::validate(shiny::need( - input$conf_level >= 0 && input$conf_level <= 1, - "Please choose a confidence level between 0 and 1" - )) - shiny::validate(shiny::need( length(anl[[input_paramcd]]) > 0, "Value of the endpoint variable should not be empty." )) - shiny::validate( - shiny::need(checkmate::test_string(input_aval_var), "Analysis variable should be a single column.") - ) - shiny::validate( - shiny::need(checkmate::test_string(input_cnsr_var), "Censor variable should be a single column.") - ) NULL }) From add1d4b43370adc57781d83d57265a1fdf2a41e2 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 8 Dec 2022 15:16:09 +0000 Subject: [PATCH 14/69] more coxreg --- R/tm_t_coxreg.R | 34 ++++++++++++++-------------------- 1 file changed, 14 insertions(+), 20 deletions(-) diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index c2ea4db4bf..dd3a046783 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -776,13 +776,25 @@ srv_t_coxreg <- function(id, cov_var = cov_var ), datasets = data, - select_validation_rule = NULL + select_validation_rule = list( + aval_var = shinyvalidate::sv_required("An analysis variable is required"), + cnsr_var = shinyvalidate::sv_required("A censor variable is required"), + arm_var = shinyvalidate::sv_required("A treatment variable is required") + ) ) iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_validator(iv_arm_ref) - teal.transform::compose_and_enable_validators(iv, selector_list, NULL) + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule( + "conf_level", + shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between 0 and 1") + ) + iv$add_rule("pval_method", ~ if( length(merged$anl_input_r()$columns_source$strata_var) > 0 && . != "wald") { + "Only Wald tests are supported for models with strata." + }) + teal.transform::compose_and_enable_validators(iv, selector_list, c("aval_var", "cnsr_var", "arm_var")) }) anl_inputs <- teal.transform::merge_expression_srv( @@ -862,11 +874,6 @@ srv_t_coxreg <- function(id, validate_args <- append(validate_args, list(min_n_levels_armvar = NULL)) } - shiny::validate(shiny::need( - input$conf_level >= 0 && input$conf_level <= 1, - "Please choose a confidence level between 0 and 1" - )) - teal::validate_no_intersection( input_arm_var, input_strata_var, @@ -896,14 +903,6 @@ srv_t_coxreg <- function(id, "Each treatment group should have at least 2 records." )) - # validate p-value method - if (length(input_strata_var) > 0) { - shiny::validate(shiny::need( - input$pval_method == "wald", - "Only Wald tests are supported for models with strata." - )) - } - if (input$type == "Multivariate") { shiny::validate(shiny::need( input$interactions == FALSE, @@ -925,11 +924,6 @@ srv_t_coxreg <- function(id, )) } - shiny::validate( - shiny::need(checkmate::test_string(input_aval_var), "Analysis variable should be a single column.") - ) - shiny::validate(shiny::need(checkmate::test_string(input_cnsr_var), "Censor variable should be a single column.")) - # validate covariate has at least two levels shiny::validate( shiny::need( From 8181992f635561c2136febb71a41c567cb428fb9 Mon Sep 17 00:00:00 2001 From: Mahmoud Hallal <86970066+mhallal1@users.noreply.github.com> Date: Thu, 8 Dec 2022 16:34:58 +0100 Subject: [PATCH 15/69] summary modules (#701) --- R/tm_t_summary.R | 34 +++++++++++++++++++++++----------- R/tm_t_summary_by.R | 30 +++++++++++++++++++++++------- 2 files changed, 46 insertions(+), 18 deletions(-) diff --git a/R/tm_t_summary.R b/R/tm_t_summary.R index ba038f3c3f..ae4d65ab19 100644 --- a/R/tm_t_summary.R +++ b/R/tm_t_summary.R @@ -424,10 +424,27 @@ srv_summary <- function(id, with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_inputs <- teal.transform::merge_expression_module( + + selector_list <- teal.transform::data_extract_multiple_srv( + data_extract = list(arm_var = arm_var, summarize_vars = summarize_vars), + datasets = data, + select_validation_rule = list( + arm_var = shinyvalidate::sv_required("Please select a treatment variable"), + summarize_vars = ~ if (length(.) != 1 && length(.) != 2) + "Please select 1 or 2 summary variables" + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("numeric_stats", shinyvalidate::sv_required("Please select at least one statistic to display.")) + teal.transform::compose_and_enable_validators(iv, selector_list, c("arm_var", "summarize_vars")) + }) + + anl_inputs <- teal.transform::merge_expression_srv( id = "anl_merge", datasets = data, - data_extract = list(arm_var = arm_var, summarize_vars = summarize_vars), + selector_list = selector_list, join_keys = get_join_keys(data), merge_function = "dplyr::inner_join" ) @@ -435,8 +452,8 @@ srv_summary <- function(id, adsl_inputs <- teal.transform::merge_expression_module( id = "adsl_merge", datasets = data, - join_keys = get_join_keys(data), data_extract = list(arm_var = arm_var), + join_keys = get_join_keys(data), anl_name = "ANL_ADSL" ) @@ -471,6 +488,7 @@ srv_summary <- function(id, # validate inputs validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] anl <- merged$anl_q()[["ANL"]] @@ -488,24 +506,18 @@ srv_summary <- function(id, "i.e. USUBJID is different in each row" ) ), - shiny::need(input_arm_var, "Please select a treatment variable"), - shiny::need(input_summarize_vars, "Please select a summarize variable"), shiny::need( !any(vapply(anl_filtered[, input_summarize_vars], inherits, c("Date", "POSIXt"), FUN.VALUE = logical(1) )), "Date and POSIXt variables are not supported, please select other variables" ), - shiny::need(length(input_arm_var) <= 2, "Please limit column variables within two"), if (length(input_arm_var) == 2) { shiny::need( - is.factor(adsl_filtered[[input_arm_var[[2]]]]) & all(!adsl_filtered[[input_arm_var[[2]]]] %in% c( - "", NA - )), + is.factor(adsl_filtered[[input_arm_var[[2]]]]) & all(!adsl_filtered[[input_arm_var[[2]]]] %in% c("", NA)), "Please check nested treatment variable which needs to be a factor without NA or empty strings." ) - }, - shiny::need(!is.null(input$numeric_stats), "Please select at least one statistic to display.") + } ) validate_standard_inputs( diff --git a/R/tm_t_summary_by.R b/R/tm_t_summary_by.R index 989eadd34d..50a75f0766 100644 --- a/R/tm_t_summary_by.R +++ b/R/tm_t_summary_by.R @@ -590,14 +590,33 @@ srv_summary_by <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - vars <- list(arm_var = arm_var, id_var = id_var, by_vars = by_vars, summarize_vars = summarize_vars) + vars <- list(arm_var = arm_var, id_var = id_var, summarize_vars = summarize_vars, by_vars = by_vars) + if (!is.null(paramcd)) { vars[["paramcd"]] <- paramcd } - anl_inputs <- teal.transform::merge_expression_module( + validation_rules <- list( + arm_var = shinyvalidate::sv_required("Please select a treatment variable."), + id_var = shinyvalidate::sv_required("Please select a subject identifier."), + summarize_vars = shinyvalidate::sv_required("Please select a summarize variable.") + ) + + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = vars, datasets = data, + select_validation_rule = validation_rules + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("numeric_stats", shinyvalidate::sv_required("Please select at least one statistic to display.")) + teal.transform::compose_and_enable_validators(iv, selector_list, c("arm_var", "id_var", "summarize_vars")) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + selector_list = selector_list, + datasets = data, join_keys = get_join_keys(data), merge_function = "dplyr::inner_join" ) @@ -624,6 +643,7 @@ srv_summary_by <- function(id, # Prepare the analysis environment (filter data, check data, populate envir). validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] @@ -635,16 +655,12 @@ srv_summary_by <- function(id, # validate inputs shiny::validate( - shiny::need(input_arm_var, "Please select a treatment variable."), - shiny::need(input_id_var, "Please select a subject identifier."), - shiny::need(input_summarize_vars, "Please select a summarize variable."), if (!all(input_summarize_vars %in% names(adsl_filtered))) { shiny::need( input[[extract_input("paramcd", paramcd$filter[[1]]$dataname, filter = TRUE)]], "`Select Endpoint` is not selected." ) - }, - shiny::need(!is.null(input$numeric_stats), "Please select at least one statistic to display.") + } ) validate_standard_inputs( adsl = adsl_filtered, From c3e282083a966cede641e29da0899362c3fb38a9 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 8 Dec 2022 16:32:48 +0000 Subject: [PATCH 16/69] tm_g_ipp --- R/tm_g_ipp.R | 33 +++++++++++++++++++++++---------- 1 file changed, 23 insertions(+), 10 deletions(-) diff --git a/R/tm_g_ipp.R b/R/tm_g_ipp.R index b679c43086..31259b4a19 100644 --- a/R/tm_g_ipp.R +++ b/R/tm_g_ipp.R @@ -474,7 +474,8 @@ srv_g_ipp <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_inputs <- teal.transform::merge_expression_module( + + selector_list <- teal.transform::data_extract_multiple_srv( datasets = data, data_extract = list( arm_var = arm_var, @@ -485,6 +486,25 @@ srv_g_ipp <- function(id, visit_var = visit_var, base_var = base_var ), + select_validation_rule = list( + aval_var = shinyvalidate::sv_required("A Parameter values over Time must be selected"), + avalu_var = shinyvalidate::sv_required("An Analysis Variable Unit must be selected"), + visit_var = shinyvalidate::sv_required("A Timepoint Variable must be selected"), + id_var = shinyvalidate::sv_required("A Patient ID must be selected"), + base_var = shinyvalidate::sv_required("Baseline Parameter Values must be selected") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + teal.transform::compose_and_enable_validators( + iv, selector_list, c("aval_var", "avalu_var", "visit_var", "id_var", "base_var") + ) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + selector_list = selector_list, merge_function = "dplyr::inner_join", join_keys = get_join_keys(data) ) @@ -504,6 +524,8 @@ srv_g_ipp <- function(id, # Prepare the analysis environment (filter data, check data, populate envir). validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) + qenv <- anl_q() adsl_filtered <- qenv[[parentname]] anl_filtered <- qenv[[dataname]] @@ -536,15 +558,6 @@ srv_g_ipp <- function(id, ) do.call(what = "validate_standard_inputs", validate_args) - - shiny::validate( - shiny::need(checkmate::test_string(input_aval_var), "Analysis variable should be a single column.") - ) - - shiny::validate( - shiny::need(checkmate::test_string(input_visit_var), "Please select a timepoint variable.") - ) - NULL }) From 35d695613e7ec1367dece83cf2571b3b987f3e89 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Fri, 9 Dec 2022 11:51:17 +0000 Subject: [PATCH 17/69] cox reg filtering --- R/tm_t_coxreg.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index dd3a046783..1426bfc493 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -780,6 +780,9 @@ srv_t_coxreg <- function(id, aval_var = shinyvalidate::sv_required("An analysis variable is required"), cnsr_var = shinyvalidate::sv_required("A censor variable is required"), arm_var = shinyvalidate::sv_required("A treatment variable is required") + ), + filter_validation_rule = list( + paramcd = shinyvalidate::sv_required("An endpoint is required") ) ) @@ -794,7 +797,7 @@ srv_t_coxreg <- function(id, iv$add_rule("pval_method", ~ if( length(merged$anl_input_r()$columns_source$strata_var) > 0 && . != "wald") { "Only Wald tests are supported for models with strata." }) - teal.transform::compose_and_enable_validators(iv, selector_list, c("aval_var", "cnsr_var", "arm_var")) + teal.transform::compose_and_enable_validators(iv, selector_list, c("aval_var", "cnsr_var", "arm_var", "paramcd")) }) anl_inputs <- teal.transform::merge_expression_srv( From 386223fcbb4e62b0554c9e4f4739164c2c1d2c96 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Fri, 9 Dec 2022 13:18:27 +0000 Subject: [PATCH 18/69] more coxreg --- R/tm_t_coxreg.R | 74 ++++++++++++++++++++++++++----------------------- 1 file changed, 40 insertions(+), 34 deletions(-) diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index 1426bfc493..05067de2f9 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -766,6 +766,32 @@ srv_t_coxreg <- function(id, module = "tm_t_coxreg" ) + overlap_rule <- function(other_var, var_name) { + function(data) { + if (length(intersect(data, as.vector(merged$anl_input_r()$columns_source[[other_var]]))) > 0 ) { + sprintf("`%s` and `%s` variables should not overlap", var_name[1], var_name[2]) + } + } + } + + select_validation_rule <- list( + aval_var = shinyvalidate::sv_required("An analysis variable is required"), + cnsr_var = shinyvalidate::sv_required("A censor variable is required"), + arm_var = shinyvalidate::compose_rules( + shinyvalidate::sv_required("A treatment variable is required"), + overlap_rule("strata_var", c("Treatment", "Strata")), + overlap_rule("cov_var", c("Treatment", "Covariate")) + ), + strata_var = shinyvalidate::compose_rules( + overlap_rule("arm_var", c("Treatment", "Strata")), + overlap_rule("cov_var", c("Covariate", "Strata")) + ), + cov_var = shinyvalidate::compose_rules( + overlap_rule("arm_var", c("Treatment", "Covariate")), + overlap_rule("strata_var", c("Covariate", "Strata")) + ) + ) + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, @@ -776,11 +802,7 @@ srv_t_coxreg <- function(id, cov_var = cov_var ), datasets = data, - select_validation_rule = list( - aval_var = shinyvalidate::sv_required("An analysis variable is required"), - cnsr_var = shinyvalidate::sv_required("A censor variable is required"), - arm_var = shinyvalidate::sv_required("A treatment variable is required") - ), + select_validation_rule = select_validation_rule, filter_validation_rule = list( paramcd = shinyvalidate::sv_required("An endpoint is required") ) @@ -797,7 +819,9 @@ srv_t_coxreg <- function(id, iv$add_rule("pval_method", ~ if( length(merged$anl_input_r()$columns_source$strata_var) > 0 && . != "wald") { "Only Wald tests are supported for models with strata." }) - teal.transform::compose_and_enable_validators(iv, selector_list, c("aval_var", "cnsr_var", "arm_var", "paramcd")) + teal.transform::compose_and_enable_validators( + iv, selector_list, c("aval_var", "cnsr_var", "arm_var", "paramcd", "strata_var", "cov_var") + ) }) anl_inputs <- teal.transform::merge_expression_srv( @@ -829,10 +853,15 @@ srv_t_coxreg <- function(id, ) } + use_interactions <- reactive({ + input$type == "Univariate" && !is.null(input$interactions) && input$interactions + }) + + output$interaction_input <- shiny::renderUI({ # exclude cases when increments are not necessary and # finally accessing the UI-rendering function defined above. - if (!is.null(input$interactions) && input$interactions) { + if (use_interactions()) { input_cov_var <- as.vector(merged$anl_input_r()$columns_source$cov_var) dataset <- merged$anl_q()[[dataname]] cov_is_numeric <- vapply(dataset[input_cov_var], is.numeric, logical(1)) @@ -877,22 +906,6 @@ srv_t_coxreg <- function(id, validate_args <- append(validate_args, list(min_n_levels_armvar = NULL)) } - teal::validate_no_intersection( - input_arm_var, - input_strata_var, - "`Treatment` and `Strata` variables should not be overlapped." - ) - teal::validate_no_intersection( - input_arm_var, - input_cov_var, - "`Treatment` and `Covariate` variables should not be overlapped." - ) - teal::validate_no_intersection( - input_strata_var, - input_cov_var, - "`Strata` and `Covariate` variables should not be overlapped." - ) - do.call(what = "validate_standard_inputs", validate_args) arm_n <- base::table(anl_filtered[[input_arm_var]]) @@ -906,14 +919,7 @@ srv_t_coxreg <- function(id, "Each treatment group should have at least 2 records." )) - if (input$type == "Multivariate") { - shiny::validate(shiny::need( - input$interactions == FALSE, - "Interaction is only supported for univariate models." - )) - } - - if (!is.null(input$interactions) && input$interactions) { + if (use_interactions()) { shiny::validate(shiny::need( (length(input_cov_var) > 0), "If interactions are selected at least one covariate should be specified." @@ -933,7 +939,7 @@ srv_t_coxreg <- function(id, all(vapply(anl_filtered[input_cov_var], FUN = function(x) { length(unique(x)) > 1 }, logical(1))), - "All covariate needs to have at least two levels" + "All covariates needs to have at least two levels" ) ) @@ -966,7 +972,7 @@ srv_t_coxreg <- function(id, cov_var <- as.vector(anl$columns_source$cov_var) cov_var <- if (length(cov_var) > 0) cov_var else NULL - at <- if (!is.null(input$interactions) && input$interactions) at() else list() + at <- if (use_interactions()) at() else list() arm_var <- as.vector(anl$columns_source$arm_var) cnsr_var <- as.vector(anl$columns_source$cnsr_var) aval_var <- as.vector(anl$columns_source$aval_var) @@ -976,7 +982,7 @@ srv_t_coxreg <- function(id, pval_method = input$pval_method, ties = input$ties, conf_level = as.numeric(input$conf_level), - interaction = `if`(is.null(input$interactions), FALSE, input$interactions) + interaction = `if`(!use_interactions(), FALSE, input$interactions) ) if (multivariate) { From d17347195430335f7b8fcab7aa2faaae1f1b8c01 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Fri, 9 Dec 2022 13:25:33 +0000 Subject: [PATCH 19/69] coxreg --- R/tm_t_coxreg.R | 21 ++++++++------------- 1 file changed, 8 insertions(+), 13 deletions(-) diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index 05067de2f9..4ba6a66ee8 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -766,6 +766,10 @@ srv_t_coxreg <- function(id, module = "tm_t_coxreg" ) + use_interactions <- reactive({ + input$type == "Univariate" && !is.null(input$interactions) && input$interactions + }) + overlap_rule <- function(other_var, var_name) { function(data) { if (length(intersect(data, as.vector(merged$anl_input_r()$columns_source[[other_var]]))) > 0 ) { @@ -788,7 +792,10 @@ srv_t_coxreg <- function(id, ), cov_var = shinyvalidate::compose_rules( overlap_rule("arm_var", c("Treatment", "Covariate")), - overlap_rule("strata_var", c("Covariate", "Strata")) + overlap_rule("strata_var", c("Covariate", "Strata")), + ~ if (use_interactions() && length(.) == 0) { + "If interactions are selected at least one covariate should be specified." + } ) ) @@ -853,11 +860,6 @@ srv_t_coxreg <- function(id, ) } - use_interactions <- reactive({ - input$type == "Univariate" && !is.null(input$interactions) && input$interactions - }) - - output$interaction_input <- shiny::renderUI({ # exclude cases when increments are not necessary and # finally accessing the UI-rendering function defined above. @@ -919,13 +921,6 @@ srv_t_coxreg <- function(id, "Each treatment group should have at least 2 records." )) - if (use_interactions()) { - shiny::validate(shiny::need( - (length(input_cov_var) > 0), - "If interactions are selected at least one covariate should be specified." - )) - } - if (!is.null(input$interactions) && input$interactions && length(interaction_var) > 0) { shiny::validate(shiny::need( all(vapply(at(), function(x) length(x) > 0, logical(1))), From 09a689264be4700bd33081db8d26bca2af6507d1 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Fri, 9 Dec 2022 13:55:58 +0000 Subject: [PATCH 20/69] coxreg finished --- R/tm_t_coxreg.R | 37 +++++++++++++++++++++++-------------- R/utils.R | 10 ++++++++++ 2 files changed, 33 insertions(+), 14 deletions(-) diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index 4ba6a66ee8..fae00aa55b 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -826,6 +826,18 @@ srv_t_coxreg <- function(id, iv$add_rule("pval_method", ~ if( length(merged$anl_input_r()$columns_source$strata_var) > 0 && . != "wald") { "Only Wald tests are supported for models with strata." }) + # add rules for interaction_var text inputs + for (val in interaction_var_r()) { + iv$add_rule( + paste0("interact_", val), + shinyvalidate::sv_required(paste("Interaction level(s) should be specified for", val)) + ) + iv$add_rule( + paste0("interact_", val), + ~ if (anyNA(as_numeric_from_comma_sep_str(.))) + paste("Numeric interaction level(s) should be specified for", val) + ) + } teal.transform::compose_and_enable_validators( iv, selector_list, c("aval_var", "cnsr_var", "arm_var", "paramcd", "strata_var", "cov_var") ) @@ -860,17 +872,22 @@ srv_t_coxreg <- function(id, ) } - output$interaction_input <- shiny::renderUI({ + interaction_var_r <- reactive({ # exclude cases when increments are not necessary and # finally accessing the UI-rendering function defined above. if (use_interactions()) { input_cov_var <- as.vector(merged$anl_input_r()$columns_source$cov_var) dataset <- merged$anl_q()[[dataname]] cov_is_numeric <- vapply(dataset[input_cov_var], is.numeric, logical(1)) - interaction_var <- input_cov_var[cov_is_numeric] - if (length(interaction_var) > 0 && length(input_cov_var) > 0) { - lapply(interaction_var, open_textinput, dataset = dataset) - } + input_cov_var[cov_is_numeric] + } else{ + NULL + } + }) + + output$interaction_input <- shiny::renderUI({ + if (length(interaction_var_r()) > 0) { + lapply(interaction_var_r(), open_textinput, dataset = merged$anl_q()[[dataname]]) } }) @@ -921,13 +938,6 @@ srv_t_coxreg <- function(id, "Each treatment group should have at least 2 records." )) - if (!is.null(input$interactions) && input$interactions && length(interaction_var) > 0) { - shiny::validate(shiny::need( - all(vapply(at(), function(x) length(x) > 0, logical(1))), - "Please specify all the interaction levels." - )) - } - # validate covariate has at least two levels shiny::validate( shiny::need( @@ -951,8 +961,7 @@ srv_t_coxreg <- function(id, function(x) { cov <- input[[paste0("interact_", x)]] if (!is.null(cov)) { - vec <- strsplit(cov, split = ",") - as.numeric(unlist(vec)) + as_numeric_from_comma_sep_str(cov) } } ) diff --git a/R/utils.R b/R/utils.R index 535988ae70..340a8e7470 100644 --- a/R/utils.R +++ b/R/utils.R @@ -872,3 +872,13 @@ get_paramcd_label <- function(anl, paramcd) { label_paramcd }) } + +as_numeric_from_comma_sep_str <- function(input_string) { + if (!is.null(input_string) && trimws(input_string) != "") { + ref_line <- unlist(strsplit(trimws(input_string), ",")) + ref_line <- suppressWarnings(as.numeric(ref_line)) + } else { + ref_line <- NULL + } + return(ref_line) +} From 9ac216cbe8b2ee9d20c5ef0e3b148cfa1786c893 Mon Sep 17 00:00:00 2001 From: Mahmoud Hallal Date: Fri, 9 Dec 2022 15:51:56 +0100 Subject: [PATCH 21/69] add filter validation --- R/tm_g_ci.R | 5 ++++- R/tm_g_forest_tte.R | 5 +++-- R/tm_g_ipp.R | 6 +++++- R/tm_g_lineplot.R | 5 ++++- R/tm_t_coxreg.R | 5 ++++- R/tm_t_summary_by.R | 25 +++++++++++++++---------- 6 files changed, 35 insertions(+), 16 deletions(-) diff --git a/R/tm_g_ci.R b/R/tm_g_ci.R index b1cdf7014b..c5c097c830 100644 --- a/R/tm_g_ci.R +++ b/R/tm_g_ci.R @@ -384,7 +384,10 @@ srv_g_ci <- function(id, # nolint select_validation_rule = list( x_var = shinyvalidate::sv_required("Select a treatment (x axis)"), y_var = shinyvalidate::sv_required("Select an analysis value (y axis)") - ) + ), + filter_validation_rule = list( + y_var = shinyvalidate::sv_required(message = "Please select the filters.") + ) ) iv_r <- reactive({ diff --git a/R/tm_g_forest_tte.R b/R/tm_g_forest_tte.R index 58ec8171be..427c3e6149 100644 --- a/R/tm_g_forest_tte.R +++ b/R/tm_g_forest_tte.R @@ -509,7 +509,8 @@ srv_g_forest_tte <- function(id, aval_var = shinyvalidate::sv_required("An analysis variable is required"), cnsr_var = shinyvalidate::sv_required("A censor variable is required"), arm_var = shinyvalidate::sv_required("A treatment variable is required") - ) + ), + filter_validation_rule = list(paramcd = shinyvalidate::sv_required(message = "Please select Endpoint filter.")) ) iv_r <- reactive({ @@ -521,7 +522,7 @@ srv_g_forest_tte <- function(id, ) iv$add_validator(iv_arm_ref) teal.transform::compose_and_enable_validators( - iv, selector_list, c("aval_var", "cnsr_var", "arm_var") + iv, selector_list, c("aval_var", "cnsr_var", "arm_var", "paramcd") ) }) diff --git a/R/tm_g_ipp.R b/R/tm_g_ipp.R index 31259b4a19..7ea423dc36 100644 --- a/R/tm_g_ipp.R +++ b/R/tm_g_ipp.R @@ -492,13 +492,17 @@ srv_g_ipp <- function(id, visit_var = shinyvalidate::sv_required("A Timepoint Variable must be selected"), id_var = shinyvalidate::sv_required("A Patient ID must be selected"), base_var = shinyvalidate::sv_required("Baseline Parameter Values must be selected") + ), + filter_validation_rule = list( + paramcd = shinyvalidate::sv_required(message = "Please select Parameter filter."), + arm_var = shinyvalidate::sv_required(message = "Please select Arm filter.") ) ) iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() teal.transform::compose_and_enable_validators( - iv, selector_list, c("aval_var", "avalu_var", "visit_var", "id_var", "base_var") + iv, selector_list, c("aval_var", "avalu_var", "visit_var", "id_var", "base_var", "paramcd", "arm_var") ) }) diff --git a/R/tm_g_lineplot.R b/R/tm_g_lineplot.R index b19d71dec6..3f9cdfd7d9 100644 --- a/R/tm_g_lineplot.R +++ b/R/tm_g_lineplot.R @@ -526,6 +526,9 @@ srv_g_lineplot <- function(id, x = shinyvalidate::sv_required("Please select a single time variable"), y = shinyvalidate::sv_required("Please select a single analysis variable"), strata = shinyvalidate::sv_required("Please select a treatment variable") + ), + filter_validation_rule = list( + param = shinyvalidate::sv_required(message = "Please select Biomarker filter.") ) ) @@ -540,7 +543,7 @@ srv_g_lineplot <- function(id, ) iv$add_rule("interval", shinyvalidate::sv_required("Please select an interval for the midpoint statistic")) iv$add_rule("whiskers", shinyvalidate::sv_required("At least one of the whiskers must be selected")) - teal.transform::compose_and_enable_validators(iv, selector_list, c("x", "y", "strata")) + teal.transform::compose_and_enable_validators(iv, selector_list, c("x", "y", "strata", "param")) }) anl_inputs <- teal.transform::merge_expression_srv( diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index dd3a046783..c9f103db3d 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -780,6 +780,9 @@ srv_t_coxreg <- function(id, aval_var = shinyvalidate::sv_required("An analysis variable is required"), cnsr_var = shinyvalidate::sv_required("A censor variable is required"), arm_var = shinyvalidate::sv_required("A treatment variable is required") + ), + filter_validation_rule = list( + paramcd = shinyvalidate::sv_required(message = "Please select Endpoint filter.") ) ) @@ -794,7 +797,7 @@ srv_t_coxreg <- function(id, iv$add_rule("pval_method", ~ if( length(merged$anl_input_r()$columns_source$strata_var) > 0 && . != "wald") { "Only Wald tests are supported for models with strata." }) - teal.transform::compose_and_enable_validators(iv, selector_list, c("aval_var", "cnsr_var", "arm_var")) + teal.transform::compose_and_enable_validators(iv, selector_list, c("aval_var", "cnsr_var", "arm_var", "paramcd")) }) anl_inputs <- teal.transform::merge_expression_srv( diff --git a/R/tm_t_summary_by.R b/R/tm_t_summary_by.R index 50a75f0766..b2f48f6ae8 100644 --- a/R/tm_t_summary_by.R +++ b/R/tm_t_summary_by.R @@ -605,13 +605,18 @@ srv_summary_by <- function(id, selector_list <- teal.transform::data_extract_multiple_srv( data_extract = vars, datasets = data, - select_validation_rule = validation_rules + select_validation_rule = validation_rules, + filter_validation_rule = list(paramcd = shinyvalidate::sv_required(message = "Please select a filter.")) ) iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("numeric_stats", shinyvalidate::sv_required("Please select at least one statistic to display.")) - teal.transform::compose_and_enable_validators(iv, selector_list, c("arm_var", "id_var", "summarize_vars")) + teal.transform::compose_and_enable_validators( + iv, + selector_list, + c("arm_var", "id_var", "summarize_vars", "paramcd") + ) }) anl_inputs <- teal.transform::merge_expression_srv( @@ -654,14 +659,14 @@ srv_summary_by <- function(id, input_paramcd <- `if`(is.null(paramcd), NULL, unlist(paramcd$filter)["vars_selected"]) # validate inputs - shiny::validate( - if (!all(input_summarize_vars %in% names(adsl_filtered))) { - shiny::need( - input[[extract_input("paramcd", paramcd$filter[[1]]$dataname, filter = TRUE)]], - "`Select Endpoint` is not selected." - ) - } - ) + # shiny::validate( + # if (!all(input_summarize_vars %in% names(adsl_filtered))) { + # shiny::need( + # input[[extract_input("paramcd", paramcd$filter[[1]]$dataname, filter = TRUE)]], + # "`Select Endpoint` is not selected." + # ) + # } + # ) validate_standard_inputs( adsl = adsl_filtered, adslvars = c("USUBJID", "STUDYID", input_arm_var), From 0a2e17f8c0afabdb21a826b7d7fcfd9429590ce2 Mon Sep 17 00:00:00 2001 From: Mahmoud Hallal Date: Fri, 9 Dec 2022 16:31:18 +0100 Subject: [PATCH 22/69] remove comment --- R/tm_t_summary_by.R | 8 -------- 1 file changed, 8 deletions(-) diff --git a/R/tm_t_summary_by.R b/R/tm_t_summary_by.R index b2f48f6ae8..7a80c75374 100644 --- a/R/tm_t_summary_by.R +++ b/R/tm_t_summary_by.R @@ -659,14 +659,6 @@ srv_summary_by <- function(id, input_paramcd <- `if`(is.null(paramcd), NULL, unlist(paramcd$filter)["vars_selected"]) # validate inputs - # shiny::validate( - # if (!all(input_summarize_vars %in% names(adsl_filtered))) { - # shiny::need( - # input[[extract_input("paramcd", paramcd$filter[[1]]$dataname, filter = TRUE)]], - # "`Select Endpoint` is not selected." - # ) - # } - # ) validate_standard_inputs( adsl = adsl_filtered, adslvars = c("USUBJID", "STUDYID", input_arm_var), From fa4f81ac391c6bc443fb85cb52032ef57a1643c8 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 13 Dec 2022 12:02:17 +0000 Subject: [PATCH 23/69] remove list of selectors when enabling --- R/tm_g_ci.R | 2 +- R/tm_g_forest_tte.R | 4 +--- R/tm_g_ipp.R | 4 +--- R/tm_g_lineplot.R | 2 +- R/tm_t_coxreg.R | 4 +--- R/tm_t_events.R | 2 +- R/tm_t_pp_basic_info.R | 2 +- R/tm_t_summary.R | 2 +- R/tm_t_summary_by.R | 6 +----- 9 files changed, 9 insertions(+), 19 deletions(-) diff --git a/R/tm_g_ci.R b/R/tm_g_ci.R index c5c097c830..4394a4a2b4 100644 --- a/R/tm_g_ci.R +++ b/R/tm_g_ci.R @@ -397,7 +397,7 @@ srv_g_ci <- function(id, # nolint "conf_level", shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between 0 and 1") ) - teal.transform::compose_and_enable_validators(iv, selector_list, c("x_var", "y_var")) + teal.transform::compose_and_enable_validators(iv, selector_list) }) anl_inputs <- teal.transform::merge_expression_srv( diff --git a/R/tm_g_forest_tte.R b/R/tm_g_forest_tte.R index 427c3e6149..28a454b2e1 100644 --- a/R/tm_g_forest_tte.R +++ b/R/tm_g_forest_tte.R @@ -521,9 +521,7 @@ srv_g_forest_tte <- function(id, shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between 0 and 1") ) iv$add_validator(iv_arm_ref) - teal.transform::compose_and_enable_validators( - iv, selector_list, c("aval_var", "cnsr_var", "arm_var", "paramcd") - ) + teal.transform::compose_and_enable_validators(iv, selector_list) }) anl_inputs <- teal.transform::merge_expression_srv( diff --git a/R/tm_g_ipp.R b/R/tm_g_ipp.R index 7ea423dc36..824bc58329 100644 --- a/R/tm_g_ipp.R +++ b/R/tm_g_ipp.R @@ -501,9 +501,7 @@ srv_g_ipp <- function(id, iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() - teal.transform::compose_and_enable_validators( - iv, selector_list, c("aval_var", "avalu_var", "visit_var", "id_var", "base_var", "paramcd", "arm_var") - ) + teal.transform::compose_and_enable_validators(iv, selector_list) }) anl_inputs <- teal.transform::merge_expression_srv( diff --git a/R/tm_g_lineplot.R b/R/tm_g_lineplot.R index 3f9cdfd7d9..00a535db25 100644 --- a/R/tm_g_lineplot.R +++ b/R/tm_g_lineplot.R @@ -543,7 +543,7 @@ srv_g_lineplot <- function(id, ) iv$add_rule("interval", shinyvalidate::sv_required("Please select an interval for the midpoint statistic")) iv$add_rule("whiskers", shinyvalidate::sv_required("At least one of the whiskers must be selected")) - teal.transform::compose_and_enable_validators(iv, selector_list, c("x", "y", "strata", "param")) + teal.transform::compose_and_enable_validators(iv, selector_list) }) anl_inputs <- teal.transform::merge_expression_srv( diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index fae00aa55b..1c32f789c1 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -838,9 +838,7 @@ srv_t_coxreg <- function(id, paste("Numeric interaction level(s) should be specified for", val) ) } - teal.transform::compose_and_enable_validators( - iv, selector_list, c("aval_var", "cnsr_var", "arm_var", "paramcd", "strata_var", "cov_var") - ) + teal.transform::compose_and_enable_validators(iv, selector_list) }) anl_inputs <- teal.transform::merge_expression_srv( diff --git a/R/tm_t_events.R b/R/tm_t_events.R index d0b7ff67ed..fc1f391a5d 100644 --- a/R/tm_t_events.R +++ b/R/tm_t_events.R @@ -665,7 +665,7 @@ srv_t_events_byterm <- function(id, "prune_diff", shinyvalidate::sv_between(0, 100, message_fmt = "Please provide a Difference Rate between 0 and 100 (%).") ) - teal.transform::compose_and_enable_validators(iv, selector_list, c("arm_var", "hlt", "llt")) + teal.transform::compose_and_enable_validators(iv, selector_list) }) anl_inputs <- teal.transform::merge_expression_srv( diff --git a/R/tm_t_pp_basic_info.R b/R/tm_t_pp_basic_info.R index b9d8e54bae..95708b3f1d 100644 --- a/R/tm_t_pp_basic_info.R +++ b/R/tm_t_pp_basic_info.R @@ -205,7 +205,7 @@ srv_t_basic_info <- function(id, iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient")) - teal.transform::compose_and_enable_validators(iv, selector_list, "vars") + teal.transform::compose_and_enable_validators(iv, selector_list) }) anl_inputs <- teal.transform::merge_expression_srv( diff --git a/R/tm_t_summary.R b/R/tm_t_summary.R index ae4d65ab19..bd638ada51 100644 --- a/R/tm_t_summary.R +++ b/R/tm_t_summary.R @@ -438,7 +438,7 @@ srv_summary <- function(id, iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("numeric_stats", shinyvalidate::sv_required("Please select at least one statistic to display.")) - teal.transform::compose_and_enable_validators(iv, selector_list, c("arm_var", "summarize_vars")) + teal.transform::compose_and_enable_validators(iv, selector_list) }) anl_inputs <- teal.transform::merge_expression_srv( diff --git a/R/tm_t_summary_by.R b/R/tm_t_summary_by.R index 7a80c75374..f4fb842c54 100644 --- a/R/tm_t_summary_by.R +++ b/R/tm_t_summary_by.R @@ -612,11 +612,7 @@ srv_summary_by <- function(id, iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("numeric_stats", shinyvalidate::sv_required("Please select at least one statistic to display.")) - teal.transform::compose_and_enable_validators( - iv, - selector_list, - c("arm_var", "id_var", "summarize_vars", "paramcd") - ) + teal.transform::compose_and_enable_validators(iv, selector_list) }) anl_inputs <- teal.transform::merge_expression_srv( From 3d8b2b22bdedf18e0b1c2ead4c5d0256efcc7a1a Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 13 Dec 2022 13:10:58 +0000 Subject: [PATCH 24/69] data to value --- R/arm_ref_comp.R | 4 ++-- R/tm_t_coxreg.R | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/arm_ref_comp.R b/R/arm_ref_comp.R index a3561b20a8..f72c4d4ae1 100644 --- a/R/arm_ref_comp.R +++ b/R/arm_ref_comp.R @@ -81,8 +81,8 @@ arm_ref_comp_observer <- function(session, output_id = "arms_buckets") { iv <- shinyvalidate::InputValidator$new() - iv$add_rule(input_id, function(data) if (length(data[[id_ref]]) == 0) "A reference arm must be selected") - iv$add_rule(input_id, function(data) if (length(data[[id_comp]]) == 0) "A comparison arm must be selected") + iv$add_rule(input_id, function(value) if (length(value[[id_ref]]) == 0) "A reference arm must be selected") + iv$add_rule(input_id, function(value) if (length(value[[id_comp]]) == 0) "A comparison arm must be selected") output[[output_id]] <- shiny::renderUI({ diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index 1c32f789c1..38d66f586e 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -771,8 +771,8 @@ srv_t_coxreg <- function(id, }) overlap_rule <- function(other_var, var_name) { - function(data) { - if (length(intersect(data, as.vector(merged$anl_input_r()$columns_source[[other_var]]))) > 0 ) { + function(value) { + if (length(intersect(value, as.vector(merged$anl_input_r()$columns_source[[other_var]]))) > 0 ) { sprintf("`%s` and `%s` variables should not overlap", var_name[1], var_name[2]) } } From 90cbf4f0eea49d4be6dd401584166b90a8c1201a Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 13 Dec 2022 13:32:09 +0000 Subject: [PATCH 25/69] tm_g_km --- R/tm_g_km.R | 90 +++++++++++++++++++++++++++++++---------------------- R/utils.R | 4 +-- 2 files changed, 54 insertions(+), 40 deletions(-) diff --git a/R/tm_g_km.R b/R/tm_g_km.R index ed2acbbfcc..56e4d33223 100644 --- a/R/tm_g_km.R +++ b/R/tm_g_km.R @@ -634,7 +634,7 @@ srv_g_km <- function(id, shiny::moduleServer(id, function(input, output, session) { # Setup arm variable selection, default reference arms and default # comparison arms for encoding panel - arm_ref_comp_observer( + iv_arm_ref <- arm_ref_comp_observer( session, input, output, @@ -645,8 +645,7 @@ srv_g_km <- function(id, on_off = shiny::reactive(input$compare_arms) ) - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( aval_var = aval_var, cnsr_var = cnsr_var, @@ -656,8 +655,50 @@ srv_g_km <- function(id, facet_var = facet_var, time_unit_var = time_unit_var ), - merge_function = "dplyr::inner_join", - join_keys = get_join_keys(data) + datasets = data, + select_validation_rule = list( + aval_var = shinyvalidate::sv_required("An analysis variable is required"), + cnsr_var = shinyvalidate::sv_required("A censor variable is required"), + arm_var = shinyvalidate::sv_required("A treatment variable is required") + ), + filter_validation_rule = list( + paramcd = shinyvalidate::sv_required("An endpoint is required") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_validator(iv_arm_ref); + iv$add_rule("font_size", shinyvalidate::sv_required("Plot tables font size must be greater than or equal to 5")) + iv$add_rule("font_size", shinyvalidate::sv_gte(5, "Plot tables font size must be greater than or equal to 5.")) + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule( + "conf_level", + shinyvalidate::sv_between( + 0, 1, inclusive = c(FALSE, FALSE), + message_fmt = "Please choose a confidence level between 0 and 1" + ) + ) + iv$add_rule("xticks", shinyvalidate::sv_optional()) + iv$add_rule( + "xticks", + function(value) { + val <- as_numeric_from_comma_sep_str(value, split_char = ";") + if (anyNA(val) || any(val < 0)) { + "All break intervals for x-axis must be non-negative numbers" + } else if (all(val == 0)) { + "Not all break intervals for x-axis can be 0" + } + } + ) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + join_keys = get_join_keys(data), + selector_list = selector_list, + merge_function = "dplyr::inner_join" ) anl_q <- reactive({ @@ -668,6 +709,8 @@ srv_g_km <- function(id, }) validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) + qenv <- anl_q() adsl_filtered <- qenv[[parentname]] anl_filtered <- qenv[[dataname]] @@ -680,10 +723,6 @@ srv_g_km <- function(id, input_cnsr_var <- as.vector(anl_m$columns_source$cnsr_var) input_paramcd <- unlist(paramcd$filter)["vars_selected"] input_time_unit_var <- as.vector(anl_m$columns_source$time_unit_var) - input_xticks <- gsub(";", ",", trimws(input$xticks)) %>% - strsplit(",") %>% - unlist() %>% - as.numeric() # validate inputs validate_args <- list( @@ -706,28 +745,6 @@ srv_g_km <- function(id, } do.call(what = "validate_standard_inputs", validate_args) - # validate xticks - if (length(input_xticks) == 0) { - input_xticks <- NULL - } else { - shiny::validate(shiny::need(all(!is.na(input_xticks)), "Not all values entered were numeric")) - shiny::validate(shiny::need(all(input_xticks >= 0), "All break intervals for x-axis must be non-negative")) - shiny::validate(shiny::need(any(input_xticks > 0), "At least one break interval for x-axis must be positive")) - } - - shiny::validate(shiny::need( - input$conf_level > 0 && input$conf_level < 1, - "Please choose a confidence level between 0 and 1" - )) - - shiny::validate( - shiny::need(checkmate::test_string(input_aval_var), "Analysis variable should be a single column.") - ) - shiny::validate(shiny::need(checkmate::test_string(input_cnsr_var), "Censor variable should be a single column.")) - - # validate font size - shiny::validate(shiny::need(input$font_size >= 5, "Plot tables font size must be greater than or equal to 5.")) - NULL }) @@ -740,13 +757,10 @@ srv_g_km <- function(id, anl <- qenv[["ANL"]] # nolint teal::validate_has_data(anl, 2) - input_xticks <- gsub(";", ",", trimws(input$xticks)) %>% - strsplit(",") %>% - unlist() %>% - as.numeric() - - if (length(input_xticks) == 0) { - input_xticks <- NULL + input_xticks <- if (!is.null(input$xticks)) { + as_numeric_from_comma_sep_str(input$xticks, split_char = ";") + } else { + NULL } input_paramcd <- as.character(unique(anl[[as.vector(anl_m$columns_source$paramcd)]])) diff --git a/R/utils.R b/R/utils.R index 340a8e7470..d5de16e49b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -873,9 +873,9 @@ get_paramcd_label <- function(anl, paramcd) { }) } -as_numeric_from_comma_sep_str <- function(input_string) { +as_numeric_from_comma_sep_str <- function(input_string, split_char = ",") { if (!is.null(input_string) && trimws(input_string) != "") { - ref_line <- unlist(strsplit(trimws(input_string), ",")) + ref_line <- unlist(strsplit(trimws(input_string), split_char)) ref_line <- suppressWarnings(as.numeric(ref_line)) } else { ref_line <- NULL From 44e3bb4e007d5b4b6c47b65e58b64dabe61b2deb Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 13 Dec 2022 20:56:02 +0000 Subject: [PATCH 26/69] tm_t_tte --- R/tm_g_km.R | 2 +- R/tm_t_tte.R | 69 ++++++++++++++++++++++++++++++++-------------------- 2 files changed, 43 insertions(+), 28 deletions(-) diff --git a/R/tm_g_km.R b/R/tm_g_km.R index 56e4d33223..6cbf9415f4 100644 --- a/R/tm_g_km.R +++ b/R/tm_g_km.R @@ -668,7 +668,7 @@ srv_g_km <- function(id, iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() - iv$add_validator(iv_arm_ref); + iv$add_validator(iv_arm_ref) iv$add_rule("font_size", shinyvalidate::sv_required("Plot tables font size must be greater than or equal to 5")) iv$add_rule("font_size", shinyvalidate::sv_gte(5, "Plot tables font size must be greater than or equal to 5.")) iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) diff --git a/R/tm_t_tte.R b/R/tm_t_tte.R index e29f557832..37c33b4945 100644 --- a/R/tm_t_tte.R +++ b/R/tm_t_tte.R @@ -720,7 +720,7 @@ srv_t_tte <- function(id, shiny::moduleServer(id, function(input, output, session) { # Setup arm variable selection, default reference arms, and default # comparison arms for encoding panel - arm_ref_comp_observer( + iv_arm_ref <- arm_ref_comp_observer( session, input, output, @@ -731,8 +731,7 @@ srv_t_tte <- function(id, on_off = shiny::reactive(input$compare_arms) ) - anl_merge_inputs <- teal.transform::merge_expression_module( - datasets = data, + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, paramcd = paramcd, @@ -742,6 +741,45 @@ srv_t_tte <- function(id, event_desc_var = event_desc_var, time_unit_var = time_unit_var ), + datasets = data, + select_validation_rule = list( + aval_var = shinyvalidate::sv_required("An analysis variable is required"), + cnsr_var = shinyvalidate::sv_required("A censor variable is required"), + arm_var = shinyvalidate::sv_required("A treatment variable is required"), + event_desc_var = shinyvalidate::sv_required("An event description variable is required"), + time_unit_var= shinyvalidate::sv_required("A Time unit variable is required") + ), + filter_validation_rule = list( + paramcd = shinyvalidate::sv_required("An endpoint is required") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_validator(iv_arm_ref) + + iv$add_rule("conf_level_coxph", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule( + "conf_level_coxph", shinyvalidate::sv_between( + 0, 1, message_fmt = "Please choose a confidence level between 0 and 1" + ) + ) + iv$add_rule("conf_level_survfit", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule( + "conf_level_survfit", shinyvalidate::sv_between( + 0, 1, message_fmt = "Please choose a confidence level between 0 and 1" + ) + ) + iv$add_rule( + "probs_survfit", + ~ if (!is.null(.) && .[1] == .[2]) "KM Estimate Percentiles cannot have a range of size 0" + ) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_merge_inputs <- teal.transform::merge_expression_srv( + datasets = data, + selector_list = selector_list, join_keys = get_join_keys(data), merge_function = "dplyr::inner_join" ) @@ -761,6 +799,7 @@ srv_t_tte <- function(id, # Prepare the analysis environment (filter data, check data, populate envir). validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) adsl_filtered <- anl_q()[[parentname]] anl_filtered <- anl_q()[[dataname]] anl <- anl_q()[["ANL"]] @@ -799,36 +838,12 @@ srv_t_tte <- function(id, do.call(what = "validate_standard_inputs", validate_args) - shiny::validate(shiny::need( - input$conf_level_coxph >= 0 && input$conf_level_coxph <= 1, - "Please choose a confidence level between 0 and 1" - )) - - shiny::validate(shiny::need( - input$conf_level_survfit >= 0 && input$conf_level_survfit <= 1, - "Please choose a confidence level between 0 and 1" - )) - - shiny::validate( - shiny::need(checkmate::test_string(input_aval_var), "Analysis variable should be a single column.") - ) - shiny::validate(shiny::need(checkmate::test_string(input_cnsr_var), "Censor variable should be a single column.")) - shiny::validate(shiny::need( - checkmate::test_string(input_event_desc), - "Event description variable should be a single column." - )) - # check that there is at least one record with no missing data shiny::validate(shiny::need( !all(is.na(anl[[input_aval_var]])), "ANCOVA table cannot be calculated as all values are missing." )) - shiny::validate(shiny::need( - length(input[[extract_input("paramcd", paramcd$filter[[1]]$dataname, filter = TRUE)]]) > 0, - "`Select Endpoint` field is NULL" - )) - NULL }) From 836732595880ae51eee7991f48d49ff648ce56a0 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Wed, 14 Dec 2022 11:53:11 +0000 Subject: [PATCH 27/69] tm_a_gee --- R/tm_a_gee.R | 74 ++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 52 insertions(+), 22 deletions(-) diff --git a/R/tm_a_gee.R b/R/tm_a_gee.R index d9532b1196..d7e0707445 100644 --- a/R/tm_a_gee.R +++ b/R/tm_a_gee.R @@ -216,15 +216,13 @@ tm_a_gee <- function(label, args <- as.list(environment()) data_extract_list <- list( - arm_var = teal.modules.clinical::cs_to_des_select(arm_var, dataname = parentname), - paramcd = teal.modules.clinical::cs_to_des_filter(paramcd, dataname = dataname), - id_var = teal.modules.clinical::cs_to_des_select(id_var, dataname = dataname), - visit_var = teal.modules.clinical::cs_to_des_select(visit_var, dataname = dataname), - cov_var = teal.modules.clinical::cs_to_des_select(cov_var, dataname = dataname, multiple = TRUE), - split_covariates = teal.modules.clinical::cs_to_des_select(teal.modules.clinical::split_choices(cov_var), - dataname = dataname, multiple = TRUE - ), - aval_var = teal.modules.clinical::cs_to_des_select(aval_var, dataname = dataname) + arm_var = cs_to_des_select(arm_var, dataname = parentname), + paramcd = cs_to_des_filter(paramcd, dataname = dataname), + id_var = cs_to_des_select(id_var, dataname = dataname), + visit_var = cs_to_des_select(visit_var, dataname = dataname), + cov_var = cs_to_des_select(cov_var, dataname = dataname, multiple = TRUE), + split_covariates = cs_to_des_select(split_choices(cov_var),dataname = dataname, multiple = TRUE), + aval_var = cs_to_des_select(aval_var, dataname = dataname) ) teal::module( @@ -308,13 +306,11 @@ ui_gee <- function(id, ...) { data_extract_spec = a$arm_var, is_single_dataset = is_single_dataset_value ), - shinyjs::hidden(shiny::uiOutput(ns("arms_buckets"))), shinyjs::hidden( + shiny::uiOutput(ns("arms_buckets")), shiny::helpText( id = ns("help_text"), "Multiple reference groups are automatically combined into a single group." - ) - ), - shinyjs::hidden( + ), shiny::checkboxInput( ns("combine_comp_arms"), "Combine all comparison groups?", @@ -391,14 +387,14 @@ srv_gee <- function(id, shiny::moduleServer(id, function(input, output, session) { ## split_covariates ---- - shiny::observeEvent(input[[teal.modules.clinical::extract_input("cov_var", dataname)]], + shiny::observeEvent(input[[extract_input("cov_var", dataname)]], ignoreNULL = FALSE, { # update covariates as actual variables - split_interactions_values <- teal.modules.clinical::split_interactions( - input[[teal.modules.clinical::extract_input("cov_var", dataname)]] + split_interactions_values <- split_interactions( + input[[extract_input("cov_var", dataname)]] ) - arm_var_value <- input[[teal.modules.clinical::extract_input("arm_var", parentname)]] + arm_var_value <- input[[extract_input("arm_var", parentname)]] arm_in_cov <- length(intersect(split_interactions_values, arm_var_value)) >= 1L if (arm_in_cov) { split_covariates_selected <- setdiff(split_interactions_values, arm_var_value) @@ -407,7 +403,7 @@ srv_gee <- function(id, } teal.widgets::updateOptionalSelectInput( session, - inputId = teal.modules.clinical::extract_input("split_covariates", dataname), + inputId = extract_input("split_covariates", dataname), selected = split_covariates_selected ) } @@ -418,15 +414,14 @@ srv_gee <- function(id, session, input, output, - id_arm_var = teal.modules.clinical::extract_input("arm_var", parentname), + id_arm_var = extract_input("arm_var", parentname), data = data[[parentname]], arm_ref_comp = arm_ref_comp, module = "tm_a_gee" ) ## data_merge_modules ---- - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, paramcd = paramcd, @@ -435,6 +430,35 @@ srv_gee <- function(id, split_covariates = split_covariates, aval_var = aval_var ), + datasets = data, + select_validation_rule = list( + aval_var = shinyvalidate::sv_required("An analysis variable is required"), + arm_var = shinyvalidate::sv_required("A treatment variable is required"), + id_var = shinyvalidate::sv_required("A Subject identifier is required"), + visit_var = shinyvalidate::sv_required("A visit variable is required") + ), + filter_validation_rule = list( + paramcd = shinyvalidate::sv_required("An endpoint is required") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule( + "conf_level", + shinyvalidate::sv_between( + 0, 1, inclusive = c(FALSE, FALSE), + message_fmt = "Please choose a confidence level between 0 and 1" + ) + ) + iv$add_rule("cor_struct", shinyvalidate::sv_required("Please choose a correlation structure")) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + selector_list = selector_list, merge_function = "dplyr::inner_join", join_keys = get_join_keys(data) ) @@ -461,10 +485,16 @@ srv_gee <- function(id, # Initially hide the output title because there is no output yet. shinyjs::show("gee_title") - # To do in production: add validations. + validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) + + # To do in production: add validations. + NULL + }) ## table_r ---- table_q <- shiny::reactive({ + validate_checks() output_table <- input$output_table conf_level <- as.numeric(input$conf_level) col_source <- merged$anl_input_r()$columns_source From a027a257fea362402b9ae1045b414f1202ce4ba2 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Wed, 14 Dec 2022 12:23:22 +0000 Subject: [PATCH 28/69] tm_t_shift_by_arm --- R/tm_t_shift_by_arm.R | 38 +++++++++++++++++++++++++++++++------- 1 file changed, 31 insertions(+), 7 deletions(-) diff --git a/R/tm_t_shift_by_arm.R b/R/tm_t_shift_by_arm.R index a15e1f7eac..a7a1b7db00 100644 --- a/R/tm_t_shift_by_arm.R +++ b/R/tm_t_shift_by_arm.R @@ -394,9 +394,8 @@ srv_shift_by_arm <- function(id, with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, - join_keys = get_join_keys(data), + + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, paramcd = paramcd, @@ -405,6 +404,32 @@ srv_shift_by_arm <- function(id, base_var = base_var, treatment_flag_var = treatment_flag_var ), + datasets = data, + select_validation_rule = list( + aval_var = shinyvalidate::sv_required("An analysis range indicator required"), + arm_var = shinyvalidate::sv_required("A treatment variable is required"), + treatment_flag_var = shinyvalidate::sv_required("An on treatment flag variable is required"), + base_var = shinyvalidate::sv_required("A baseline reference range indicator is required") + ), + filter_validation_rule = list( + paramcd = shinyvalidate::sv_required("An endpoint is required"), + visit_var = shinyvalidate::sv_required("A visit is required") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule( + "treatment_flag", + shinyvalidate::sv_required("An indicator value for on treatment records is required") + ) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + join_keys = get_join_keys(data), + selector_list = selector_list, merge_function = "dplyr::inner_join" ) @@ -429,6 +454,8 @@ srv_shift_by_arm <- function(id, # validate inputs validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) + adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] @@ -438,16 +465,13 @@ srv_shift_by_arm <- function(id, input_treatment_flag_var <- names(merged$anl_input_r()$columns_source$treatment_flag_var) shiny::validate( - shiny::need(input_arm_var, "Please select a treatment variable"), shiny::need( nrow(merged$anl_q()[["ANL"]]) > 0, paste0( "Please make sure the analysis dataset is not empty or\n", "endpoint parameter and analysis visit are selected." ) - ), - shiny::need(input_treatment_flag_var, "Please select an on treatment flag variable."), - shiny::need(input$treatment_flag, "Please select indicator value for on treatment records.") + ) ) validate_standard_inputs( From 5f38cf79067889194d3e9e9bcbb37810be62c1de Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Wed, 14 Dec 2022 13:12:19 +0000 Subject: [PATCH 29/69] tm_t_shift_by_grade --- R/tm_t_shift_by_grade.R | 37 +++++++++++++++++++++++++++---------- 1 file changed, 27 insertions(+), 10 deletions(-) diff --git a/R/tm_t_shift_by_grade.R b/R/tm_t_shift_by_grade.R index 70755b5bd4..3f7b12bc71 100644 --- a/R/tm_t_shift_by_grade.R +++ b/R/tm_t_shift_by_grade.R @@ -751,9 +751,8 @@ srv_t_shift_by_grade <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, - join_keys = get_join_keys(data), + + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, visit_var = visit_var, @@ -763,6 +762,30 @@ srv_t_shift_by_grade <- function(id, anl_toxgrade_var = anl_toxgrade_var, base_toxgrade_var = base_toxgrade_var ), + datasets = data, + select_validation_rule = list( + base_toxgrade_var = shinyvalidate::sv_required("A baseline toxicity grade is required"), + anl_toxgrade_var = shinyvalidate::sv_required("An analysis toxicity grade is required"), + visit_var = shinyvalidate::sv_required("An analysis visit is required"), + arm_var = shinyvalidate::sv_required("A treatment variable is required"), + worst_flag_var = shinyvalidate::sv_required("A worst treatment flag is required"), + id_var = shinyvalidate::sv_required("A subject identifier is required.") + ), + filter_validation_rule = list( + paramcd = shinyvalidate::sv_required("A laboratory parameter is required") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("worst_flag_indicator", shinyvalidate::sv_required("Please select the value indicating worst grade.")) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + join_keys = get_join_keys(data), + selector_list = selector_list, merge_function = "dplyr::inner_join" ) @@ -786,6 +809,7 @@ srv_t_shift_by_grade <- function(id, ) validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] @@ -798,13 +822,6 @@ srv_t_shift_by_grade <- function(id, input_anl_toxgrade_var <- names(merged$anl_input_r()$columns_source$anl_toxgrade_var) input_base_toxgrade_var <- names(merged$anl_input_r()$columns_source$base_toxgrade_var) - shiny::validate( - shiny::need(input_worst_flag_var, "Please select the worst flag variable."), - shiny::need(input_paramcd, "Please select Laboratory parameter."), - shiny::need(input_id_var, "Please select a subject identifier."), - shiny::need(input$worst_flag_indicator, "Please select the value indicating worst grade.") - ) - # validate inputs validate_standard_inputs( adsl = adsl_filtered, From 3e37f23e2156575f21f966786f170b6e157cfbb1 Mon Sep 17 00:00:00 2001 From: Blazewim Date: Wed, 14 Dec 2022 17:47:02 +0100 Subject: [PATCH 30/69] tm_t_smq --- R/tm_t_smq.R | 39 +++++++++++++++++++++++++-------------- 1 file changed, 25 insertions(+), 14 deletions(-) diff --git a/R/tm_t_smq.R b/R/tm_t_smq.R index 6dd3f634d2..41ff8b7ad9 100644 --- a/R/tm_t_smq.R +++ b/R/tm_t_smq.R @@ -358,7 +358,6 @@ template_smq <- function(dataname, #' choices = variable_choices(adae, subset = c("AEDECOD")), #' selected = "AEDECOD" #' ) -#' ) #' ) #' ) #' if (interactive()) { @@ -536,15 +535,34 @@ srv_t_smq <- function(id, with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( + scopes = scopes, + llt = llt, arm_var = arm_var, id_var = id_var, - baskets = baskets, - scopes = scopes, - llt = llt + baskets = baskets ), + datasets = data, + select_validation_rule = list( + scopes = shinyvalidate::sv_required("A scope variable is required"), + llt = shinyvalidate::sv_required("A low level term variable is required"), + arm_var = shinyvalidate::sv_required("At least one Treatment Variable is required"), + id_var = shinyvalidate::sv_required("An id variable is required"), + baskets = shinyvalidate::sv_required("At least one basket is required") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("arm_var", ~ if (length(.) > 2) "Please select not more than two Treatment Variables") + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + selector_list = selector_list, join_keys = get_join_keys(data), merge_function = "dplyr::inner_join" ) @@ -569,6 +587,7 @@ srv_t_smq <- function(id, ) validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] @@ -578,14 +597,6 @@ srv_t_smq <- function(id, input_scopes <- names(merged$anl_input_r()$columns_source$scopes) input_llt <- names(merged$anl_input_r()$columns_source$llt) - shiny::validate( - shiny::need(input_id_var, "Please select a subject identifier."), - shiny::need(length(input_arm_var) <= 2, "Please limit arm variables within two"), - shiny::need(input_baskets, "Please select the SMQ/CQ baskets."), - shiny::need(input_scopes, "Please select the scope variables."), - shiny::need(input_llt, "Please select the low level term."), - shiny::need(input_arm_var, "Please select the arm variable.") - ) # validate inputs validate_standard_inputs( adsl = adsl_filtered, From af39cf07636e97eb7ed9d61af7ffd744b541aa32 Mon Sep 17 00:00:00 2001 From: Blazewim Date: Wed, 14 Dec 2022 18:03:50 +0100 Subject: [PATCH 31/69] tm_t_smq 2 --- R/tm_t_smq.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/tm_t_smq.R b/R/tm_t_smq.R index 41ff8b7ad9..d10e8bbcd5 100644 --- a/R/tm_t_smq.R +++ b/R/tm_t_smq.R @@ -548,7 +548,10 @@ srv_t_smq <- function(id, select_validation_rule = list( scopes = shinyvalidate::sv_required("A scope variable is required"), llt = shinyvalidate::sv_required("A low level term variable is required"), - arm_var = shinyvalidate::sv_required("At least one Treatment Variable is required"), + arm_var = shinyvalidate::compose_rules( + shinyvalidate::sv_required("At least one Treatment Variable is required"), + ~ if (length(.) > 2) "Please select not more than two Treatment Variables" + ), id_var = shinyvalidate::sv_required("An id variable is required"), baskets = shinyvalidate::sv_required("At least one basket is required") ) @@ -556,7 +559,6 @@ srv_t_smq <- function(id, iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() - iv$add_rule("arm_var", ~ if (length(.) > 2) "Please select not more than two Treatment Variables") teal.transform::compose_and_enable_validators(iv, selector_list) }) From 510b41cadcb6bb73dfdb4116a5c0c8b75d0efa57 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Wed, 14 Dec 2022 20:51:19 +0000 Subject: [PATCH 32/69] fix syntax error in roxygen example --- R/tm_t_smq.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/tm_t_smq.R b/R/tm_t_smq.R index d10e8bbcd5..81162d7f49 100644 --- a/R/tm_t_smq.R +++ b/R/tm_t_smq.R @@ -358,6 +358,7 @@ template_smq <- function(dataname, #' choices = variable_choices(adae, subset = c("AEDECOD")), #' selected = "AEDECOD" #' ) +#' ) #' ) #' ) #' if (interactive()) { From 0f470fe97fe4d58d02dcf7a5cbfa0800f8029b07 Mon Sep 17 00:00:00 2001 From: Blazewim Date: Thu, 15 Dec 2022 11:32:29 +0100 Subject: [PATCH 33/69] tm_t_shift_by_arm_by_worst --- R/tm_t_shift_by_arm_by_worst.R | 41 ++++++++++++++++++++++++++-------- R/tm_t_smq.R | 4 ++-- 2 files changed, 34 insertions(+), 11 deletions(-) diff --git a/R/tm_t_shift_by_arm_by_worst.R b/R/tm_t_shift_by_arm_by_worst.R index a842ebab4b..3072370c66 100644 --- a/R/tm_t_shift_by_arm_by_worst.R +++ b/R/tm_t_shift_by_arm_by_worst.R @@ -417,17 +417,42 @@ srv_shift_by_arm_by_worst <- function(id, with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, - join_keys = get_join_keys(data), + + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, - paramcd = paramcd, + treatment_flag_var = treatment_flag_var, worst_flag_var = worst_flag_var, aval_var = aval_var, base_var = base_var, - treatment_flag_var = treatment_flag_var + paramcd = paramcd ), + datasets = data, + select_validation_rule = list( + arm_var = shinyvalidate::sv_required("A treatment variable is required"), + treatment_flag_var = shinyvalidate::sv_required("A treatment flag variable is required"), + worst_flag_var = shinyvalidate::sv_required("A worst flag variable is required"), + aval_var = shinyvalidate::sv_required("An analysis range indicator required"), + base_var = shinyvalidate::sv_required("A baseline reference range indicator is required") + ), + filter_validation_rule = list( + paramcd = shinyvalidate::sv_required("An endpoint is required") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule( + "treatment_flag", + shinyvalidate::sv_required("An indicator value for on treatment records is required") + ) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + selector_list = selector_list, + join_keys = get_join_keys(data), merge_function = "dplyr::inner_join" ) @@ -452,6 +477,8 @@ srv_shift_by_arm_by_worst <- function(id, # validate inputs validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) + adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] @@ -462,7 +489,6 @@ srv_shift_by_arm_by_worst <- function(id, input_worst_flag_var <- names(merged$anl_input_r()$columns_source$worst_flag_var) shiny::validate( - shiny::need(input_arm_var, "Please select a treatment variable"), shiny::need( nrow(merged$anl_q()[["ANL"]]) > 0, paste0( @@ -470,9 +496,6 @@ srv_shift_by_arm_by_worst <- function(id, "endpoint parameter and analysis visit are selected." ) ), - shiny::need(input_treatment_flag_var, "Please select an on treatment flag variable."), - shiny::need(input$treatment_flag, "Please select indicator value for on treatment records."), - shiny::need(input_worst_flag_var, "Please select a worst flag variable."), shiny::need( length(unique(merged$anl_q()[["ANL"]][[input_aval_var]])) < 50, paste( diff --git a/R/tm_t_smq.R b/R/tm_t_smq.R index d10e8bbcd5..17a1992d54 100644 --- a/R/tm_t_smq.R +++ b/R/tm_t_smq.R @@ -549,8 +549,8 @@ srv_t_smq <- function(id, scopes = shinyvalidate::sv_required("A scope variable is required"), llt = shinyvalidate::sv_required("A low level term variable is required"), arm_var = shinyvalidate::compose_rules( - shinyvalidate::sv_required("At least one Treatment Variable is required"), - ~ if (length(.) > 2) "Please select not more than two Treatment Variables" + shinyvalidate::sv_required("At least one treatment variable is required"), + ~ if (length(.) > 2) "Please select not more than two treatment variables" ), id_var = shinyvalidate::sv_required("An id variable is required"), baskets = shinyvalidate::sv_required("At least one basket is required") From c4fa03140d9b37080fdf2f161979b4956c84e028 Mon Sep 17 00:00:00 2001 From: Marek Blazewicz <110387997+BLAZEWIM@users.noreply.github.com> Date: Thu, 15 Dec 2022 14:33:08 +0100 Subject: [PATCH 34/69] Update tm_t_shift_by_arm_by_worst.R Signed-off-by: Marek Blazewicz <110387997+BLAZEWIM@users.noreply.github.com> --- R/tm_t_shift_by_arm_by_worst.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/tm_t_shift_by_arm_by_worst.R b/R/tm_t_shift_by_arm_by_worst.R index 3072370c66..c8d397023f 100644 --- a/R/tm_t_shift_by_arm_by_worst.R +++ b/R/tm_t_shift_by_arm_by_worst.R @@ -485,8 +485,6 @@ srv_shift_by_arm_by_worst <- function(id, input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var) input_aval_var <- names(merged$anl_input_r()$columns_source$aval_var) input_base_var <- names(merged$anl_input_r()$columns_source$base_var) - input_treatment_flag_var <- names(merged$anl_input_r()$columns_source$treatment_flag_var) - input_worst_flag_var <- names(merged$anl_input_r()$columns_source$worst_flag_var) shiny::validate( shiny::need( From c9d044f93dccebb1aa94a8ef0bb5d6c2f463dad3 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 15 Dec 2022 13:46:09 +0000 Subject: [PATCH 35/69] tm_t_events_summary --- R/tm_t_events_summary.R | 31 +++++++++++++++++++++++-------- 1 file changed, 23 insertions(+), 8 deletions(-) diff --git a/R/tm_t_events_summary.R b/R/tm_t_events_summary.R index 41218a3ad0..d0165d4d34 100644 --- a/R/tm_t_events_summary.R +++ b/R/tm_t_events_summary.R @@ -833,9 +833,26 @@ srv_t_events_summary <- function(id, data_extract_vars[["flag_var_aesi"]] <- flag_var_aesi } - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = data_extract_vars, + datasets = data, + select_validation_rule = list( + arm_var = ~ if (length(.) != 1 && length(.) != 2) "Please select exactly 1 or 2 treatment variables", + dthfl_var = shinyvalidate::sv_required("Death Flag Variable is requried"), + dcsreas_var = shinyvalidate::sv_required("Study Discontinuation Reason Variable is required"), + aeseq_var = shinyvalidate::sv_required("AE Sequence Variable is required"), + llt = shinyvalidate::sv_required("AE Term Variable is required") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + selector_list = selector_list, join_keys = get_join_keys(data), merge_function = "dplyr::inner_join" ) @@ -860,6 +877,8 @@ srv_t_events_summary <- function(id, ) validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) + adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] @@ -880,14 +899,10 @@ srv_t_events_summary <- function(id, input_llt <- as.vector(merged$anl_input_r()$columns_source$llt) shiny::validate( - shiny::need(input_arm_var, "Please select a treatment variable"), - shiny::need(length(input_arm_var) <= 2, "Please limit treatment variables within two"), - if (length(input_arm_var) >= 1) { - shiny::need(is.factor(adsl_filtered[[input_arm_var[[1]]]]), "Treatment variable is not a factor.") - }, + shiny::need(is.factor(adsl_filtered[[input_arm_var[[1]]]]), "Treatment variable is not a factor."), if (length(input_arm_var) == 2) { shiny::need( - is.factor(adsl_filtered[[input_arm_var[[2]]]]) & all(!adsl_filtered[[input_arm_var[[2]]]] %in% c( + is.factor(adsl_filtered[[input_arm_var[[2]]]]) && all(!adsl_filtered[[input_arm_var[[2]]]] %in% c( "", NA )), "Please check nested treatment variable which needs to be a factor without NA or empty strings." From 20133cea9cbd57cf0115fb699292edaf5a71a145 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 15 Dec 2022 14:10:38 +0000 Subject: [PATCH 36/69] tm_t_events_patyear --- R/tm_t_events_patyear.R | 47 +++++++++++++++++++++++++++-------------- 1 file changed, 31 insertions(+), 16 deletions(-) diff --git a/R/tm_t_events_patyear.R b/R/tm_t_events_patyear.R index b0c6796482..7f38f6d721 100644 --- a/R/tm_t_events_patyear.R +++ b/R/tm_t_events_patyear.R @@ -404,8 +404,7 @@ srv_events_patyear <- function(id, } }) - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, paramcd = paramcd, @@ -413,6 +412,35 @@ srv_events_patyear <- function(id, avalu_var = avalu_var, events_var = events_var ), + datasets = data, + select_validation_rule = list( + arm_var = ~ if (length(.) != 1 && length(.) != 2) "Please select exactly 1 or 2 treatment variables", + aval_var = shinyvalidate::sv_required("Analysis Variable is required"), + events_var = shinyvalidate::sv_required("Events Variable is required") + ), + filter_validation_rule = list( + paramcd = shinyvalidate::sv_required("A Event Type Parameter is required") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule( + "conf_level", + shinyvalidate::sv_between( + 0, 1, inclusive = c(FALSE, FALSE), + message_fmt = "Please choose a confidence level between 0 and 1" + ) + ) + iv$add_rule("conf_method", shinyvalidate::sv_required("A CI method is required")) + iv$add_rule("time_unit_output", shinyvalidate::sv_required("Time Unit for AE Rate is required")) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + selector_list = selector_list, join_keys = get_join_keys(data), merge_function = "dplyr::inner_join" ) @@ -438,6 +466,7 @@ srv_events_patyear <- function(id, # Prepare the analysis environment (filter data, check data, populate envir). validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] @@ -456,26 +485,12 @@ srv_events_patyear <- function(id, arm_var = input_arm_var ) - shiny::validate(shiny::need( - input$conf_level > 0 && input$conf_level < 1, - "Please choose a confidence level between 0 and 1" - )) - shiny::validate( - shiny::need(checkmate::test_string(input_aval_var), "`Analysis Variable` should be a single column."), - shiny::need(checkmate::test_string(input_events_var), "Events variable should be a single column."), - shiny::need(input$conf_method, "`CI Method` field is not selected."), - shiny::need(input$time_unit_output, "`Time Unit for AE Rate (in Patient-Years)` field is empty."), - shiny::need( - input[[extract_input("paramcd", paramcd$filter[[1]]$dataname, filter = TRUE)]], - "`Select an Event Type Parameter is not selected." - ), shiny::need( !any(is.na(merged$anl_q()[["ANL"]][[input_events_var]])), "`Event Variable` for selected parameter includes NA values." ) ) - NULL }) From d7acaf98e3d8f6fe430bd466015cdd6fd43ebe60 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 15 Dec 2022 14:33:10 +0000 Subject: [PATCH 37/69] tm_t_events_by_grade --- R/tm_t_events_by_grade.R | 73 +++++++++++++++++++++++++--------------- 1 file changed, 45 insertions(+), 28 deletions(-) diff --git a/R/tm_t_events_by_grade.R b/R/tm_t_events_by_grade.R index 6aa9b57b55..b8cc13ca91 100644 --- a/R/tm_t_events_by_grade.R +++ b/R/tm_t_events_by_grade.R @@ -987,9 +987,50 @@ srv_t_events_by_grade <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list(arm_var = arm_var, hlt = hlt, llt = llt, grade = grade), + datasets = data, + select_validation_rule = list( + arm_var = shinyvalidate::sv_required("A treatment variable is required"), + grade = shinyvalidate::sv_required("An event grade is required"), + hlt = ~ if (length(as.vector(merged$anl_input_r()$columns_source$llt)) + length(.) == 0) + "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables.", + llt = shinyvalidate::compose_rules( + ~ if (length(as.vector(merged$anl_input_r()$columns_source$hlt)) + length(.) == 0) + "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables.", + ~ if (col_by_grade() && length(.) == 0) + "Low Level Term must be present when grade groupings are displayed in nested columns." + ) + ) + ) + + col_by_grade <- reactive({ + input$col_by_grade + }) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule( + "prune_freq", shinyvalidate::sv_required("Please provide an Incidence Rate between 0 and 100 (%).") + ) + iv$add_rule( + "prune_freq", + shinyvalidate::sv_between(0, 100, message_fmt = "Please provide an Incidence Rate between 0 and 100 (%).") + ) + iv$add_rule( + "prune_diff", shinyvalidate::sv_required("Please provide a Difference Rate between 0 and 100 (%).") + ) + iv$add_rule( + "prune_diff", + shinyvalidate::sv_between(0, 100, message_fmt = "Please provide a Difference Rate between 0 and 100 (%).") + ) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + selector_list = selector_list, join_keys = get_join_keys(data), merge_function = "dplyr::inner_join" ) @@ -1014,6 +1055,8 @@ srv_t_events_by_grade <- function(id, ) validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) + adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] adsl_keys <- merged$adsl_input_r()$keys @@ -1025,14 +1068,6 @@ srv_t_events_by_grade <- function(id, ) input_grade <- as.vector(merged$anl_input_r()$columns_source$grade) - shiny::validate( - shiny::need(input_arm_var, "Please select a treatment variable"), - shiny::need(input_grade, "Please select a grade variable") - ) - teal::validate_has_elements( - input_level_term, - "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables.\n If the module is for displaying adverse events with grading groups in nested columns, \"LOW LEVEL TERM\" cannot be empty" # nolint - ) shiny::validate( shiny::need(is.factor(adsl_filtered[[input_arm_var]]), "Treatment variable is not a factor.") ) @@ -1052,24 +1087,6 @@ srv_t_events_by_grade <- function(id, ) ) } - shiny::validate( - shiny::need( - input$prune_freq >= 0 && input$prune_freq <= 100, - "Please provide an Incidence Rate between 0 and 100 (%)." - ), - shiny::need( - input$prune_diff >= 0 && input$prune_diff <= 100, - "Please provide a Difference Rate between 0 and 100 (%)." - ) - ) - if (input$col_by_grade) { - shiny::validate( - shiny::need( - as.vector(merged$anl_input_r()$columns_source$llt), - "Low Level Term must be present for nested grade grouping display." - ) - ) - } # validate inputs validate_standard_inputs( From 37dd17fc418fc04081017645ff5fe0dfd150607c Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Fri, 16 Dec 2022 10:53:53 +0000 Subject: [PATCH 38/69] tm_a_mmrm --- R/tm_a_mmrm.R | 107 +++++++++++++++++++++++++++++--------------------- 1 file changed, 63 insertions(+), 44 deletions(-) diff --git a/R/tm_a_mmrm.R b/R/tm_a_mmrm.R index 1bea322ce1..b947e7a6af 100644 --- a/R/tm_a_mmrm.R +++ b/R/tm_a_mmrm.R @@ -858,16 +858,74 @@ srv_mmrm <- function(id, ) }) - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + arm_ref_comp_iv <- arm_ref_comp_observer( + session, + input, + output, + id_arm_var = extract_input("arm_var", parentname), # From UI. + data = data[[parentname]], + arm_ref_comp = arm_ref_comp, + module = "tm_mmrm" + ) + + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, paramcd = paramcd, id_var = id_var, visit_var = visit_var, split_covariates = split_covariates, + cov_var = cov_var, # only needed for validation see selector_list_without_cov reactive aval_var = aval_var ), + datasets = data, + select_validation_rule = list( + aval_var = shinyvalidate::sv_required("'Analysis Variable' field is not selected"), + visit_var = shinyvalidate::sv_required("'Visit Variable' field is not selected"), + arm_var = shinyvalidate::sv_required("'Treatment Variable' field is not selected"), + id_var = shinyvalidate::sv_required("'Subject Identifier' field is not selected"), + # validation on cov_var + cov_var = function(value) { + if ("BASE:AVISIT" %in% value && anl_inputs()$columns_source$visit_var == "AVISITN") { + paste( + "'BASE:AVISIT' is not a valid covariate when 'AVISITN' is selected as visit variable.", + "Please deselect 'BASE:AVISIT' as a covariate or change visit variable to 'AVISIT'." + ) + } else if ("BASE:AVISITN" %in% value && anl_inputs()$columns_source$visit_var == "AVISIT") { + paste( + "'BASE:AVISITN' is not a valid covariate when 'AVISIT' is selected as visit variable.", + "Please deselect 'BASE:AVISITN' as a covariate or change visit variable to 'AVISITN'." + ) + } + } + ), + filter_validation_rule = list( + paramcd = shinyvalidate::sv_required("'Select Endpoint' field is not selected") + ) + ) + + # selector_list includes cov_var as it is needed for validation rules + # but it is not needed for the merge so it is removed here + selector_list_without_cov <- reactive({ + selector_list()[names(selector_list()) != "cov_var"] + }) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_validator(arm_ref_comp_iv) + iv$add_rule("conf_level", shinyvalidate::sv_required("'Confidence Level' field is not selected")) + iv$add_rule( + "conf_level", + shinyvalidate::sv_between( + 0, 1, message_fmt = "Please choose a confidence level between 0 and 1" + ) + ) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + selector_list = selector_list_without_cov, join_keys = get_join_keys(data), merge_function = "dplyr::inner_join" ) @@ -929,16 +987,6 @@ srv_mmrm <- function(id, } }) - arm_ref_comp_observer( - session, - input, - output, - id_arm_var = extract_input("arm_var", parentname), # From UI. - data = data[[parentname]], - arm_ref_comp = arm_ref_comp, - module = "tm_mmrm" - ) - # Event handler: # Show either the plot or the table output. shiny::observeEvent(input$output_function, { @@ -1035,7 +1083,7 @@ srv_mmrm <- function(id, mmrm_inputs_reactive <- shiny::reactive({ shinyjs::disable("button_start") disable_r_code(TRUE) - + teal::validate_inputs(iv_r()) encoding_inputs <- lapply( sync_inputs, function(x) { @@ -1052,33 +1100,7 @@ srv_mmrm <- function(id, anl_filtered <- anl_q()[[dataname]] shiny::validate( - shiny::need( - encoding_inputs[[extract_input("aval_var", dataname)]], "`Analysis Variable` field is not selected" - ), - shiny::need( - encoding_inputs[[extract_input("paramcd", dataname, filter = TRUE)]], - "`Select Endpoint` field is not selected" - ), - shiny::need(encoding_inputs[[extract_input("visit_var", dataname)]], "`Visit Variable` field is not selected"), - shiny::need(encoding_inputs[[extract_input("id_var", dataname)]], "`Subject Identifier` field is not selected"), - shiny::need(encoding_inputs[["conf_level"]], "`Confidence Level` field is not selected"), - shiny::need(nrow(adsl_filtered) > 1 && nrow(anl_filtered) > 1, "Filtered data has zero rows"), - shiny::need( - !("BASE:AVISIT" %in% encoding_inputs[[extract_input("cov_var", dataname)]] & - encoding_inputs[[extract_input("visit_var", dataname)]] != "AVISIT"), - paste( - "`BASE:AVISIT` is not a valid covariate when `AVISITN` is selected as visit variable.", - "Please deselect `BASE:AVISIT` as a covariate or change visit variable to `AVISIT`." - ) - ), - shiny::need( - !("BASE:AVISITN" %in% encoding_inputs[[extract_input("cov_var", dataname)]] & - encoding_inputs[[extract_input("visit_var", dataname)]] != "AVISITN"), - paste( - "`BASE:AVISITN` is not a valid covariate when `AVISIT` is selected as visit variable.", - "Please deselect `BASE:AVISITN` as a covariate or change visit variable to `AVISITN`." - ) - ) + shiny::need(nrow(adsl_filtered) > 1 && nrow(anl_filtered) > 1, "Filtered data has zero rows") ) validate_checks() c(list(adsl_filtered = adsl_filtered, anl_filtered = anl_filtered), encoding_inputs) @@ -1194,10 +1216,6 @@ srv_mmrm <- function(id, levels(anl_data[[input_visit_var]]) ) - shiny::validate(shiny::need( - input$conf_level >= 0 && input$conf_level <= 1, - "Please choose a confidence level between 0 and 1" - )) }) # Connector: @@ -1421,6 +1439,7 @@ srv_mmrm <- function(id, # Optimizer that was selected. output$optimizer_selected <- shiny::renderText({ # First reassign reactive sources: + req(iv_r()$is_valid()) fit_stack <- try(mmrm_fit(), silent = TRUE) result <- if (!inherits(fit_stack, "try-error")) { fit <- fit_stack[["fit"]] From c2cc890009e4ae9e70a27a4084b5fbfa1207f640 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Fri, 16 Dec 2022 11:10:57 +0000 Subject: [PATCH 39/69] fix tm_a_mmrm --- R/tm_a_mmrm.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/tm_a_mmrm.R b/R/tm_a_mmrm.R index b947e7a6af..ae30cd3fbc 100644 --- a/R/tm_a_mmrm.R +++ b/R/tm_a_mmrm.R @@ -886,12 +886,15 @@ srv_mmrm <- function(id, id_var = shinyvalidate::sv_required("'Subject Identifier' field is not selected"), # validation on cov_var cov_var = function(value) { - if ("BASE:AVISIT" %in% value && anl_inputs()$columns_source$visit_var == "AVISITN") { + if (length(as.vector(anl_inputs()$columns_source$visit_var)) == 0) { + return(NULL) + } + if ("BASE:AVISIT" %in% value && as.vector(anl_inputs()$columns_source$visit_var) == "AVISITN") { paste( "'BASE:AVISIT' is not a valid covariate when 'AVISITN' is selected as visit variable.", "Please deselect 'BASE:AVISIT' as a covariate or change visit variable to 'AVISIT'." ) - } else if ("BASE:AVISITN" %in% value && anl_inputs()$columns_source$visit_var == "AVISIT") { + } else if ("BASE:AVISITN" %in% value && as.vector(anl_inputs()$columns_source$visit_var) == "AVISIT") { paste( "'BASE:AVISITN' is not a valid covariate when 'AVISIT' is selected as visit variable.", "Please deselect 'BASE:AVISITN' as a covariate or change visit variable to 'AVISITN'." From 1a447af2f28b6d343108c32cfefdaa04d876ed07 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Fri, 16 Dec 2022 14:35:50 +0000 Subject: [PATCH 40/69] fixed coxrge --- R/tm_t_coxreg.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index 38d66f586e..73e72bef8d 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -772,7 +772,8 @@ srv_t_coxreg <- function(id, overlap_rule <- function(other_var, var_name) { function(value) { - if (length(intersect(value, as.vector(merged$anl_input_r()$columns_source[[other_var]]))) > 0 ) { + #as.vector(merged$anl_input_r()$columns_source[[other_var]]) + if (length(intersect(value, selector_list()[[other_var]]()$select)) > 0) { sprintf("`%s` and `%s` variables should not overlap", var_name[1], var_name[2]) } } From 57f89c7e6fa98d8dc9cb75c4c81c205b22ad4e93 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Fri, 16 Dec 2022 14:45:11 +0000 Subject: [PATCH 41/69] use selector_list not merge for validation --- R/tm_a_mmrm.R | 6 +++--- R/tm_t_coxreg.R | 1 - R/tm_t_events.R | 4 ++-- R/tm_t_events_by_grade.R | 4 ++-- 4 files changed, 7 insertions(+), 8 deletions(-) diff --git a/R/tm_a_mmrm.R b/R/tm_a_mmrm.R index ae30cd3fbc..f39cf44aec 100644 --- a/R/tm_a_mmrm.R +++ b/R/tm_a_mmrm.R @@ -886,15 +886,15 @@ srv_mmrm <- function(id, id_var = shinyvalidate::sv_required("'Subject Identifier' field is not selected"), # validation on cov_var cov_var = function(value) { - if (length(as.vector(anl_inputs()$columns_source$visit_var)) == 0) { + if (length(selector_list()$visit_var()$select) == 0) { return(NULL) } - if ("BASE:AVISIT" %in% value && as.vector(anl_inputs()$columns_source$visit_var) == "AVISITN") { + if ("BASE:AVISIT" %in% value && selector_list()$visit_var()$select == "AVISITN") { paste( "'BASE:AVISIT' is not a valid covariate when 'AVISITN' is selected as visit variable.", "Please deselect 'BASE:AVISIT' as a covariate or change visit variable to 'AVISIT'." ) - } else if ("BASE:AVISITN" %in% value && as.vector(anl_inputs()$columns_source$visit_var) == "AVISIT") { + } else if ("BASE:AVISITN" %in% value && selector_list()$visit_var()$select == "AVISIT") { paste( "'BASE:AVISITN' is not a valid covariate when 'AVISIT' is selected as visit variable.", "Please deselect 'BASE:AVISITN' as a covariate or change visit variable to 'AVISITN'." diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index 73e72bef8d..a6da3b379c 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -772,7 +772,6 @@ srv_t_coxreg <- function(id, overlap_rule <- function(other_var, var_name) { function(value) { - #as.vector(merged$anl_input_r()$columns_source[[other_var]]) if (length(intersect(value, selector_list()[[other_var]]()$select)) > 0) { sprintf("`%s` and `%s` variables should not overlap", var_name[1], var_name[2]) } diff --git a/R/tm_t_events.R b/R/tm_t_events.R index fc1f391a5d..44eb67a227 100644 --- a/R/tm_t_events.R +++ b/R/tm_t_events.R @@ -646,9 +646,9 @@ srv_t_events_byterm <- function(id, select_validation_rule = list( arm_var = ~ if (length(.) != 1 && length(.) != 2) "Please select 1 or 2 treatment variable values", - hlt = ~ if (length(as.vector(merged$anl_input_r()$columns_source$llt)) + length(.) == 0) + hlt = ~ if (length(selector_list()$llt()$select) + length(.) == 0) "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables.", - llt = ~ if (length(as.vector(merged$anl_input_r()$columns_source$hlt)) + length(.) == 0) + llt = ~ if (length(selector_list()$hlt()$select) + length(.) == 0) "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables." ) ) diff --git a/R/tm_t_events_by_grade.R b/R/tm_t_events_by_grade.R index b8cc13ca91..89dfceb6c2 100644 --- a/R/tm_t_events_by_grade.R +++ b/R/tm_t_events_by_grade.R @@ -994,10 +994,10 @@ srv_t_events_by_grade <- function(id, select_validation_rule = list( arm_var = shinyvalidate::sv_required("A treatment variable is required"), grade = shinyvalidate::sv_required("An event grade is required"), - hlt = ~ if (length(as.vector(merged$anl_input_r()$columns_source$llt)) + length(.) == 0) + hlt = ~ if (length(selector_list()$llt()$select) + length(.) == 0) "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables.", llt = shinyvalidate::compose_rules( - ~ if (length(as.vector(merged$anl_input_r()$columns_source$hlt)) + length(.) == 0) + ~ if (length(selector_list()$hlt()$select) + length(.) == 0) "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables.", ~ if (col_by_grade() && length(.) == 0) "Low Level Term must be present when grade groupings are displayed in nested columns." From 84e40df56b659486a227992133dc8f1384d2e268 Mon Sep 17 00:00:00 2001 From: Marek Blazewicz <110387997+BLAZEWIM@users.noreply.github.com> Date: Fri, 16 Dec 2022 17:15:05 +0100 Subject: [PATCH 42/69] mb tmc shinyvalidate (#704) My commits to https://github.com/insightsengineering/teal.modules.clinical/pull/699 Co-authored-by: Nikolas Burkoff --- R/tm_t_pp_prior_medication.R | 47 +++++++++++++++++++----------------- 1 file changed, 25 insertions(+), 22 deletions(-) diff --git a/R/tm_t_pp_prior_medication.R b/R/tm_t_pp_prior_medication.R index a1bc17f00b..03b885c1b1 100644 --- a/R/tm_t_pp_prior_medication.R +++ b/R/tm_t_pp_prior_medication.R @@ -272,6 +272,28 @@ srv_t_prior_medication <- function(id, shiny::moduleServer(id, function(input, output, session) { patient_id <- shiny::reactive(input$patient_id) + selector_list <- teal.transform::data_extract_multiple_srv( + data_extract = list( + atirel = atirel, + cmdecod = cmdecod, + cmindc = cmindc, + cmstdy = cmstdy + ), + datasets = data, + select_validation_rule = list( + atirel = shinyvalidate::sv_required("An ATIREL variable is required"), + cmdecod = shinyvalidate::sv_required("A medication decoding variable is required"), + cmindc = shinyvalidate::sv_required("A CMINDC variable is required"), + cmstdy = shinyvalidate::sv_required("A CMSTDY variable is required") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("patient_id", shinyvalidate::sv_required("Please select patient id")) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + # Init patient_data_base <- shiny::reactive(unique(data[[parentname]]()[[patient_col]])) teal.widgets::updateOptionalSelectInput( @@ -298,10 +320,10 @@ srv_t_prior_medication <- function(id, ) # Prior medication tab ---- - anl_inputs <- teal.transform::merge_expression_module( + anl_inputs <- teal.transform::merge_expression_srv( datasets = data, + selector_list = selector_list, join_keys = get_join_keys(data), - data_extract = list(atirel = atirel, cmdecod = cmdecod, cmindc = cmindc, cmstdy = cmstdy), merge_function = "dplyr::left_join" ) @@ -311,26 +333,7 @@ srv_t_prior_medication <- function(id, }) all_q <- shiny::reactive({ - shiny::validate(shiny::need(patient_id(), "Please select a patient.")) - - shiny::validate( - shiny::need( - input[[extract_input("atirel", dataname)]], - "Please select ATIREL variable." - ), - shiny::need( - input[[extract_input("cmdecod", dataname)]], - "Please select Medication decoding variable." - ), - shiny::need( - input[[extract_input("cmindc", dataname)]], - "Please select CMINDC variable." - ), - shiny::need( - input[[extract_input("cmstdy", dataname)]], - "Please select CMSTDY variable." - ) - ) + teal::validate_inputs(iv_r()) my_calls <- template_prior_medication( dataname = "ANL", From dadcb39def309b83d15ec167e5dc45c3e59de99c Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 20 Dec 2022 10:10:00 +0000 Subject: [PATCH 43/69] fix coxreg --- R/tm_t_coxreg.R | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index a6da3b379c..0f04654cdf 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -815,6 +815,17 @@ srv_t_coxreg <- function(id, ) ) + + numeric_level_validation <- function(val) { + # need to explicitly evaluate 'val' here to ensure + # the correct label is shown - if this is not done + # then the last value of "val" is the label for all cases + v <- val + ~ if (anyNA(as_numeric_from_comma_sep_str(.))) + paste("Numeric interaction level(s) should be specified for", v) + } + + iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_validator(iv_arm_ref) @@ -827,15 +838,15 @@ srv_t_coxreg <- function(id, "Only Wald tests are supported for models with strata." }) # add rules for interaction_var text inputs + for (val in interaction_var_r()) { iv$add_rule( paste0("interact_", val), shinyvalidate::sv_required(paste("Interaction level(s) should be specified for", val)) ) iv$add_rule( - paste0("interact_", val), - ~ if (anyNA(as_numeric_from_comma_sep_str(.))) - paste("Numeric interaction level(s) should be specified for", val) + paste0("interact_", val), numeric_level_validation(val) + ) } teal.transform::compose_and_enable_validators(iv, selector_list) From 5d647eab8f27bd9c11f13f2d76adff57311442ab Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 20 Dec 2022 10:30:57 +0000 Subject: [PATCH 44/69] remove anl_input from coxreg validation --- R/tm_t_coxreg.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index 0f04654cdf..ce9b60887c 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -834,7 +834,7 @@ srv_t_coxreg <- function(id, "conf_level", shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between 0 and 1") ) - iv$add_rule("pval_method", ~ if( length(merged$anl_input_r()$columns_source$strata_var) > 0 && . != "wald") { + iv$add_rule("pval_method", ~ if (length(selector_list()$strata_var()$select) > 0 && . != "wald") { "Only Wald tests are supported for models with strata." }) # add rules for interaction_var text inputs @@ -846,7 +846,6 @@ srv_t_coxreg <- function(id, ) iv$add_rule( paste0("interact_", val), numeric_level_validation(val) - ) } teal.transform::compose_and_enable_validators(iv, selector_list) From 206498870281d9d3cc5b6c31d1904c262ca34958 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> Date: Tue, 20 Dec 2022 12:25:30 +0100 Subject: [PATCH 45/69] contribution AC (#703) some more modules Co-authored-by: Mahmoud Hallal <86970066+mhallal1@users.noreply.github.com> Co-authored-by: Nikolas Burkoff --- R/arm_ref_comp.R | 85 ++++++++++---------- R/tm_g_barchart_simple.R | 104 ++++++++++++++----------- R/tm_g_forest_rsp.R | 43 ++++++---- R/tm_g_pp_adverse_events.R | 58 +++++++------- R/tm_g_pp_patient_timeline.R | 61 +++++++++++---- R/tm_g_pp_therapy.R | 77 ++++++++---------- R/tm_g_pp_vitals.R | 50 +++++++----- R/tm_t_abnormality.R | 42 +++++++--- R/tm_t_abnormality_by_worst_grade.R | 67 ++++++++++------ R/tm_t_ancova.R | 66 +++++++++------- R/tm_t_binary_outcome.R | 41 ++++++---- R/tm_t_exposure.R | 62 ++++++++++----- R/tm_t_logistic.R | 89 ++++++++++++--------- R/tm_t_mult_events.R | 26 +++++-- R/tm_t_pp_laboratory.R | 54 ++++++------- R/tm_t_pp_medical_history.R | 34 ++++---- man/arm_ref_comp_observer.Rd | 68 ++++++++-------- man/tm_t_abnormality_by_worst_grade.Rd | 1 - 18 files changed, 599 insertions(+), 429 deletions(-) diff --git a/R/arm_ref_comp.R b/R/arm_ref_comp.R index f72c4d4ae1..9240deb69e 100644 --- a/R/arm_ref_comp.R +++ b/R/arm_ref_comp.R @@ -29,41 +29,45 @@ #' arm_ref_comp <- list(ARMCD = list(ref = "ARM A", comp = c("ARM B"))) #' arm_var <- choices_selected(c("ARM", "ARMCD"), "ARMCD") #' -#' adsl <- data.frame(ARM = c("ARM 1", "ARM2"), ARMCD = c("ARM A", "ARMB")) +#' adsl <- data.frame(ARM = c("ARM 1", "ARM 2"), ARMCD = c("ARM A", "ARM B")) #' -#' shiny::shinyApp( -#' ui = fluidPage( -#' teal.widgets::optionalSelectInput( -#' "arm", -#' "Treatment Variable", -#' choices = arm_var$choices, -#' selected = arm_var$selected +#' ui <- fluidPage( +#' sidebarLayout( +#' sidebarPanel( +#' teal.widgets::optionalSelectInput( +#' "arm", +#' "Treatment Variable", +#' choices = arm_var$choices, +#' selected = arm_var$selected +#' ), +#' shiny::uiOutput("arms_buckets") #' ), -#' shiny::uiOutput("arms_buckets"), -#' shiny::textOutput("result") -#' ), -#' server = function(input, output, session) { -#' -#' iv_arm_ref <- teal.modules.clinical:::arm_ref_comp_observer( -#' session, -#' input, -#' output, -#' id_arm_var = "arm", -#' data = adsl, -#' arm_ref_comp = arm_ref_comp, -#' module = "example" +#' mainPanel( +#' shiny::textOutput("result") #' ) +#' ) +#' ) #' -#' output$result <- shiny::renderText({ -#' iv <- shinyvalidate::InputValidator$new() -#' iv$add_validator(iv_arm_ref) -#' iv$enable() -#' teal::validate_inputs(iv) -#' "Valid selection has been made!" -#' }) +#' server = function(input, output, session) { #' -#' } -#' ) +#' iv_arm_ref <- teal.modules.clinical:::arm_ref_comp_observer( +#' session, +#' input, +#' output, +#' id_arm_var = "arm", +#' data = adsl, +#' arm_ref_comp = arm_ref_comp, +#' module = "example" +#' ) +#' +#' output$result <- shiny::renderText({ +#' iv <- shinyvalidate::InputValidator$new() +#' iv$add_validator(iv_arm_ref) +#' iv$enable() +#' teal::validate_inputs(iv) +#' "Valid selection has been made!" +#' }) +#' } #' if (interactive()) { #' shiny::shinyApp(ui, server) #' } @@ -81,24 +85,26 @@ arm_ref_comp_observer <- function(session, output_id = "arms_buckets") { iv <- shinyvalidate::InputValidator$new() - iv$add_rule(input_id, function(value) if (length(value[[id_ref]]) == 0) "A reference arm must be selected") - iv$add_rule(input_id, function(value) if (length(value[[id_comp]]) == 0) "A comparison arm must be selected") + iv1 <- shinyvalidate::InputValidator$new() + iv2 <- shinyvalidate::InputValidator$new() + iv2$condition(~ iv1$is_valid()) + iv1$add_rule(id_arm_var, shinyvalidate::sv_required("Treatment variable must be selected")) + iv2$add_rule(input_id, ~ if (length(.[[id_ref]]) == 0) "A reference arm must be selected") + iv2$add_rule(input_id, ~ if (length(.[[id_comp]]) == 0) "A comparison arm must be selected") + iv$add_validator(iv1) + iv$add_validator(iv2) output[[output_id]] <- shiny::renderUI({ - if (!is.null(on_off()) && on_off()) { + if (isTRUE(on_off())) { df <- if (shiny::is.reactive(data)) { data() } else { data } - check_arm_ref_comp(arm_ref_comp, df, module) ## throws an error if there are issues - arm_var <- input[[id_arm_var]] - - # validations here don't produce nice UI message (it's observe and not render output) but it prevent red errors - teal::validate_has_elements(arm_var, "Treatment variable name is empty.") + arm_var <- shiny::req(input[[id_arm_var]]) arm <- df[[arm_var]] teal::validate_has_elements(arm, "Treatment variable is empty.") @@ -129,6 +135,7 @@ arm_ref_comp_observer <- function(session, ) } }) + return(iv) } @@ -150,7 +157,6 @@ check_arm_ref_comp <- function(x, df_to_check, module) { stop(msg, "needs to be a list or NULL") } - vars <- names(x) if (is.null(vars) || any(vars == "")) { stop(msg, "is not named") @@ -160,7 +166,6 @@ check_arm_ref_comp <- function(x, df_to_check, module) { stop(msg, "refers to variables that are not in the data") } - Map( x, vars, f = function(xi, var) { diff --git a/R/tm_g_barchart_simple.R b/R/tm_g_barchart_simple.R index 80fdfbd1c5..2eeef4ef05 100644 --- a/R/tm_g_barchart_simple.R +++ b/R/tm_g_barchart_simple.R @@ -325,18 +325,50 @@ srv_g_barchart_simple <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_inputs <- teal.transform::merge_expression_module( + + rule_dupl <- function(others) { + function(value) { + othervals <- lapply(others, function(x) selector_list()[[x]]()$select) + vars <- c(value, unlist(othervals)) + dups <- unique(vars[duplicated(vars)]) + if (value %in% dups) + paste("Duplicated value:", value, collapse = ", ") + } + } + + selector_list <- teal.transform::data_extract_multiple_srv( + data_extract = list(x = x, fill = fill, x_facet = x_facet, y_facet = y_facet), datasets = data, - join_keys = get_join_keys(data), - data_extract = list(x = x, fill = fill, x_facet = x_facet, y_facet = y_facet) + select_validation_rule = list( + x = shinyvalidate::compose_rules( + shinyvalidate::sv_required("Please select an x-variable"), + rule_dupl(others = c("fill", "x_facet", "y_facet")) + ), + fill = shinyvalidate::compose_rules( + shinyvalidate::sv_optional(), + rule_dupl(others = c("x", "x_facet", "y_facet")) + ), + x_facet = shinyvalidate::compose_rules( + shinyvalidate::sv_optional(), + rule_dupl(others = c("fill", "x", "y_facet")) + ), + y_facet = shinyvalidate::compose_rules( + shinyvalidate::sv_optional(), + rule_dupl(others = c("fill", "x_facet", "x")) + ) + ) ) - validate_checks <- reactive( - shiny::validate({ - shiny::need(anl_inputs()$columns_source$x, "Please select an x-variable") - }) - ) + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + hm <- teal.transform::compose_and_enable_validators(iv, selector_list) + }) + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + join_keys = get_join_keys(data), + selector_list = selector_list + ) anl_q <- shiny::reactive({ qenv <- teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) @@ -393,7 +425,7 @@ srv_g_barchart_simple <- function(id, }) all_q <- shiny::reactive({ - validate_checks() + teal::validate_inputs(iv_r()) groupby_vars <- as.list(r_groupby_vars()) # so $ access works below qenv2 <- teal.code::eval_code(count_q(), substitute( @@ -446,36 +478,26 @@ srv_g_barchart_simple <- function(id, plot_r <- shiny::reactive(all_q()[["plot"]]) - output$table <- shiny::renderTable(all_q()[["counts"]]) + output$table <- shiny::renderTable({ + shiny::req(iv_r()$is_valid()) + all_q()[["counts"]] + }) - # reactive vars + # get grouping variables # NULL: not present in UI, vs character(0): no selection - - # returns named vector of non-NULL variables to group by + ## helper function + resolve_argument <- function(x){ + ans <- if (is.null(x)) NULL else as.vector(anl_inputs()$columns_source[[deparse(substitute(x))]]) + if (identical(ans, character(0L))) NULL else ans + } + ## returns named vector of non-NULL variables to group by r_groupby_vars <- function() { - x_name <- if (is.null(x)) NULL else as.vector(anl_inputs()$columns_source$x) - fill_name <- if (is.null(fill)) NULL else as.vector(anl_inputs()$columns_source$fill) - x_facet_name <- if (is.null(x_facet)) NULL else as.vector(anl_inputs()$columns_source$x_facet) - y_facet_name <- if (is.null(y_facet)) NULL else as.vector(anl_inputs()$columns_source$y_facet) - - # set to NULL when empty character - if (identical(x_name, character(0))) x_name <- NULL - if (identical(fill_name, character(0))) fill_name <- NULL - if (identical(x_facet_name, character(0))) x_facet_name <- NULL - if (identical(y_facet_name, character(0))) y_facet_name <- NULL - - res <- c( - x_name = x_name, fill_name = fill_name, - x_facet_name = x_facet_name, y_facet_name = y_facet_name - ) # c() -> NULL entries are omitted - - # at least one category must be specified - shiny::validate(shiny::need( - length(res) > 0, # c() removes NULL entries - "Must specify at least one of x, fill, x_facet and y_facet." - )) - - res + c( + x_name = resolve_argument(x), + fill_name = resolve_argument(fill), + x_facet_name = resolve_argument(x_facet), + y_facet_name = resolve_argument(y_facet) + ) } # Insert the plot into a plot with settings module from teal.widgets @@ -572,21 +594,13 @@ make_barchart_simple_call <- function(y_name, rotate_y_label = FALSE, expand_y_range = 0, ggplot2_args = teal.widgets::ggplot2_args()) { - # c() filters out NULL - plot_vars <- c(x_name, fill_name, x_facet_name, y_facet_name) - shiny::validate( - shiny::need( - !any(duplicated(plot_vars)), - paste("Duplicated variable(s):", paste(plot_vars[duplicated(plot_vars)], collapse = ", ")) - ) - ) checkmate::assert_string(y_name) checkmate::assert_string(x_name, null.ok = TRUE) checkmate::assert_string(fill_name, null.ok = TRUE) checkmate::assert_string(x_facet_name, null.ok = TRUE) checkmate::assert_string(y_facet_name, null.ok = TRUE) + checkmate::assert_character(c(x_name, fill_name, x_facet_name, y_facet_name)) checkmate::assert_flag(label_bars) - checkmate::assert_character(plot_vars, min.len = 1) checkmate::assert_scalar(expand_y_range) barlayout <- match.arg(barlayout) checkmate::assert_flag(flip_axis, null.ok = TRUE) diff --git a/R/tm_g_forest_rsp.R b/R/tm_g_forest_rsp.R index 8992707551..ff6eacf375 100644 --- a/R/tm_g_forest_rsp.R +++ b/R/tm_g_forest_rsp.R @@ -479,7 +479,7 @@ srv_g_forest_rsp <- function(id, shiny::moduleServer(id, function(input, output, session) { # Setup arm variable selection, default reference arms, and default # comparison arms for encoding panel - arm_ref_comp_observer( + iv_arm_ref <- arm_ref_comp_observer( session, input, output, @@ -489,8 +489,7 @@ srv_g_forest_rsp <- function(id, module = "tm_t_tte" ) - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, subgroup_var = subgroup_var, @@ -498,6 +497,29 @@ srv_g_forest_rsp <- function(id, paramcd = paramcd, aval_var = aval_var ), + datasets = data, + select_validation_rule = list( + aval_var = shinyvalidate::sv_required("An analysis variable is required"), + arm_var = shinyvalidate::sv_required("A treatment variable is required") + ), + filter_validation_rule = list(paramcd = shinyvalidate::sv_required(message = "Please select Endpoint filter.")) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule( + "conf_level", + shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between {left} and {right}") + ) + iv$add_rule("responders", shinyvalidate::sv_required("`Responders` field is empty")) + iv$add_validator(iv_arm_ref) + teal.transform::compose_and_enable_validators(iv, selector_list, c("arm_var", "aval_var", "paramcd")) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + selector_list = selector_list, merge_function = "dplyr::inner_join", join_keys = get_join_keys(data) ) @@ -564,6 +586,7 @@ srv_g_forest_rsp <- function(id, # Prepare the analysis environment (filter data, check data, populate envir). validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) req(anl_q()) qenv <- anl_q() adsl_filtered <- qenv[[parentname]] @@ -644,20 +667,6 @@ srv_g_forest_rsp <- function(id, ) } - shiny::validate(shiny::need( - input$conf_level >= 0 && input$conf_level <= 1, - "Please choose a confidence level between 0 and 1" - )) - - shiny::validate( - shiny::need(checkmate::test_string(input_aval_var), "Analysis variable should be a single column."), - shiny::need(input$responders, "`Responders` field is empty."), - shiny::need( - input[[extract_input("paramcd", paramcd$filter[[1]]$dataname, filter = TRUE)]], - "`Select Endpoint` is not selected." - ) - ) - validate_has_data(qenv[["ANL"]], min_nrow = 1) NULL }) diff --git a/R/tm_g_pp_adverse_events.R b/R/tm_g_pp_adverse_events.R index 4388fcce1d..66b46329c4 100644 --- a/R/tm_g_pp_adverse_events.R +++ b/R/tm_g_pp_adverse_events.R @@ -453,8 +453,7 @@ srv_g_adverse_events <- function(id, ) # Adverse events tab ---- - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = Filter( Negate(is.null), list( @@ -467,6 +466,27 @@ srv_g_adverse_events <- function(id, decod = decod ) ), + datasets = data, + select_validation_rule = list( + aeterm = shinyvalidate::sv_required("Please select AETERM variable."), + tox_grade = shinyvalidate::sv_required("Please select AETOXGR variable."), + causality = shinyvalidate::sv_required("Please select AEREL variable."), + outcome = shinyvalidate::sv_required("Please select AEOUT variable."), + action = shinyvalidate::sv_required("Please select AEACN variable."), + time = shinyvalidate::sv_required("Please select ASTDY variable."), + decod = shinyvalidate::sv_required("Please select ANRIND variable.") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient")) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + selector_list = selector_list, join_keys = get_join_keys(data) ) @@ -477,40 +497,13 @@ srv_g_adverse_events <- function(id, ) all_q <- shiny::reactive({ - shiny::validate(shiny::need(patient_id(), "Please select a patient.")) + teal::validate_inputs(iv_r()) anl_m <- anl_inputs() qenv <- anl_q() ANL <- qenv[["ANL"]] # nolint teal::validate_has_data(ANL[ANL[[patient_col]] == input$patient_id, ], min_nrow = 1) - shiny::validate( - shiny::need( - input[[extract_input("aeterm", dataname)]], - "Please select AETERM variable." - ), - shiny::need( - input[[extract_input("tox_grade", dataname)]], - "Please select AETOXGR variable." - ), - shiny::need( - input[[extract_input("causality", dataname)]], - "Please select AEREL variable." - ), - shiny::need( - input[[extract_input("outcome", dataname)]], - "Please select AEOUT variable." - ), - shiny::need( - input[[extract_input("action", dataname)]], - "Please select AEACN variable." - ), - shiny::need( - input[[extract_input("time", dataname)]], - "Please select ASTDY variable." - ) - ) - qenv2 <- teal.code::eval_code( qenv, substitute( @@ -543,7 +536,10 @@ srv_g_adverse_events <- function(id, options = list(pageLength = input$table_rows) ) - plot_r <- shiny::reactive(all_q()[["plot"]]) + plot_r <- shiny::reactive({ + shiny::req(iv_r()$is_valid()) + all_q()[["plot"]] + }) pws <- teal.widgets::plot_with_settings_srv( id = "chart", diff --git a/R/tm_g_pp_patient_timeline.R b/R/tm_g_pp_patient_timeline.R index a9eeec5543..590dab52aa 100644 --- a/R/tm_g_pp_patient_timeline.R +++ b/R/tm_g_pp_patient_timeline.R @@ -751,25 +751,68 @@ srv_g_patient_timeline <- function(id, ignoreInit = TRUE ) + # Patient timeline tab ---- - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, - join_keys = get_join_keys(data), + check_box <- reactive(input$relday_x_axis) + + check_relative <- function(main_param, return_name) { + function(value) { + if (length(selector_list()[[main_param]]()$select) > 0 && length(value) == 0) { + sprintf("Please add %s", return_name) + } + } + } + + rule_one_parameter <- function(other) { + function(value) { + if (length(value) == 0L && length(selector_list()[[other]]()$select) == 0L) + "At least one parameter must be selected." + } + } + + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( dsrelday_start = dsrelday_start, dsrelday_end = dsrelday_end, aerelday_start = aerelday_start, aerelday_end = aerelday_end, aeterm = aeterm, aetime_start = aetime_start, aetime_end = aetime_end, dstime_start = dstime_start, dstime_end = dstime_end, cmdecod = cmdecod + ), + datasets = data, + select_validation_rule = list( + # aeterm + aeterm = rule_one_parameter("cmdecod"), + aerelday_start = check_relative("aeterm", "AE start date."), + aerelday_end = check_relative("aeterm", "AE end date."), + aetime_start = check_relative("aeterm", "AE start date."), + aetime_end = check_relative("aeterm", "AE end date."), + # cmdecod + cmdecod = rule_one_parameter("aeterm"), + dsrelday_start = check_relative("cmdecod", "Medication start date."), + dsrelday_end = check_relative("cmdecod", "Medication end date."), + dstime_start = check_relative("cmdecod", "Medication start date."), + dstime_end = check_relative("cmdecod", "Medication end date.") ) ) + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient")) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + join_keys = get_join_keys(data), + selector_list = selector_list + ) + anl_q <- reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) }) all_q <- shiny::reactive({ - shiny::validate(shiny::need(patient_id(), "Please select a patient.")) + teal::validate_inputs(iv_r()) aeterm <- input[[extract_input("aeterm", dataname_adae)]] aetime_start <- input[[extract_input("aetime_start", dataname_adae)]] @@ -796,11 +839,6 @@ srv_g_patient_timeline <- function(id, (sum(stats::complete.cases(p_time_data_pat[, c(aetime_start, aetime_end)])) > 0 || sum(stats::complete.cases(p_time_data_pat[, c(dstime_start, dstime_end)])) > 0), "Selected patient is not in dataset (either due to filtering or missing values). Consider relaxing filters." - ), - shiny::need( - input$relday_x_axis || (isFALSE(ae_chart_vars_null) || isFALSE(ds_chart_vars_null)), - "The sections of the plot (Adverse Events and Medication) do not have enough input variables. - Please select the appropriate input variables." ) ) @@ -836,11 +874,6 @@ srv_g_patient_timeline <- function(id, (sum(stats::complete.cases(p_time_data_pat[, c(aerelday_start_name, aerelday_end_name)])) > 0 || sum(stats::complete.cases(p_time_data_pat[, c(dsrelday_start_name, dsrelday_end_name)])) > 0), "Selected patient is not in dataset (either due to filtering or missing values). Consider relaxing filters." - ), - shiny::need( - !input$relday_x_axis || (isFALSE(aerel_chart_vars_null) || isFALSE(dsrel_chart_vars_null)), - "The sections of the plot (Adverse Events and Medication) do not have enough input variables. - Please select the appropriate input variables." ) ) diff --git a/R/tm_g_pp_therapy.R b/R/tm_g_pp_therapy.R index 1a8ee378bb..e36f5248b8 100644 --- a/R/tm_g_pp_therapy.R +++ b/R/tm_g_pp_therapy.R @@ -601,14 +601,37 @@ srv_g_therapy <- function(id, ) # Therapy tab ---- - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, - join_keys = get_join_keys(data), + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( atirel = atirel, cmdecod = cmdecod, cmindc = cmindc, cmdose = cmdose, cmtrt = cmtrt, cmdosu = cmdosu, cmroute = cmroute, cmdosfrq = cmdosfrq, cmstdy = cmstdy, cmendy = cmendy ), + datasets = data, + select_validation_rule = list( + atirel = shinyvalidate::sv_required("Please select ATIREL variable."), + cmdecod = shinyvalidate::sv_required("Please select medication decoding variable."), + cmindc = shinyvalidate::sv_required("Please select CMINDC variable."), + cmdose = shinyvalidate::sv_required("Please select CMDOSE variable."), + cmtrt = shinyvalidate::sv_required("Please select CMTRT variable."), + cmdosu = shinyvalidate::sv_required("Please select CMDOSU variable."), + cmroute = shinyvalidate::sv_required("Please select CMROUTE variable."), + cmdosfrq = shinyvalidate::sv_required("Please select CMDOSFRQ variable."), + cmstdy = shinyvalidate::sv_required("Please select CMSTDY variable."), + cmendy = shinyvalidate::sv_required("Please select CMENDY variable.") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient.")) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + join_keys = get_join_keys(data), + selector_list = selector_list, merge_function = "dplyr::left_join" ) @@ -620,50 +643,11 @@ srv_g_therapy <- function(id, merged <- list(anl_input_r = anl_inputs, anl_q = anl_q) all_q <- shiny::reactive({ - shiny::validate(shiny::need(patient_id(), "Please select a patient.")) teal::validate_has_data(merged$anl_q()[["ANL"]], 1) + teal::validate_inputs(iv_r()) + shiny::validate( - shiny::need( - input[[extract_input("atirel", dataname)]], - "Please select ATIREL variable." - ), - shiny::need( - input[[extract_input("cmdecod", dataname)]], - "Please select Medication decoding variable." - ), - shiny::need( - input[[extract_input("cmindc", dataname)]], - "Please select CMINDC variable." - ), - shiny::need( - input[[extract_input("cmdose", dataname)]], - "Please select CMDOSE variable." - ), - shiny::need( - input[[extract_input("cmtrt", dataname)]], - "Please select CMTRT variable." - ), - shiny::need( - input[[extract_input("cmdosu", dataname)]], - "Please select CMDOSU variable." - ), - shiny::need( - input[[extract_input("cmroute", dataname)]], - "Please select CMROUTE variable." - ), - shiny::need( - input[[extract_input("cmdosfrq", dataname)]], - "Please select CMDOSFRQ variable." - ), - shiny::need( - input[[extract_input("cmstdy", dataname)]], - "Please select CMSTDY variable." - ), - shiny::need( - input[[extract_input("cmendy", dataname)]], - "Please select CMENDY variable." - ), shiny::need( nrow(merged$anl_q()[["ANL"]][input$patient_id == merged$anl_q()[["ANL"]][, patient_col], ]) > 0, "Selected patient is not in dataset (either due to filtering or missing values). Consider relaxing filters." @@ -708,7 +692,10 @@ srv_g_therapy <- function(id, options = list(pageLength = input$therapy_table_rows) ) - plot_r <- shiny::reactive(all_q()[["therapy_plot"]]) + plot_r <- shiny::reactive({ + shiny::req(iv_r()$is_valid()) + all_q()[["therapy_plot"]] + }) pws <- teal.widgets::plot_with_settings_srv( id = "therapy_plot", diff --git a/R/tm_g_pp_vitals.R b/R/tm_g_pp_vitals.R index 5385291fad..a55ffa1d0a 100644 --- a/R/tm_g_pp_vitals.R +++ b/R/tm_g_pp_vitals.R @@ -266,6 +266,10 @@ tm_g_pp_vitals <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(ggplot2_args, "ggplot2_args") + checkmate::assert_multi_class(paramcd, c("choices_selected", "data_extract_spec"), null.ok = TRUE) + checkmate::assert_multi_class(param, c("choices_selected", "data_extract_spec"), null.ok = TRUE) + checkmate::assert_multi_class(aval, c("choices_selected", "data_extract_spec"), null.ok = TRUE) + checkmate::assert_multi_class(xaxis, c("choices_selected", "data_extract_spec"), null.ok = TRUE) args <- as.list(environment()) data_extract_list <- list( @@ -406,10 +410,33 @@ srv_g_vitals <- function(id, ) # Vitals tab ---- - anl_inputs <- teal.transform::merge_expression_module( + + selector_list <- teal.transform::data_extract_multiple_srv( + data_extract = list(paramcd = paramcd, xaxis = xaxis, aval = aval), + datasets = data, + select_validation_rule = list( + paramcd = shinyvalidate::sv_required( + "Please select PARAMCD variable."), + xaxis = shinyvalidate::sv_required( + "Please select Vitals x-axis variable."), + aval = shinyvalidate::sv_required( + "Please select AVAL variable.") + ) + ) + + iv_r <- shiny::reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("patient_id", shinyvalidate::sv_required( + "Please select a patient.")) + iv$add_rule("paramcd_levels_vals", shinyvalidate::sv_required( + "Please select PARAMCD variable levels.")) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( datasets = data, join_keys = get_join_keys(data), - data_extract = list(paramcd = paramcd, xaxis = xaxis, aval = aval), + selector_list = selector_list, merge_function = "dplyr::left_join" ) @@ -451,26 +478,11 @@ srv_g_vitals <- function(id, }) all_q <- shiny::reactive({ - shiny::validate(shiny::need(patient_id(), "Please select a patient.")) teal::validate_has_data(merged$anl_q()[["ANL"]], 1) + teal::validate_inputs(iv_r()) + shiny::validate( - shiny::need( - input[[extract_input("paramcd", dataname)]], - "Please select PARAMCD variable." - ), - shiny::need( - input[["paramcd_levels_vals"]], - "Please select PARAMCD variable levels." - ), - shiny::need( - input[[extract_input("xaxis", dataname)]], - "Please select Vitals x-axis variable." - ), - shiny::need( - input[[extract_input("aval", dataname)]], - "Please select AVAL variable." - ), shiny::need( nrow(merged$anl_q()[["ANL"]][input$patient_id == merged$anl_q()[["ANL"]][, patient_col], ]) > 0, "Selected patient is not in dataset (either due to filtering or missing values). Consider relaxing filters." diff --git a/R/tm_t_abnormality.R b/R/tm_t_abnormality.R index f5425adc25..f5f55b94a1 100644 --- a/R/tm_t_abnormality.R +++ b/R/tm_t_abnormality.R @@ -499,8 +499,8 @@ srv_t_abnormality <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, id_var = id_var, @@ -509,7 +509,34 @@ srv_t_abnormality <- function(id, baseline_var = baseline_var, treatment_flag_var = treatment_flag_var ), + datasets = data, + select_validation_rule = list( + arm_var = shinyvalidate::sv_required( + "Please select a treatment variable."), + by_vars = shinyvalidate::sv_required( + "Please select a Row By Variable."), + id_var = shinyvalidate::sv_required( + "Please select a subject identifier."), + grade = shinyvalidate::sv_required( + "Please select a grade variable."), + baseline_var = shinyvalidate::sv_required( + "Please select a baseline grade variable."), + treatment_flag_var = shinyvalidate::sv_required( + "Please select indicator value for on treatment records.") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("treatment_flag", shinyvalidate::sv_required( + "Please select indicator value for on treatment records.")) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, join_keys = get_join_keys(data), + selector_list = selector_list, merge_function = "dplyr::inner_join" ) @@ -536,6 +563,8 @@ srv_t_abnormality <- function(id, adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] + teal::validate_inputs(iv_r()) + input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var) input_id_var <- names(merged$anl_input_r()$columns_source$id_var) input_by_vars <- names(merged$anl_input_r()$columns_source$by_vars) @@ -543,15 +572,6 @@ srv_t_abnormality <- function(id, input_baseline_var <- names(merged$anl_input_r()$columns_source$baseline_var) input_treatment_flag_var <- names(merged$anl_input_r()$columns_source$treatment_flag_var) - shiny::validate( - shiny::need(input_arm_var, "Please select a treatment variable."), - shiny::need(input_grade, "Please select a grade variable."), - shiny::need(input_by_vars, "Please select a Row By Variable."), - shiny::need(input_id_var, "Please select a subject identifier."), - shiny::need(input_baseline_var, "Please select a baseline grade variable."), - shiny::need(input_treatment_flag_var, "Please select an on treatment flag variable."), - shiny::need(input$treatment_flag, "Please select indicator value for on treatment records.") - ) # validate inputs validate_standard_inputs( adsl = adsl_filtered, diff --git a/R/tm_t_abnormality_by_worst_grade.R b/R/tm_t_abnormality_by_worst_grade.R index cc05e70322..6a882de836 100644 --- a/R/tm_t_abnormality_by_worst_grade.R +++ b/R/tm_t_abnormality_by_worst_grade.R @@ -226,7 +226,6 @@ template_abnormality_by_worst_grade <- function(parentname, # nolint #' @export #' #' @examples -#' #' library(scda) #' library(dplyr) #' @@ -323,8 +322,8 @@ tm_t_abnormality_by_worst_grade <- function(label, # nolint checkmate::assert_string(label) checkmate::assert_string(dataname) checkmate::assert_string(parentname) - checkmate::assert_class(id_var, "choices_selected") checkmate::assert_class(arm_var, "choices_selected") + checkmate::assert_class(id_var, "choices_selected") checkmate::assert_class(paramcd, "choices_selected") checkmate::assert_class(atoxgr_var, "choices_selected") checkmate::assert_class(worst_high_flag_var, "choices_selected") @@ -388,8 +387,13 @@ ui_t_abnormality_by_worst_grade <- function(id, ...) { # nolint shiny::tags$label("Encodings", class = "text-primary"), teal.transform::datanames_input( a[c( - "arm_var", "id_var", "paramcd", - "atoxgr_var", "worst_high_flag_var", "worst_low_flag_var", "worst_flag_indicator" + "arm_var", + "id_var", + "paramcd", + "atoxgr_var", + "worst_high_flag_var", + "worst_low_flag_var", + "worst_flag_indicator" )] ), teal.transform::data_extract_ui( @@ -479,14 +483,39 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, - join_keys = get_join_keys(data), + + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( - arm_var = arm_var, id_var = id_var, paramcd = paramcd, - atoxgr_var = atoxgr_var, worst_high_flag_var = worst_high_flag_var, + arm_var = arm_var, + id_var = id_var, + paramcd = paramcd, + atoxgr_var = atoxgr_var, + worst_high_flag_var = worst_high_flag_var, worst_low_flag_var = worst_low_flag_var ), + datasets = data, + select_validation_rule = list( + arm_var = shinyvalidate::sv_required("Please select a treatment variable."), + id_var = shinyvalidate::sv_required("Please select a Subject Identifier."), + atoxgr_var = shinyvalidate::sv_required("Please select Analysis Toxicity Grade variable."), + worst_low_flag_var = shinyvalidate::sv_required("Please select the Worst Low Grade flag variable."), + worst_high_flag_var = shinyvalidate::sv_required("Please select the Worst High Grade flag variable."), + worst_flag_indicator = shinyvalidate::sv_required("Please select the value indicating worst grade.") + ), + filter_validation_rule = list( + paramcd = shinyvalidate::sv_required("Please select at least one Laboratory parameter.") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + selector_list = selector_list, + datasets = data, + join_keys = get_join_keys(data), merge_function = "dplyr::inner_join" ) @@ -515,27 +544,15 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint anl <- merged$anl_q()[["ANL"]] input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var) - input_id_var <- names(merged$anl_input_r()$columns_source$id_var) input_paramcd_var <- names(merged$anl_input_r()$columns_source$paramcd) input_atoxgr <- names(merged$anl_input_r()$columns_source$atoxgr_var) input_worst_high_flag_var <- names(merged$anl_input_r()$columns_source$worst_high_flag_var) input_worst_low_flag_var <- names(merged$anl_input_r()$columns_source$worst_low_flag_var) - shiny::validate( - shiny::need(input_arm_var, "Please select a treatment variable."), - shiny::need(input_worst_high_flag_var, "Please select the Worst High Grade flag variable."), - shiny::need(input_worst_low_flag_var, "Please select the Worst Low Grade flag variable."), - shiny::need(input_atoxgr, "Please select Analysis Toxicity Grade variable."), - shiny::need(input_id_var, "Please select a Subject Identifier."), - shiny::need(input$worst_flag_indicator, "Please select the value indicating worst grade."), - ) + teal::validate_inputs(iv_r()) if (length(input_paramcd_var) > 0) { shiny::validate( - shiny::need( - length(merged$anl_q()[["ANL"]][[input_paramcd_var]]) > 0, - "Please select at least one Laboratory parameter." - ), shiny::need( is.factor(merged$anl_q()[["ANL"]][[input_paramcd_var]]), "Parameter variable should be a factor." @@ -549,13 +566,15 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint all(as.character(unique(merged$anl_q()[["ANL"]][[input_atoxgr]])) %in% as.character(c(-4:4))), "All grade values should be within -4:4 range." ), - shiny::need(is.factor(merged$anl_q()[["ANL"]][[input_atoxgr]]), "Grade variable should be a factor.") + shiny::need(is.factor(merged$anl_q()[["ANL"]][[input_atoxgr]]), + "Grade variable should be a factor.") ) } if (length(input_atoxgr) > 0) { shiny::validate( - shiny::need(is.factor(merged$anl_q()[["ANL"]][[input_atoxgr]]), "Treatment variable should be a factor."), + shiny::need(is.factor(merged$anl_q()[["ANL"]][[input_atoxgr]]), + "Treatment variable should be a factor."), ) } diff --git a/R/tm_t_ancova.R b/R/tm_t_ancova.R index d6887a68a5..d149654e29 100644 --- a/R/tm_t_ancova.R +++ b/R/tm_t_ancova.R @@ -604,11 +604,15 @@ ui_ancova <- function(id, ...) { shiny::uiOutput( ns("arms_buckets"), title = paste( - "Multiple reference groups are automatically combined into a single group when more than one", - "value is selected." + "Multiple reference groups are automatically combined into a single group", + "when more than one value is selected." ) ), - shiny::helpText("Multiple reference groups are automatically combined into a single group."), + shiny::conditionalPanel( + condition = "input['arm_var-dataset_ADSL_singleextract-select'].length != 0", + ns = ns, + shiny::helpText("Multiple reference groups are automatically combined into a single group.") + ), shiny::checkboxInput( ns("combine_comp_arms"), "Combine all comparison groups?", @@ -689,7 +693,7 @@ srv_ancova <- function(id, shiny::moduleServer(id, function(input, output, session) { # Setup arm variable selection, default reference arms, and default # comparison arms for encoding panel. - arm_ref_comp_observer( + iv_arco <- arm_ref_comp_observer( session, input, output, @@ -699,8 +703,7 @@ srv_ancova <- function(id, module = "tm_ancova" ) - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, aval_var = aval_var, @@ -709,8 +712,33 @@ srv_ancova <- function(id, paramcd = paramcd, interact_var = interact_var ), - merge_function = "dplyr::inner_join", - join_keys = get_join_keys(data) + datasets = data, + select_validation_rule = list( + arm_var = shinyvalidate::sv_required("Arm variable cannot be empty."), + aval_var = shinyvalidate::sv_required("Analysis variable cannot be empty."), + cov_var = shinyvalidate::sv_optional(), + interact_var = shinyvalidate::sv_optional() + ), + filter_validation_rule = list( + avisit = shinyvalidate::sv_required("`Analysis Visit` field cannot be empty."), + paramcd = shinyvalidate::sv_required("`Select Endpoint` is not selected.") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level.")) + iv$add_rule("conf_level", shinyvalidate::sv_between( + 0, 1, message_fmt = "Confdence level must be between {left} and {right}.")) + iv$add_validator(iv_arco) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + selector_list = selector_list, + datasets = data, + join_keys = get_join_keys(data), + merge_function = "dplyr::inner_join" ) adsl_inputs <- teal.transform::merge_expression_module( @@ -768,6 +796,8 @@ srv_ancova <- function(id, adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] + teal::validate_inputs(iv_r()) + input_arm_var <- as.vector(merged$anl_input_r()$columns_source$arm_var) input_aval_var <- as.vector(merged$anl_input_r()$columns_source$aval_var) input_cov_var <- as.vector(merged$anl_input_r()$columns_source$cov_var) @@ -793,11 +823,7 @@ srv_ancova <- function(id, # Other validations. shiny::validate(shiny::need( - length(input_aval_var) > 0, - "Analysis variable cannot be empty." - )) - shiny::validate(shiny::need( - length(input_arm_var) > 0 && length(unique(adsl_filtered[[input_arm_var]])) > 1, + length(unique(adsl_filtered[[input_arm_var]])) > 1, "ANCOVA table needs at least 2 arm groups to make comparisons." )) # check that there is at least one record with no missing data @@ -813,20 +839,6 @@ srv_ancova <- function(id, !any(all_NA_dataset$all_NA), "ANCOVA table cannot be calculated as all values are missing for one visit for (at least) one arm." )) - shiny::validate(shiny::need( - input$conf_level >= 0 && input$conf_level <= 1, - "Please choose a confidence level between 0 and 1" - )) - - shiny::validate(shiny::need( - input[[extract_input("avisit", avisit$filter[[1]]$dataname, filter = TRUE)]], - "`Analysis Visit` field cannot be empty" - )) - - shiny::validate(shiny::need( - input[[extract_input("paramcd", paramcd$filter[[1]]$dataname, filter = TRUE)]], - "`Select Endpoint` is not selected." - )) if (input$include_interact) { if (!is.null(input_interact_var) && length(input_interact_var) > 0) { diff --git a/R/tm_t_binary_outcome.R b/R/tm_t_binary_outcome.R index a766f25a6f..28a6978651 100644 --- a/R/tm_t_binary_outcome.R +++ b/R/tm_t_binary_outcome.R @@ -743,20 +743,42 @@ srv_t_binary_outcome <- function(id, shiny::moduleServer(id, function(input, output, session) { # Setup arm variable selection, default reference arms, and default # comparison arms for encoding panel - arm_ref_comp_observer( + iv_arm_ref <- arm_ref_comp_observer( session, input, output, id_arm_var = extract_input("arm_var", parentname), data = data[[parentname]], arm_ref_comp = arm_ref_comp, - module = "tm_t_tte", + module = "tm_t_binary_outcome", on_off = shiny::reactive(input$compare_arms) ) - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list(arm_var = arm_var, paramcd = paramcd, strata_var = strata_var, aval_var = aval_var), + datasets = data, + select_validation_rule = list( + aval_var = shinyvalidate::sv_required("An analysis variable is required"), + arm_var = shinyvalidate::sv_required("A treatment variable is required") + ), + filter_validation_rule = list(paramcd = shinyvalidate::sv_required(message = "Please select a filter.")) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_validator(iv_arm_ref) + iv$add_rule("responders", shinyvalidate::sv_required("`Responders` field is empty")) + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule( + "conf_level", + shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between {left} and {right}") + ) + teal.transform::compose_and_enable_validators(iv, selector_list, c("arm_var", "aval_var", "paramcd")) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + selector_list = selector_list, merge_function = "dplyr::inner_join", join_keys = get_join_keys(data) ) @@ -815,6 +837,7 @@ srv_t_binary_outcome <- function(id, ) validate_check <- shiny::reactive({ + teal::validate_inputs(iv_r()) adsl_filtered <- anl_q()[[parentname]] anl_filtered <- anl_q()[[dataname]] anl <- anl_q()[["ANL"]] @@ -883,11 +906,6 @@ srv_t_binary_outcome <- function(id, } ) - shiny::validate( - shiny::need(checkmate::test_string(input_aval_var), "Analysis variable should be a single column."), - shiny::need(input$responders, "`Responders` field is empty") - ) - if (is.list(default_responses)) { shiny::validate( shiny::need( @@ -900,11 +918,6 @@ srv_t_binary_outcome <- function(id, ) } - shiny::validate(shiny::need( - input$conf_level >= 0 && input$conf_level <= 1, - "Please choose a confidence level between 0 and 1" - )) - NULL }) diff --git a/R/tm_t_exposure.R b/R/tm_t_exposure.R index 66077ba6e3..5f33dfecde 100644 --- a/R/tm_t_exposure.R +++ b/R/tm_t_exposure.R @@ -491,9 +491,16 @@ srv_t_exposure <- function(id, with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, - join_keys = get_join_keys(data), + + rule_intersection <- function(other) { + function(value) { + others <- selector_list()[[other]]()$select + if (length(intersect(value, others)) > 0L) + "Column by and row by variables should not be the same." + } + } + + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( id_var = id_var, paramcd = paramcd, @@ -503,6 +510,35 @@ srv_t_exposure <- function(id, aval_var = aval_var, avalu_var = avalu_var ), + datasets = data, + select_validation_rule = list( + id_var = shinyvalidate::sv_required("Subject Identifier is required"), + col_by_var = shinyvalidate::compose_rules( + shinyvalidate::sv_optional(), + rule_intersection('row_by_var') + ), + row_by_var = shinyvalidate::compose_rules( + shinyvalidate::sv_required("Please select a row by variable."), + rule_intersection("col_by_var") + ), + aval_var = shinyvalidate::sv_required("Please select an analysis variable."), + avalu_var = shinyvalidate::sv_required("Please select an analysis unit variable.") + ), + filter_validation_rule = list( + paramcd = shinyvalidate::sv_required("Please select a parameter value."), + parcat = shinyvalidate::sv_required("Please select a parameter category value.") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + selector_list = selector_list, + join_keys = get_join_keys(data), merge_function = "dplyr::inner_join" ) @@ -529,6 +565,8 @@ srv_t_exposure <- function(id, adsl_filtered <- merged$anl_q()[[parentname]] anl_filtered <- merged$anl_q()[[dataname]] + teal::validate_inputs(iv_r()) + input_paramcd <- unlist(paramcd$filter)["vars_selected"] input_id_var <- names(merged$anl_input_r()$columns_source$id_var) input_row_by_var <- names(merged$anl_input_r()$columns_source$row_by_var) @@ -537,24 +575,6 @@ srv_t_exposure <- function(id, input_aval_var <- names(merged$anl_input_r()$columns_source$aval_var) input_avalu_var <- names(merged$anl_input_r()$columns_source$avalu_var) - shiny::validate( - shiny::need(input_row_by_var, "Please select a row by variable."), - shiny::need(input_aval_var, "Please select an analysis variable."), - shiny::need(input_avalu_var, "Please select an analysis unit variable."), - shiny::need( - input[[extract_input("parcat", parcat$filter[[1]]$dataname, filter = TRUE)]], - "Please select a parameter category value." - ), - shiny::need( - input[[extract_input("paramcd", paramcd$filter[[1]]$dataname, filter = TRUE)]], - "Please select a parameter value." - ), - teal::validate_no_intersection( - input[[extract_input("col_by_var", parentname)]], - input[[extract_input("row_by_var", dataname)]], - "Column by and row by variables should not be the same." - ) - ) # validate inputs validate_standard_inputs( adsl = adsl_filtered, diff --git a/R/tm_t_logistic.R b/R/tm_t_logistic.R index 47b549e239..2b494db63e 100644 --- a/R/tm_t_logistic.R +++ b/R/tm_t_logistic.R @@ -304,7 +304,11 @@ tm_t_logistic <- function(label, checkmate::assert_string(label) checkmate::assert_string(dataname) checkmate::assert_string(parentname) - checkmate::assert_class(avalc_var, classes = "choices_selected") + checkmate::assert_multi_class(arm_var, c("choices_selected", "data_extract_spec"), null.ok = TRUE) + checkmate::assert_list(arm_ref_comp, names = "named", null.ok = TRUE) + checkmate::assert_multi_class(paramcd, c("choices_selected", "data_extract_spec")) + checkmate::assert_multi_class(cov_var, c("choices_selected", "data_extract_spec")) + checkmate::assert_multi_class(avalc_var, c("choices_selected", "data_extract_spec")) checkmate::assert_class(conf_level, classes = "choices_selected") checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) @@ -315,8 +319,8 @@ tm_t_logistic <- function(label, data_extract_list <- list( arm_var = `if`(is.null(arm_var), NULL, cs_to_des_select(arm_var, dataname = parentname)), paramcd = cs_to_des_filter(paramcd, dataname = dataname), - avalc_var = cs_to_des_select(avalc_var, dataname = dataname), - cov_var = cs_to_des_select(cov_var, dataname = dataname, multiple = TRUE) + cov_var = cs_to_des_select(cov_var, dataname = dataname, multiple = TRUE), + avalc_var = cs_to_des_select(avalc_var, dataname = dataname) ) module( @@ -458,7 +462,7 @@ srv_t_logistic <- function(id, shiny::moduleServer(id, function(input, output, session) { # Observer to update reference and comparison arm input options. - arm_ref_comp_observer( + iv_arco <- arm_ref_comp_observer( session, input, output, @@ -468,10 +472,50 @@ srv_t_logistic <- function(id, module = "tm_t_logistic" ) - anl_inputs <- teal.transform::merge_expression_module( + selector_list <- teal.transform::data_extract_multiple_srv( + data_extract = list( + arm_var = arm_var, + paramcd = paramcd, + avalc_var = avalc_var, + cov_var = cov_var), + datasets = data, + select_validation_rule = list( + arm_var = shinyvalidate::sv_required("Treatment Variable is empty"), + avalc_var = shinyvalidate::sv_required("Analysis variable is empty"), + cov_var = shinyvalidate::sv_required("`Covariates` field is empty") + ), + filter_validation_rule = list( + paramcd = shinyvalidate::sv_required("`Select Endpoint` field is empty") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("responders", shinyvalidate::sv_required("`Responders` field is empty")) + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level.")) + iv$add_rule("conf_level", shinyvalidate::sv_between( + 0, 1, message_fmt = "Confdence level must be between {left} and {right}.")) + iv$add_validator(iv_arco) + # Conditional validator for interaction values. + iv_int <- shinyvalidate::InputValidator$new() + iv_int$condition(~ length(input$interaction_var) > 0L && + is.numeric(merged$anl_q()[["ANL"]][[input$interaction_var]])) + iv_int$add_rule("interaction_values", shinyvalidate::sv_required( + "If interaction is specified the level should be entered.")) + iv_int$add_rule("interaction_values", + ~ if (anyNA(as_numeric_from_comma_sep_str(.))) + "Interaction levels are invalid.") + iv_int$add_rule("interaction_values", + ~ if (any(duplicated(as_numeric_from_comma_sep_str(.)))) + "Interaction levels must be unique.") + iv$add_validator(iv_int) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + selector_list = selector_list, datasets = data, join_keys = get_join_keys(data), - data_extract = list(arm_var = arm_var, paramcd = paramcd, avalc_var = avalc_var, cov_var = cov_var), merge_function = "dplyr::inner_join" ) @@ -547,6 +591,8 @@ srv_t_logistic <- function(id, adsl_filtered <- anl_q()[[parentname]] anl_filtered <- anl_q()[[dataname]] + validate_inputs(iv_r()) + input_arm_var <- as.vector(merged$anl_input_r()$columns_source$arm_var) input_avalc_var <- as.vector(merged$anl_input_r()$columns_source$avalc_var) input_cov_var <- as.vector(merged$anl_input_r()$columns_source$cov_var) @@ -554,13 +600,8 @@ srv_t_logistic <- function(id, input_interaction_var <- input$interaction_var input_interaction_at <- input_interaction_var[input_interaction_var %in% input_cov_var] - interaction_flag <- length(input_interaction_at) != 0 - at_values <- if (is.null(input$interaction_values)) { - NA - } else { - unlist(as_num(input$interaction_values)) - } + at_values <- as_numeric_from_comma_sep_str(input$interaction_values) # validate inputs validate_args <- list( @@ -574,11 +615,6 @@ srv_t_logistic <- function(id, min_nrow = 4 ) - shiny::validate(shiny::need( - input$conf_level >= 0 && input$conf_level <= 1, - "Please choose a confidence level between 0 and 1" - )) - # validate arm levels if (!is.null(arm_var)) { if (length(input_arm_var) > 0 && length(unique(adsl_filtered[[input_arm_var]])) == 1) { @@ -599,19 +635,6 @@ srv_t_logistic <- function(id, )) } - shiny::validate( - shiny::need(checkmate::test_string(input_avalc_var), "Analysis variable should be a single column."), - shiny::need(input$responders, "`Responders` field is empty") - ) - - # validate interaction values - if (interaction_flag && (is.numeric(merged$anl_q()[["ANL"]][[input_interaction_at]]))) { - shiny::validate(shiny::need( - !is.na(at_values), - "If interaction is specified the level should be entered." - )) - } - # validate covariate has at least two levels shiny::validate( shiny::need( @@ -641,11 +664,7 @@ srv_t_logistic <- function(id, interaction_var <- input$interaction_var interaction_flag <- length(interaction_var) != 0 - at_values <- if (is.null(input$interaction_values)) { - NA - } else { - unlist(as_num(input$interaction_values)) - } + at_values <- as_numeric_from_comma_sep_str(input$interaction_values) at_flag <- interaction_flag && is.numeric(ANL[[interaction_var]]) cov_var <- names(merged$anl_input_r()$columns_source$cov_var) diff --git a/R/tm_t_mult_events.R b/R/tm_t_mult_events.R index a400f2e675..422f18831e 100644 --- a/R/tm_t_mult_events.R +++ b/R/tm_t_mult_events.R @@ -458,19 +458,32 @@ srv_t_mult_events_byterm <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - anl_merge_inputs <- teal.transform::merge_expression_module( - id = "anl_merge", - datasets = data, - join_keys = get_join_keys(data), + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, seq_var = seq_var, hlt = hlt, llt = llt ), - merge_function = "dplyr::inner_join" + datasets = data, + select_validation_rule = list( + arm_var = shinyvalidate::sv_required("Please select a treatment variable"), + llt = shinyvalidate::sv_required("Please select a \"LOW LEVEL TERM\" variable") + ) ) + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + teal.transform::compose_and_enable_validators(iv, selector_list, c("arm_var", "llt")) + }) + + anl_merge_inputs <- teal.transform::merge_expression_srv( + id = "anl_merge", + datasets = data, + join_keys = get_join_keys(data), + selector_list = selector_list, + merge_function = "dplyr::inner_join" + ) adsl_merge_inputs <- teal.transform::merge_expression_module( id = "adsl_merge", @@ -487,6 +500,7 @@ srv_t_mult_events_byterm <- function(id, }) validate_checks <- shiny::reactive({ + teal::validate_inputs(iv_r()) adsl_filtered <- anl_q()[[parentname]] anl_filtered <- anl_q()[[dataname]] @@ -497,8 +511,6 @@ srv_t_mult_events_byterm <- function(id, input_hlt <- as.vector(anl_m$columns_source$hlt) input_llt <- as.vector(anl_m$columns_source$llt) - shiny::validate(shiny::need(input_arm_var, "Please select a treatment variable")) - shiny::validate(shiny::need(input_llt, "Please select a \"LOW LEVEL TERM\" variable")) shiny::validate( shiny::need(is.factor(adsl_filtered[[input_arm_var]]), "Treatment variable is not a factor.") diff --git a/R/tm_t_pp_laboratory.R b/R/tm_t_pp_laboratory.R index 2bac4ab414..a9e9aa97ea 100644 --- a/R/tm_t_pp_laboratory.R +++ b/R/tm_t_pp_laboratory.R @@ -344,9 +344,7 @@ srv_g_laboratory <- function(id, ) # Laboratory values tab ---- - anl_inputs <- teal.transform::merge_expression_module( - datasets = data, - join_keys = get_join_keys(data), + selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( timepoints = timepoints, aval = aval, @@ -354,43 +352,37 @@ srv_g_laboratory <- function(id, param = param, paramcd = paramcd, anrind = anrind + ), + datasets = data, + select_validation_rule = list( + timepoints = shinyvalidate::sv_required("Please select timepoints variable."), + aval = shinyvalidate::sv_required("Please select AVAL variable."), + avalu = shinyvalidate::sv_required("Please select AVALU variable."), + param = shinyvalidate::sv_required("Please select PARAM variable."), + paramcd = shinyvalidate::sv_required("Please select PARAMCD variable."), + anrind = shinyvalidate::sv_required("Please select ANRIND variable.") ) ) + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient")) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( + datasets = data, + join_keys = get_join_keys(data), + selector_list = selector_list + ) + anl_q <- reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) }) all_q <- shiny::reactive({ - shiny::validate(shiny::need(patient_id(), "Please select a patient.")) - - shiny::validate( - shiny::need( - input[[extract_input("timepoints", dataname)]], - "Please select timepoints variable." - ), - shiny::need( - input[[extract_input("aval", dataname)]], - "Please select AVAL variable." - ), - shiny::need( - input[[extract_input("avalu", dataname)]], - "Please select AVALU variable." - ), - shiny::need( - input[[extract_input("param", dataname)]], - "Please select PARAM variable." - ), - shiny::need( - input[[extract_input("paramcd", dataname)]], - "Please select PARAMCD variable." - ), - shiny::need( - input[[extract_input("anrind", dataname)]], - "Please select ANRIND variable." - ) - ) + teal::validate_inputs(iv_r()) labor_calls <- template_laboratory( dataname = "ANL", diff --git a/R/tm_t_pp_medical_history.R b/R/tm_t_pp_medical_history.R index 33fffaac7b..970ea118ed 100644 --- a/R/tm_t_pp_medical_history.R +++ b/R/tm_t_pp_medical_history.R @@ -266,10 +266,26 @@ srv_t_medical_history <- function(id, ) # Medical history tab ---- - anl_inputs <- teal.transform::merge_expression_module( + selector_list <- teal.transform::data_extract_multiple_srv( + data_extract = list(mhterm = mhterm, mhbodsys = mhbodsys, mhdistat = mhdistat), + datasets = data, + select_validation_rule = list( + mhterm = shinyvalidate::sv_required("Please select MHTERM variable."), + mhbodsys = shinyvalidate::sv_required("Please select MHBODSYS variable."), + mhdistat = shinyvalidate::sv_required("Please select MHDISTAT variable.") + ) + ) + + iv_r <- reactive({ + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient")) + teal.transform::compose_and_enable_validators(iv, selector_list) + }) + + anl_inputs <- teal.transform::merge_expression_srv( datasets = data, join_keys = get_join_keys(data), - data_extract = list(mhterm = mhterm, mhbodsys = mhbodsys, mhdistat = mhdistat), + selector_list = selector_list, merge_function = "dplyr::left_join" ) @@ -279,21 +295,9 @@ srv_t_medical_history <- function(id, }) all_q <- shiny::reactive({ - shiny::validate(shiny::need(patient_id(), "Please select a patient.")) + teal::validate_inputs(iv_r()) shiny::validate( - shiny::need( - input[[extract_input("mhterm", dataname)]], - "Please select MHTERM variable." - ), - shiny::need( - input[[extract_input("mhbodsys", dataname)]], - "Please select MHBODSYS variable." - ), - shiny::need( - input[[extract_input("mhdistat", dataname)]], - "Please select MHDISTAT variable." - ), shiny::need( nrow(anl_q()[["ANL"]][anl_q()[["ANL"]][[patient_col]] == patient_id(), ]) > 0, "Patient has no data about medical history." diff --git a/man/arm_ref_comp_observer.Rd b/man/arm_ref_comp_observer.Rd index ed1b54988e..f2c9686267 100644 --- a/man/arm_ref_comp_observer.Rd +++ b/man/arm_ref_comp_observer.Rd @@ -62,41 +62,45 @@ Updates the reference and comparison Treatments when the selected Treatment vari arm_ref_comp <- list(ARMCD = list(ref = "ARM A", comp = c("ARM B"))) arm_var <- choices_selected(c("ARM", "ARMCD"), "ARMCD") -adsl <- data.frame(ARM = c("ARM 1", "ARM2"), ARMCD = c("ARM A", "ARMB")) - -shiny::shinyApp( - ui = fluidPage( - teal.widgets::optionalSelectInput( - "arm", - "Treatment Variable", - choices = arm_var$choices, - selected = arm_var$selected +adsl <- data.frame(ARM = c("ARM 1", "ARM 2"), ARMCD = c("ARM A", "ARM B")) + +ui <- fluidPage( + sidebarLayout( + sidebarPanel( + teal.widgets::optionalSelectInput( + "arm", + "Treatment Variable", + choices = arm_var$choices, + selected = arm_var$selected + ), + shiny::uiOutput("arms_buckets") ), - shiny::uiOutput("arms_buckets"), - shiny::textOutput("result") - ), - server = function(input, output, session) { - - iv_arm_ref <- teal.modules.clinical:::arm_ref_comp_observer( - session, - input, - output, - id_arm_var = "arm", - data = adsl, - arm_ref_comp = arm_ref_comp, - module = "example" + mainPanel( + shiny::textOutput("result") ) - - output$result <- shiny::renderText({ - iv <- shinyvalidate::InputValidator$new() - iv$add_validator(iv_arm_ref) - iv$enable() - teal::validate_inputs(iv) - "Valid selection has been made!" - }) - - } + ) ) + +server = function(input, output, session) { + + iv_arm_ref <- teal.modules.clinical:::arm_ref_comp_observer( + session, + input, + output, + id_arm_var = "arm", + data = adsl, + arm_ref_comp = arm_ref_comp, + module = "example" + ) + + output$result <- shiny::renderText({ + iv <- shinyvalidate::InputValidator$new() + iv$add_validator(iv_arm_ref) + iv$enable() + teal::validate_inputs(iv) + "Valid selection has been made!" + }) +} if (interactive()) { shiny::shinyApp(ui, server) } diff --git a/man/tm_t_abnormality_by_worst_grade.Rd b/man/tm_t_abnormality_by_worst_grade.Rd index c3becd48bc..802de2bc1b 100644 --- a/man/tm_t_abnormality_by_worst_grade.Rd +++ b/man/tm_t_abnormality_by_worst_grade.Rd @@ -95,7 +95,6 @@ For more details, see the vignette: \code{vignette("custom-basic-table-arguments Teal Module: Laboratory test results with highest grade post-baseline } \examples{ - library(scda) library(dplyr) From 6c0cfb434c2b5735838520fb5dcaeecee2fe29bf Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 22 Dec 2022 09:20:49 +0000 Subject: [PATCH 46/69] lintr --- R/tm_a_gee.R | 2 +- R/tm_g_barchart_simple.R | 2 +- R/tm_t_coxreg.R | 2 +- R/tm_t_exposure.R | 2 +- R/tm_t_tte.R | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/tm_a_gee.R b/R/tm_a_gee.R index d7e0707445..d95f37a44f 100644 --- a/R/tm_a_gee.R +++ b/R/tm_a_gee.R @@ -221,7 +221,7 @@ tm_a_gee <- function(label, id_var = cs_to_des_select(id_var, dataname = dataname), visit_var = cs_to_des_select(visit_var, dataname = dataname), cov_var = cs_to_des_select(cov_var, dataname = dataname, multiple = TRUE), - split_covariates = cs_to_des_select(split_choices(cov_var),dataname = dataname, multiple = TRUE), + split_covariates = cs_to_des_select(split_choices(cov_var), dataname = dataname, multiple = TRUE), aval_var = cs_to_des_select(aval_var, dataname = dataname) ) diff --git a/R/tm_g_barchart_simple.R b/R/tm_g_barchart_simple.R index 2eeef4ef05..8a151dc32c 100644 --- a/R/tm_g_barchart_simple.R +++ b/R/tm_g_barchart_simple.R @@ -486,7 +486,7 @@ srv_g_barchart_simple <- function(id, # get grouping variables # NULL: not present in UI, vs character(0): no selection ## helper function - resolve_argument <- function(x){ + resolve_argument <- function(x) { ans <- if (is.null(x)) NULL else as.vector(anl_inputs()$columns_source[[deparse(substitute(x))]]) if (identical(ans, character(0L))) NULL else ans } diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index ce9b60887c..8c4d8437b5 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -888,7 +888,7 @@ srv_t_coxreg <- function(id, dataset <- merged$anl_q()[[dataname]] cov_is_numeric <- vapply(dataset[input_cov_var], is.numeric, logical(1)) input_cov_var[cov_is_numeric] - } else{ + } else { NULL } }) diff --git a/R/tm_t_exposure.R b/R/tm_t_exposure.R index 5f33dfecde..a5f7e30466 100644 --- a/R/tm_t_exposure.R +++ b/R/tm_t_exposure.R @@ -515,7 +515,7 @@ srv_t_exposure <- function(id, id_var = shinyvalidate::sv_required("Subject Identifier is required"), col_by_var = shinyvalidate::compose_rules( shinyvalidate::sv_optional(), - rule_intersection('row_by_var') + rule_intersection("row_by_var") ), row_by_var = shinyvalidate::compose_rules( shinyvalidate::sv_required("Please select a row by variable."), diff --git a/R/tm_t_tte.R b/R/tm_t_tte.R index 37c33b4945..546726f7dc 100644 --- a/R/tm_t_tte.R +++ b/R/tm_t_tte.R @@ -747,7 +747,7 @@ srv_t_tte <- function(id, cnsr_var = shinyvalidate::sv_required("A censor variable is required"), arm_var = shinyvalidate::sv_required("A treatment variable is required"), event_desc_var = shinyvalidate::sv_required("An event description variable is required"), - time_unit_var= shinyvalidate::sv_required("A Time unit variable is required") + time_unit_var = shinyvalidate::sv_required("A Time unit variable is required") ), filter_validation_rule = list( paramcd = shinyvalidate::sv_required("An endpoint is required") From 00998a8ae9bb173abdfa9706d3fabb093558360a Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 22 Dec 2022 09:28:50 +0000 Subject: [PATCH 47/69] styler and roxygen --- DESCRIPTION | 2 +- R/arm_ref_comp.R | 4 +--- R/tm_a_gee.R | 3 ++- R/tm_a_mmrm.R | 4 ++-- R/tm_g_barchart_simple.R | 4 ++-- R/tm_g_ci.R | 5 ++--- R/tm_g_ipp.R | 1 - R/tm_g_km.R | 25 ++++++++++++------------ R/tm_g_lineplot.R | 4 ++-- R/tm_g_pp_patient_timeline.R | 3 ++- R/tm_g_pp_vitals.R | 15 ++++++++++----- R/tm_t_abnormality.R | 22 +++++++++++++-------- R/tm_t_abnormality_by_worst_grade.R | 13 ++++++++----- R/tm_t_ancova.R | 4 +++- R/tm_t_coxreg.R | 3 ++- R/tm_t_events.R | 14 ++++++++------ R/tm_t_events_by_grade.R | 14 ++++++++------ R/tm_t_events_patyear.R | 3 ++- R/tm_t_exposure.R | 4 ++-- R/tm_t_logistic.R | 30 +++++++++++++++++++---------- R/tm_t_shift_by_arm.R | 1 - R/tm_t_shift_by_arm_by_worst.R | 1 - R/tm_t_shift_by_grade.R | 1 - R/tm_t_smq.R | 3 +-- R/tm_t_summary.R | 4 ++-- R/tm_t_tte.R | 6 ++++-- man/arm_ref_comp_observer.Rd | 3 +-- 27 files changed, 112 insertions(+), 84 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 157c5efcbf..7a921e963e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -90,4 +90,4 @@ Encoding: UTF-8 Language: en-US LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.2 +RoxygenNote: 7.2.3 diff --git a/R/arm_ref_comp.R b/R/arm_ref_comp.R index 9240deb69e..2dffc8d3f4 100644 --- a/R/arm_ref_comp.R +++ b/R/arm_ref_comp.R @@ -48,8 +48,7 @@ #' ) #' ) #' -#' server = function(input, output, session) { -#' +#' server <- function(input, output, session) { #' iv_arm_ref <- teal.modules.clinical:::arm_ref_comp_observer( #' session, #' input, @@ -83,7 +82,6 @@ arm_ref_comp_observer <- function(session, on_off = shiny::reactive(TRUE), input_id = "buckets", output_id = "arms_buckets") { - iv <- shinyvalidate::InputValidator$new() iv1 <- shinyvalidate::InputValidator$new() iv2 <- shinyvalidate::InputValidator$new() diff --git a/R/tm_a_gee.R b/R/tm_a_gee.R index d95f37a44f..c700e690a7 100644 --- a/R/tm_a_gee.R +++ b/R/tm_a_gee.R @@ -448,7 +448,8 @@ srv_gee <- function(id, iv$add_rule( "conf_level", shinyvalidate::sv_between( - 0, 1, inclusive = c(FALSE, FALSE), + 0, 1, + inclusive = c(FALSE, FALSE), message_fmt = "Please choose a confidence level between 0 and 1" ) ) diff --git a/R/tm_a_mmrm.R b/R/tm_a_mmrm.R index f39cf44aec..62b4c2fa2c 100644 --- a/R/tm_a_mmrm.R +++ b/R/tm_a_mmrm.R @@ -920,7 +920,8 @@ srv_mmrm <- function(id, iv$add_rule( "conf_level", shinyvalidate::sv_between( - 0, 1, message_fmt = "Please choose a confidence level between 0 and 1" + 0, 1, + message_fmt = "Please choose a confidence level between 0 and 1" ) ) teal.transform::compose_and_enable_validators(iv, selector_list) @@ -1218,7 +1219,6 @@ srv_mmrm <- function(id, split(anl_data, anl_data[[input_visit_var]]), levels(anl_data[[input_visit_var]]) ) - }) # Connector: diff --git a/R/tm_g_barchart_simple.R b/R/tm_g_barchart_simple.R index 8a151dc32c..854f432743 100644 --- a/R/tm_g_barchart_simple.R +++ b/R/tm_g_barchart_simple.R @@ -325,14 +325,14 @@ srv_g_barchart_simple <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - rule_dupl <- function(others) { function(value) { othervals <- lapply(others, function(x) selector_list()[[x]]()$select) vars <- c(value, unlist(othervals)) dups <- unique(vars[duplicated(vars)]) - if (value %in% dups) + if (value %in% dups) { paste("Duplicated value:", value, collapse = ", ") + } } } diff --git a/R/tm_g_ci.R b/R/tm_g_ci.R index 4394a4a2b4..9cf6119c6c 100644 --- a/R/tm_g_ci.R +++ b/R/tm_g_ci.R @@ -377,7 +377,6 @@ srv_g_ci <- function(id, # nolint checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list(x_var = x_var, y_var = y_var, color = color), datasets = data, @@ -386,8 +385,8 @@ srv_g_ci <- function(id, # nolint y_var = shinyvalidate::sv_required("Select an analysis value (y axis)") ), filter_validation_rule = list( - y_var = shinyvalidate::sv_required(message = "Please select the filters.") - ) + y_var = shinyvalidate::sv_required(message = "Please select the filters.") + ) ) iv_r <- reactive({ diff --git a/R/tm_g_ipp.R b/R/tm_g_ipp.R index 824bc58329..f414e9faec 100644 --- a/R/tm_g_ipp.R +++ b/R/tm_g_ipp.R @@ -474,7 +474,6 @@ srv_g_ipp <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - selector_list <- teal.transform::data_extract_multiple_srv( datasets = data, data_extract = list( diff --git a/R/tm_g_km.R b/R/tm_g_km.R index 6cbf9415f4..be20b64b12 100644 --- a/R/tm_g_km.R +++ b/R/tm_g_km.R @@ -675,22 +675,23 @@ srv_g_km <- function(id, iv$add_rule( "conf_level", shinyvalidate::sv_between( - 0, 1, inclusive = c(FALSE, FALSE), + 0, 1, + inclusive = c(FALSE, FALSE), message_fmt = "Please choose a confidence level between 0 and 1" ) ) iv$add_rule("xticks", shinyvalidate::sv_optional()) - iv$add_rule( - "xticks", - function(value) { - val <- as_numeric_from_comma_sep_str(value, split_char = ";") - if (anyNA(val) || any(val < 0)) { - "All break intervals for x-axis must be non-negative numbers" - } else if (all(val == 0)) { - "Not all break intervals for x-axis can be 0" - } - } - ) + iv$add_rule( + "xticks", + function(value) { + val <- as_numeric_from_comma_sep_str(value, split_char = ";") + if (anyNA(val) || any(val < 0)) { + "All break intervals for x-axis must be non-negative numbers" + } else if (all(val == 0)) { + "Not all break intervals for x-axis can be 0" + } + } + ) teal.transform::compose_and_enable_validators(iv, selector_list) }) diff --git a/R/tm_g_lineplot.R b/R/tm_g_lineplot.R index 00a535db25..d6ef39894a 100644 --- a/R/tm_g_lineplot.R +++ b/R/tm_g_lineplot.R @@ -518,7 +518,6 @@ srv_g_lineplot <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list(x = x, y = y, strata = strata, paramcd = paramcd, y_unit = y_unit, param = param), datasets = data, @@ -538,7 +537,8 @@ srv_g_lineplot <- function(id, iv$add_rule( "conf_level", shinyvalidate::sv_between( - 0, 1, message_fmt = "Please choose a confidence level between 0 and 1", inclusive = c(FALSE, FALSE) + 0, 1, + message_fmt = "Please choose a confidence level between 0 and 1", inclusive = c(FALSE, FALSE) ) ) iv$add_rule("interval", shinyvalidate::sv_required("Please select an interval for the midpoint statistic")) diff --git a/R/tm_g_pp_patient_timeline.R b/R/tm_g_pp_patient_timeline.R index 590dab52aa..cfd7a6fe44 100644 --- a/R/tm_g_pp_patient_timeline.R +++ b/R/tm_g_pp_patient_timeline.R @@ -765,8 +765,9 @@ srv_g_patient_timeline <- function(id, rule_one_parameter <- function(other) { function(value) { - if (length(value) == 0L && length(selector_list()[[other]]()$select) == 0L) + if (length(value) == 0L && length(selector_list()[[other]]()$select) == 0L) { "At least one parameter must be selected." + } } } diff --git a/R/tm_g_pp_vitals.R b/R/tm_g_pp_vitals.R index a55ffa1d0a..e8ddcb281c 100644 --- a/R/tm_g_pp_vitals.R +++ b/R/tm_g_pp_vitals.R @@ -416,20 +416,25 @@ srv_g_vitals <- function(id, datasets = data, select_validation_rule = list( paramcd = shinyvalidate::sv_required( - "Please select PARAMCD variable."), + "Please select PARAMCD variable." + ), xaxis = shinyvalidate::sv_required( - "Please select Vitals x-axis variable."), + "Please select Vitals x-axis variable." + ), aval = shinyvalidate::sv_required( - "Please select AVAL variable.") + "Please select AVAL variable." + ) ) ) iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("patient_id", shinyvalidate::sv_required( - "Please select a patient.")) + "Please select a patient." + )) iv$add_rule("paramcd_levels_vals", shinyvalidate::sv_required( - "Please select PARAMCD variable levels.")) + "Please select PARAMCD variable levels." + )) teal.transform::compose_and_enable_validators(iv, selector_list) }) diff --git a/R/tm_t_abnormality.R b/R/tm_t_abnormality.R index f5f55b94a1..48f31ed22a 100644 --- a/R/tm_t_abnormality.R +++ b/R/tm_t_abnormality.R @@ -499,7 +499,6 @@ srv_t_abnormality <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, @@ -512,24 +511,31 @@ srv_t_abnormality <- function(id, datasets = data, select_validation_rule = list( arm_var = shinyvalidate::sv_required( - "Please select a treatment variable."), + "Please select a treatment variable." + ), by_vars = shinyvalidate::sv_required( - "Please select a Row By Variable."), + "Please select a Row By Variable." + ), id_var = shinyvalidate::sv_required( - "Please select a subject identifier."), + "Please select a subject identifier." + ), grade = shinyvalidate::sv_required( - "Please select a grade variable."), + "Please select a grade variable." + ), baseline_var = shinyvalidate::sv_required( - "Please select a baseline grade variable."), + "Please select a baseline grade variable." + ), treatment_flag_var = shinyvalidate::sv_required( - "Please select indicator value for on treatment records.") + "Please select indicator value for on treatment records." + ) ) ) iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("treatment_flag", shinyvalidate::sv_required( - "Please select indicator value for on treatment records.")) + "Please select indicator value for on treatment records." + )) teal.transform::compose_and_enable_validators(iv, selector_list) }) diff --git a/R/tm_t_abnormality_by_worst_grade.R b/R/tm_t_abnormality_by_worst_grade.R index 6a882de836..d596f59f82 100644 --- a/R/tm_t_abnormality_by_worst_grade.R +++ b/R/tm_t_abnormality_by_worst_grade.R @@ -483,7 +483,6 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, @@ -566,15 +565,19 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint all(as.character(unique(merged$anl_q()[["ANL"]][[input_atoxgr]])) %in% as.character(c(-4:4))), "All grade values should be within -4:4 range." ), - shiny::need(is.factor(merged$anl_q()[["ANL"]][[input_atoxgr]]), - "Grade variable should be a factor.") + shiny::need( + is.factor(merged$anl_q()[["ANL"]][[input_atoxgr]]), + "Grade variable should be a factor." + ) ) } if (length(input_atoxgr) > 0) { shiny::validate( - shiny::need(is.factor(merged$anl_q()[["ANL"]][[input_atoxgr]]), - "Treatment variable should be a factor."), + shiny::need( + is.factor(merged$anl_q()[["ANL"]][[input_atoxgr]]), + "Treatment variable should be a factor." + ), ) } diff --git a/R/tm_t_ancova.R b/R/tm_t_ancova.R index d149654e29..ada7a82a43 100644 --- a/R/tm_t_ancova.R +++ b/R/tm_t_ancova.R @@ -729,7 +729,9 @@ srv_ancova <- function(id, iv <- shinyvalidate::InputValidator$new() iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level.")) iv$add_rule("conf_level", shinyvalidate::sv_between( - 0, 1, message_fmt = "Confdence level must be between {left} and {right}.")) + 0, 1, + message_fmt = "Confdence level must be between {left} and {right}." + )) iv$add_validator(iv_arco) teal.transform::compose_and_enable_validators(iv, selector_list) }) diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index 8c4d8437b5..f412bb98c5 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -821,8 +821,9 @@ srv_t_coxreg <- function(id, # the correct label is shown - if this is not done # then the last value of "val" is the label for all cases v <- val - ~ if (anyNA(as_numeric_from_comma_sep_str(.))) + ~ if (anyNA(as_numeric_from_comma_sep_str(.))) { paste("Numeric interaction level(s) should be specified for", v) + } } diff --git a/R/tm_t_events.R b/R/tm_t_events.R index 44eb67a227..88ce77c57d 100644 --- a/R/tm_t_events.R +++ b/R/tm_t_events.R @@ -639,17 +639,19 @@ srv_t_events_byterm <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list(arm_var = arm_var, hlt = hlt, llt = llt), datasets = data, select_validation_rule = list( - arm_var = ~ if (length(.) != 1 && length(.) != 2) - "Please select 1 or 2 treatment variable values", - hlt = ~ if (length(selector_list()$llt()$select) + length(.) == 0) - "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables.", - llt = ~ if (length(selector_list()$hlt()$select) + length(.) == 0) + arm_var = ~ if (length(.) != 1 && length(.) != 2) { + "Please select 1 or 2 treatment variable values" + }, + hlt = ~ if (length(selector_list()$llt()$select) + length(.) == 0) { "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables." + }, + llt = ~ if (length(selector_list()$hlt()$select) + length(.) == 0) { + "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables." + } ) ) diff --git a/R/tm_t_events_by_grade.R b/R/tm_t_events_by_grade.R index 89dfceb6c2..2788b5f110 100644 --- a/R/tm_t_events_by_grade.R +++ b/R/tm_t_events_by_grade.R @@ -987,20 +987,22 @@ srv_t_events_by_grade <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list(arm_var = arm_var, hlt = hlt, llt = llt, grade = grade), datasets = data, select_validation_rule = list( arm_var = shinyvalidate::sv_required("A treatment variable is required"), grade = shinyvalidate::sv_required("An event grade is required"), - hlt = ~ if (length(selector_list()$llt()$select) + length(.) == 0) - "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables.", + hlt = ~ if (length(selector_list()$llt()$select) + length(.) == 0) { + "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables." + }, llt = shinyvalidate::compose_rules( - ~ if (length(selector_list()$hlt()$select) + length(.) == 0) - "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables.", - ~ if (col_by_grade() && length(.) == 0) + ~ if (length(selector_list()$hlt()$select) + length(.) == 0) { + "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables." + }, + ~ if (col_by_grade() && length(.) == 0) { "Low Level Term must be present when grade groupings are displayed in nested columns." + } ) ) ) diff --git a/R/tm_t_events_patyear.R b/R/tm_t_events_patyear.R index 7f38f6d721..65c367443d 100644 --- a/R/tm_t_events_patyear.R +++ b/R/tm_t_events_patyear.R @@ -429,7 +429,8 @@ srv_events_patyear <- function(id, iv$add_rule( "conf_level", shinyvalidate::sv_between( - 0, 1, inclusive = c(FALSE, FALSE), + 0, 1, + inclusive = c(FALSE, FALSE), message_fmt = "Please choose a confidence level between 0 and 1" ) ) diff --git a/R/tm_t_exposure.R b/R/tm_t_exposure.R index a5f7e30466..253728a092 100644 --- a/R/tm_t_exposure.R +++ b/R/tm_t_exposure.R @@ -491,12 +491,12 @@ srv_t_exposure <- function(id, with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - rule_intersection <- function(other) { function(value) { others <- selector_list()[[other]]()$select - if (length(intersect(value, others)) > 0L) + if (length(intersect(value, others)) > 0L) { "Column by and row by variables should not be the same." + } } } diff --git a/R/tm_t_logistic.R b/R/tm_t_logistic.R index 2b494db63e..420c805b76 100644 --- a/R/tm_t_logistic.R +++ b/R/tm_t_logistic.R @@ -477,7 +477,8 @@ srv_t_logistic <- function(id, arm_var = arm_var, paramcd = paramcd, avalc_var = avalc_var, - cov_var = cov_var), + cov_var = cov_var + ), datasets = data, select_validation_rule = list( arm_var = shinyvalidate::sv_required("Treatment Variable is empty"), @@ -494,20 +495,29 @@ srv_t_logistic <- function(id, iv$add_rule("responders", shinyvalidate::sv_required("`Responders` field is empty")) iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level.")) iv$add_rule("conf_level", shinyvalidate::sv_between( - 0, 1, message_fmt = "Confdence level must be between {left} and {right}.")) + 0, 1, + message_fmt = "Confdence level must be between {left} and {right}." + )) iv$add_validator(iv_arco) # Conditional validator for interaction values. iv_int <- shinyvalidate::InputValidator$new() iv_int$condition(~ length(input$interaction_var) > 0L && - is.numeric(merged$anl_q()[["ANL"]][[input$interaction_var]])) + is.numeric(merged$anl_q()[["ANL"]][[input$interaction_var]])) iv_int$add_rule("interaction_values", shinyvalidate::sv_required( - "If interaction is specified the level should be entered.")) - iv_int$add_rule("interaction_values", - ~ if (anyNA(as_numeric_from_comma_sep_str(.))) - "Interaction levels are invalid.") - iv_int$add_rule("interaction_values", - ~ if (any(duplicated(as_numeric_from_comma_sep_str(.)))) - "Interaction levels must be unique.") + "If interaction is specified the level should be entered." + )) + iv_int$add_rule( + "interaction_values", + ~ if (anyNA(as_numeric_from_comma_sep_str(.))) { + "Interaction levels are invalid." + } + ) + iv_int$add_rule( + "interaction_values", + ~ if (any(duplicated(as_numeric_from_comma_sep_str(.)))) { + "Interaction levels must be unique." + } + ) iv$add_validator(iv_int) teal.transform::compose_and_enable_validators(iv, selector_list) }) diff --git a/R/tm_t_shift_by_arm.R b/R/tm_t_shift_by_arm.R index a7a1b7db00..6926f9b064 100644 --- a/R/tm_t_shift_by_arm.R +++ b/R/tm_t_shift_by_arm.R @@ -394,7 +394,6 @@ srv_shift_by_arm <- function(id, with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, diff --git a/R/tm_t_shift_by_arm_by_worst.R b/R/tm_t_shift_by_arm_by_worst.R index c8d397023f..18e26c6634 100644 --- a/R/tm_t_shift_by_arm_by_worst.R +++ b/R/tm_t_shift_by_arm_by_worst.R @@ -417,7 +417,6 @@ srv_shift_by_arm_by_worst <- function(id, with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, diff --git a/R/tm_t_shift_by_grade.R b/R/tm_t_shift_by_grade.R index 3f7b12bc71..28fbf5416f 100644 --- a/R/tm_t_shift_by_grade.R +++ b/R/tm_t_shift_by_grade.R @@ -751,7 +751,6 @@ srv_t_shift_by_grade <- function(id, checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( arm_var = arm_var, diff --git a/R/tm_t_smq.R b/R/tm_t_smq.R index 11e95f82b3..7899b941cb 100644 --- a/R/tm_t_smq.R +++ b/R/tm_t_smq.R @@ -536,7 +536,6 @@ srv_t_smq <- function(id, with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list( scopes = scopes, @@ -549,7 +548,7 @@ srv_t_smq <- function(id, select_validation_rule = list( scopes = shinyvalidate::sv_required("A scope variable is required"), llt = shinyvalidate::sv_required("A low level term variable is required"), - arm_var = shinyvalidate::compose_rules( + arm_var = shinyvalidate::compose_rules( shinyvalidate::sv_required("At least one treatment variable is required"), ~ if (length(.) > 2) "Please select not more than two treatment variables" ), diff --git a/R/tm_t_summary.R b/R/tm_t_summary.R index bd638ada51..d7a83dcf95 100644 --- a/R/tm_t_summary.R +++ b/R/tm_t_summary.R @@ -424,14 +424,14 @@ srv_summary <- function(id, with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "tdata") shiny::moduleServer(id, function(input, output, session) { - selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list(arm_var = arm_var, summarize_vars = summarize_vars), datasets = data, select_validation_rule = list( arm_var = shinyvalidate::sv_required("Please select a treatment variable"), - summarize_vars = ~ if (length(.) != 1 && length(.) != 2) + summarize_vars = ~ if (length(.) != 1 && length(.) != 2) { "Please select 1 or 2 summary variables" + } ) ) diff --git a/R/tm_t_tte.R b/R/tm_t_tte.R index 546726f7dc..658eefc1ad 100644 --- a/R/tm_t_tte.R +++ b/R/tm_t_tte.R @@ -761,13 +761,15 @@ srv_t_tte <- function(id, iv$add_rule("conf_level_coxph", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) iv$add_rule( "conf_level_coxph", shinyvalidate::sv_between( - 0, 1, message_fmt = "Please choose a confidence level between 0 and 1" + 0, 1, + message_fmt = "Please choose a confidence level between 0 and 1" ) ) iv$add_rule("conf_level_survfit", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) iv$add_rule( "conf_level_survfit", shinyvalidate::sv_between( - 0, 1, message_fmt = "Please choose a confidence level between 0 and 1" + 0, 1, + message_fmt = "Please choose a confidence level between 0 and 1" ) ) iv$add_rule( diff --git a/man/arm_ref_comp_observer.Rd b/man/arm_ref_comp_observer.Rd index f2c9686267..3cdf748d6e 100644 --- a/man/arm_ref_comp_observer.Rd +++ b/man/arm_ref_comp_observer.Rd @@ -81,8 +81,7 @@ ui <- fluidPage( ) ) -server = function(input, output, session) { - +server <- function(input, output, session) { iv_arm_ref <- teal.modules.clinical:::arm_ref_comp_observer( session, input, From a8d591b82e613f035eb3a84092d036b34362978f Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 22 Dec 2022 10:24:12 +0000 Subject: [PATCH 48/69] code review changes --- R/tm_a_gee.R | 4 ++-- R/tm_a_mmrm.R | 7 +++---- R/tm_g_forest_tte.R | 4 ++-- R/tm_g_km.R | 12 ++++++------ R/tm_t_coxreg.R | 4 ++-- R/tm_t_events_patyear.R | 4 ++-- R/tm_t_smq.R | 2 +- R/tm_t_tte.R | 15 ++++++++++----- R/utils.R | 10 +++++----- tests/testthat/test-utils.R | 16 ++++++++++++++++ 10 files changed, 49 insertions(+), 29 deletions(-) diff --git a/R/tm_a_gee.R b/R/tm_a_gee.R index c700e690a7..ef27db8a6d 100644 --- a/R/tm_a_gee.R +++ b/R/tm_a_gee.R @@ -444,13 +444,13 @@ srv_gee <- function(id, iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() - iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level.")) iv$add_rule( "conf_level", shinyvalidate::sv_between( 0, 1, inclusive = c(FALSE, FALSE), - message_fmt = "Please choose a confidence level between 0 and 1" + message_fmt = "Confidence level must be between 0 and 1" ) ) iv$add_rule("cor_struct", shinyvalidate::sv_required("Please choose a correlation structure")) diff --git a/R/tm_a_mmrm.R b/R/tm_a_mmrm.R index 62b4c2fa2c..788446af0a 100644 --- a/R/tm_a_mmrm.R +++ b/R/tm_a_mmrm.R @@ -921,7 +921,7 @@ srv_mmrm <- function(id, "conf_level", shinyvalidate::sv_between( 0, 1, - message_fmt = "Please choose a confidence level between 0 and 1" + message_fmt = "Confidence level must be between 0 and 1" ) ) teal.transform::compose_and_enable_validators(iv, selector_list) @@ -1103,9 +1103,8 @@ srv_mmrm <- function(id, adsl_filtered <- anl_q()[["ADSL"]] anl_filtered <- anl_q()[[dataname]] - shiny::validate( - shiny::need(nrow(adsl_filtered) > 1 && nrow(anl_filtered) > 1, "Filtered data has zero rows") - ) + teal::validate_has_data(adsl_filtered, min_nrow = 1) + teal::validate_has_data(anl_filtered, min_nrow = 1) validate_checks() c(list(adsl_filtered = adsl_filtered, anl_filtered = anl_filtered), encoding_inputs) }) diff --git a/R/tm_g_forest_tte.R b/R/tm_g_forest_tte.R index 28a454b2e1..04ffa56b1b 100644 --- a/R/tm_g_forest_tte.R +++ b/R/tm_g_forest_tte.R @@ -515,10 +515,10 @@ srv_g_forest_tte <- function(id, iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() - iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level")) iv$add_rule( "conf_level", - shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between 0 and 1") + shinyvalidate::sv_between(0, 1, message_fmt = "Confidence level must be between 0 and 1") ) iv$add_validator(iv_arm_ref) teal.transform::compose_and_enable_validators(iv, selector_list) diff --git a/R/tm_g_km.R b/R/tm_g_km.R index be20b64b12..16fe9eaf3a 100644 --- a/R/tm_g_km.R +++ b/R/tm_g_km.R @@ -670,25 +670,25 @@ srv_g_km <- function(id, iv <- shinyvalidate::InputValidator$new() iv$add_validator(iv_arm_ref) iv$add_rule("font_size", shinyvalidate::sv_required("Plot tables font size must be greater than or equal to 5")) - iv$add_rule("font_size", shinyvalidate::sv_gte(5, "Plot tables font size must be greater than or equal to 5.")) - iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule("font_size", shinyvalidate::sv_gte(5, "Plot tables font size must be greater than or equal to 5")) + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level")) iv$add_rule( "conf_level", shinyvalidate::sv_between( 0, 1, inclusive = c(FALSE, FALSE), - message_fmt = "Please choose a confidence level between 0 and 1" + message_fmt = "Confidence level must be between 0 and 1" ) ) iv$add_rule("xticks", shinyvalidate::sv_optional()) iv$add_rule( "xticks", function(value) { - val <- as_numeric_from_comma_sep_str(value, split_char = ";") + val <- as_numeric_from_comma_sep_str(value, sep = ";") if (anyNA(val) || any(val < 0)) { "All break intervals for x-axis must be non-negative numbers" } else if (all(val == 0)) { - "Not all break intervals for x-axis can be 0" + "At least one break interval for x-axis must be > 0" } } ) @@ -759,7 +759,7 @@ srv_g_km <- function(id, teal::validate_has_data(anl, 2) input_xticks <- if (!is.null(input$xticks)) { - as_numeric_from_comma_sep_str(input$xticks, split_char = ";") + as_numeric_from_comma_sep_str(input$xticks, sep = ";") } else { NULL } diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index f412bb98c5..6b30c374db 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -830,10 +830,10 @@ srv_t_coxreg <- function(id, iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_validator(iv_arm_ref) - iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level")) iv$add_rule( "conf_level", - shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between 0 and 1") + shinyvalidate::sv_between(0, 1, message_fmt = "Confidence level must be between 0 and 1") ) iv$add_rule("pval_method", ~ if (length(selector_list()$strata_var()$select) > 0 && . != "wald") { "Only Wald tests are supported for models with strata." diff --git a/R/tm_t_events_patyear.R b/R/tm_t_events_patyear.R index 65c367443d..75ba6017ec 100644 --- a/R/tm_t_events_patyear.R +++ b/R/tm_t_events_patyear.R @@ -425,13 +425,13 @@ srv_events_patyear <- function(id, iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() - iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level")) iv$add_rule( "conf_level", shinyvalidate::sv_between( 0, 1, inclusive = c(FALSE, FALSE), - message_fmt = "Please choose a confidence level between 0 and 1" + message_fmt = "Confidence level must be between 0 and 1" ) ) iv$add_rule("conf_method", shinyvalidate::sv_required("A CI method is required")) diff --git a/R/tm_t_smq.R b/R/tm_t_smq.R index 7899b941cb..75b359cf3e 100644 --- a/R/tm_t_smq.R +++ b/R/tm_t_smq.R @@ -550,7 +550,7 @@ srv_t_smq <- function(id, llt = shinyvalidate::sv_required("A low level term variable is required"), arm_var = shinyvalidate::compose_rules( shinyvalidate::sv_required("At least one treatment variable is required"), - ~ if (length(.) > 2) "Please select not more than two treatment variables" + ~ if (length(.) > 2) "Please select no more than two treatment variables" ), id_var = shinyvalidate::sv_required("An id variable is required"), baskets = shinyvalidate::sv_required("At least one basket is required") diff --git a/R/tm_t_tte.R b/R/tm_t_tte.R index 658eefc1ad..e93db4fb88 100644 --- a/R/tm_t_tte.R +++ b/R/tm_t_tte.R @@ -569,7 +569,7 @@ ui_t_tte <- function(id, ...) { condition = paste0("input['", ns("compare_arms"), "']"), shiny::div( shiny::uiOutput(ns("arms_buckets")), - shiny::helpText("Multiple reference groups are automatically combined into a single group."), + shiny::uiOutput(ns("helptext_ui")), shiny::checkboxInput( ns("combine_comp_arms"), "Combine all comparison groups?", @@ -754,22 +754,27 @@ srv_t_tte <- function(id, ) ) + output$helptext_ui <- renderUI({ + req(selector_list()$arm_var()$select) + shiny::helpText("Multiple reference groups are automatically combined into a single group.") + }) + iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_validator(iv_arm_ref) - iv$add_rule("conf_level_coxph", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule("conf_level_coxph", shinyvalidate::sv_required("Please choose a hazard ratio confidence level")) iv$add_rule( "conf_level_coxph", shinyvalidate::sv_between( 0, 1, - message_fmt = "Please choose a confidence level between 0 and 1" + message_fmt = "Hazard ratio confidence level must between 0 and 1" ) ) - iv$add_rule("conf_level_survfit", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) + iv$add_rule("conf_level_survfit", shinyvalidate::sv_required("Please choose a KM confidence level")) iv$add_rule( "conf_level_survfit", shinyvalidate::sv_between( 0, 1, - message_fmt = "Please choose a confidence level between 0 and 1" + message_fmt = "KM confidence level must between 0 and 1" ) ) iv$add_rule( diff --git a/R/utils.R b/R/utils.R index d5de16e49b..3e9ac8a572 100644 --- a/R/utils.R +++ b/R/utils.R @@ -873,12 +873,12 @@ get_paramcd_label <- function(anl, paramcd) { }) } -as_numeric_from_comma_sep_str <- function(input_string, split_char = ",") { +as_numeric_from_comma_sep_str <- function(input_string, sep = ",") { if (!is.null(input_string) && trimws(input_string) != "") { - ref_line <- unlist(strsplit(trimws(input_string), split_char)) - ref_line <- suppressWarnings(as.numeric(ref_line)) + split_string <- unlist(strsplit(trimws(input_string), sep)) + split_as_numeric <- suppressWarnings(as.numeric(split_string)) } else { - ref_line <- NULL + split_as_numeric <- NULL } - return(ref_line) + return(split_as_numeric) } diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index b65b35776d..f7f819fa01 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -409,3 +409,19 @@ testthat::test_that("cs_to_des_select creates data_extract_spec with ordered = T ) ) }) + +testthat::test_that("as_numeric_from_comma_sep_str returns NULL if blank string or NULL entered", { + testthat::expect_null(as_numeric_from_comma_sep_str(NULL)) + testthat::expect_null(as_numeric_from_comma_sep_str(" ")) +}) + +testthat::test_that("as_numeric_from_comma_sep_str returns numeric vector of numbers", { + testthat::expect_equal(as_numeric_from_comma_sep_str("3,4,5.56"), c(3, 4, 5.56)) + testthat::expect_equal(as_numeric_from_comma_sep_str("3,4 ,v"), c(3, 4, NA)) +}) + +testthat::test_that("as_numeric_from_comma_sep_str respects sep argument", { + testthat::expect_equal(as_numeric_from_comma_sep_str("3,4,5", sep = ";"), as.numeric(NA)) + testthat::expect_equal(as_numeric_from_comma_sep_str("3 %% 4 %% 154.32", sep = "%%"), c(3, 4, 154.32)) +}) + From 039be38284a3ef273c7b415bc0625ddbfef3b10b Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 22 Dec 2022 10:35:04 +0000 Subject: [PATCH 49/69] linter and linebreak in mmrm --- R/tm_a_mmrm.R | 3 ++- tests/testthat/test-utils.R | 1 - 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/tm_a_mmrm.R b/R/tm_a_mmrm.R index 788446af0a..b15d42b562 100644 --- a/R/tm_a_mmrm.R +++ b/R/tm_a_mmrm.R @@ -1451,7 +1451,8 @@ srv_mmrm <- function(id, } } currnt_state <- !state_has_changed() - what_to_return <- if (input$button_start > shiny::isolate(state$button_start)) { + what_to_return <- + if (input$button_start > shiny::isolate(state$button_start)) { state$button_start <- input$button_start state$optimizer <- result result diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index f7f819fa01..d7a617fd36 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -424,4 +424,3 @@ testthat::test_that("as_numeric_from_comma_sep_str respects sep argument", { testthat::expect_equal(as_numeric_from_comma_sep_str("3,4,5", sep = ";"), as.numeric(NA)) testthat::expect_equal(as_numeric_from_comma_sep_str("3 %% 4 %% 154.32", sep = "%%"), c(3, 4, 154.32)) }) - From cda3a617c420d3e104f2ae9dfa31f0c933000741 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 22 Dec 2022 11:58:53 +0100 Subject: [PATCH 50/69] update in barchart module --- R/tm_g_barchart_simple.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/tm_g_barchart_simple.R b/R/tm_g_barchart_simple.R index 854f432743..023ccfa872 100644 --- a/R/tm_g_barchart_simple.R +++ b/R/tm_g_barchart_simple.R @@ -486,8 +486,8 @@ srv_g_barchart_simple <- function(id, # get grouping variables # NULL: not present in UI, vs character(0): no selection ## helper function - resolve_argument <- function(x) { - ans <- if (is.null(x)) NULL else as.vector(anl_inputs()$columns_source[[deparse(substitute(x))]]) + resolve_argument <- function(x){ + ans <- if (is.null(x)) NULL else selector_list()[[deparse(substitute(x))]]()$select if (identical(ans, character(0L))) NULL else ans } ## returns named vector of non-NULL variables to group by From a057f20805ee6a36be0a8aed0ab3db6b5a694282 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 22 Dec 2022 11:15:30 +0000 Subject: [PATCH 51/69] styler --- R/tm_a_mmrm.R | 18 +++++++++--------- R/tm_g_barchart_simple.R | 2 +- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/R/tm_a_mmrm.R b/R/tm_a_mmrm.R index b15d42b562..f7a6dd5331 100644 --- a/R/tm_a_mmrm.R +++ b/R/tm_a_mmrm.R @@ -1452,15 +1452,15 @@ srv_mmrm <- function(id, } currnt_state <- !state_has_changed() what_to_return <- - if (input$button_start > shiny::isolate(state$button_start)) { - state$button_start <- input$button_start - state$optimizer <- result - result - } else if (currnt_state) { - shiny::isolate(state$optimizer) - } else { - NULL - } + if (input$button_start > shiny::isolate(state$button_start)) { + state$button_start <- input$button_start + state$optimizer <- result + result + } else if (currnt_state) { + shiny::isolate(state$optimizer) + } else { + NULL + } return(what_to_return) }) diff --git a/R/tm_g_barchart_simple.R b/R/tm_g_barchart_simple.R index 023ccfa872..5f15f1eb15 100644 --- a/R/tm_g_barchart_simple.R +++ b/R/tm_g_barchart_simple.R @@ -486,7 +486,7 @@ srv_g_barchart_simple <- function(id, # get grouping variables # NULL: not present in UI, vs character(0): no selection ## helper function - resolve_argument <- function(x){ + resolve_argument <- function(x) { ans <- if (is.null(x)) NULL else selector_list()[[deparse(substitute(x))]]()$select if (identical(ans, character(0L))) NULL else ans } From 174957a30e2f4c3a991de2d7a0a4dca4873eb4d1 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 22 Dec 2022 11:43:47 +0000 Subject: [PATCH 52/69] tweak barchart --- R/tm_g_barchart_simple.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/tm_g_barchart_simple.R b/R/tm_g_barchart_simple.R index 5f15f1eb15..30143d74f1 100644 --- a/R/tm_g_barchart_simple.R +++ b/R/tm_g_barchart_simple.R @@ -356,12 +356,17 @@ srv_g_barchart_simple <- function(id, shinyvalidate::sv_optional(), rule_dupl(others = c("fill", "x_facet", "x")) ) + ), + dataset_validation_rule = list( + fill = NULL, + x_facet = NULL, + y_facet = NULL ) ) iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() - hm <- teal.transform::compose_and_enable_validators(iv, selector_list) + teal.transform::compose_and_enable_validators(iv, selector_list) }) anl_inputs <- teal.transform::merge_expression_srv( From 4c240b8703f17f1cbc0f7083706ce7a73a893d35 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 22 Dec 2022 13:32:03 +0000 Subject: [PATCH 53/69] fix summary --- R/tm_t_summary.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/tm_t_summary.R b/R/tm_t_summary.R index d7a83dcf95..241e43cb59 100644 --- a/R/tm_t_summary.R +++ b/R/tm_t_summary.R @@ -428,9 +428,9 @@ srv_summary <- function(id, data_extract = list(arm_var = arm_var, summarize_vars = summarize_vars), datasets = data, select_validation_rule = list( - arm_var = shinyvalidate::sv_required("Please select a treatment variable"), - summarize_vars = ~ if (length(.) != 1 && length(.) != 2) { - "Please select 1 or 2 summary variables" + summarize_vars = shinyvalidate::sv_required("Please select a summarize variable"), + arm_var = ~ if (length(.) != 1 && length(.) != 2) { + "Please select 1 or 2 treatment variables" } ) ) From 33b7a0232fcaa66b3daecdfda0c66525b88c6406 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 22 Dec 2022 13:41:09 +0000 Subject: [PATCH 54/69] more module fixes --- R/tm_g_km.R | 6 +++++- R/tm_t_binary_outcome.R | 6 +++++- R/tm_t_summary.R | 2 +- R/tm_t_tte.R | 5 ++++- 4 files changed, 15 insertions(+), 4 deletions(-) diff --git a/R/tm_g_km.R b/R/tm_g_km.R index 16fe9eaf3a..c843851e64 100644 --- a/R/tm_g_km.R +++ b/R/tm_g_km.R @@ -668,7 +668,11 @@ srv_g_km <- function(id, iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() - iv$add_validator(iv_arm_ref) + + if (isTRUE(input$compare_arms)) { + iv$add_validator(iv_arm_ref) + } + iv$add_rule("font_size", shinyvalidate::sv_required("Plot tables font size must be greater than or equal to 5")) iv$add_rule("font_size", shinyvalidate::sv_gte(5, "Plot tables font size must be greater than or equal to 5")) iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level")) diff --git a/R/tm_t_binary_outcome.R b/R/tm_t_binary_outcome.R index 28a6978651..7651d10b70 100644 --- a/R/tm_t_binary_outcome.R +++ b/R/tm_t_binary_outcome.R @@ -766,7 +766,11 @@ srv_t_binary_outcome <- function(id, iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() - iv$add_validator(iv_arm_ref) + + if (isTRUE(input$compare_arms)) { + iv$add_validator(iv_arm_ref) + } + iv$add_rule("responders", shinyvalidate::sv_required("`Responders` field is empty")) iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) iv$add_rule( diff --git a/R/tm_t_summary.R b/R/tm_t_summary.R index 241e43cb59..1542f384fb 100644 --- a/R/tm_t_summary.R +++ b/R/tm_t_summary.R @@ -430,7 +430,7 @@ srv_summary <- function(id, select_validation_rule = list( summarize_vars = shinyvalidate::sv_required("Please select a summarize variable"), arm_var = ~ if (length(.) != 1 && length(.) != 2) { - "Please select 1 or 2 treatment variables" + "Please select 1 or 2 column variables" } ) ) diff --git a/R/tm_t_tte.R b/R/tm_t_tte.R index e93db4fb88..aa585baed3 100644 --- a/R/tm_t_tte.R +++ b/R/tm_t_tte.R @@ -761,7 +761,10 @@ srv_t_tte <- function(id, iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() - iv$add_validator(iv_arm_ref) + + if (isTRUE(input$compare_arms)) { + iv$add_validator(iv_arm_ref) + } iv$add_rule("conf_level_coxph", shinyvalidate::sv_required("Please choose a hazard ratio confidence level")) iv$add_rule( From cddb97fe94b8066f50e17a1c0ff146ecbad39d54 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 22 Dec 2022 15:22:55 +0000 Subject: [PATCH 55/69] fix imports --- R/tm_a_gee.R | 14 +++++++------- R/tm_a_mmrm.R | 18 +++++++++--------- R/tm_g_barchart_simple.R | 10 +++++----- R/tm_g_ci.R | 12 ++++++------ R/tm_g_forest_rsp.R | 18 +++++++++--------- R/tm_g_forest_tte.R | 12 ++++++------ R/tm_g_ipp.R | 12 ++++++------ R/tm_g_km.R | 12 ++++++------ R/tm_g_lineplot.R | 12 ++++++------ R/tm_g_pp_adverse_events.R | 12 ++++++------ R/tm_g_pp_patient_timeline.R | 14 +++++++------- R/tm_g_pp_therapy.R | 12 ++++++------ R/tm_g_pp_vitals.R | 10 +++++----- R/tm_t_abnormality.R | 12 ++++++------ R/tm_t_abnormality_by_worst_grade.R | 12 ++++++------ R/tm_t_ancova.R | 14 +++++++------- R/tm_t_binary_outcome.R | 12 ++++++------ R/tm_t_coxreg.R | 16 ++++++++-------- R/tm_t_events.R | 12 ++++++------ R/tm_t_events_by_grade.R | 14 +++++++------- R/tm_t_events_patyear.R | 12 ++++++------ R/tm_t_events_summary.R | 12 ++++++------ R/tm_t_exposure.R | 12 ++++++------ R/tm_t_logistic.R | 12 ++++++------ R/tm_t_mult_events.R | 12 ++++++------ R/tm_t_pp_basic_info.R | 12 ++++++------ R/tm_t_pp_laboratory.R | 12 ++++++------ R/tm_t_pp_medical_history.R | 12 ++++++------ R/tm_t_pp_prior_medication.R | 12 ++++++------ R/tm_t_shift_by_arm.R | 12 ++++++------ R/tm_t_shift_by_arm_by_worst.R | 12 ++++++------ R/tm_t_shift_by_grade.R | 12 ++++++------ R/tm_t_smq.R | 12 ++++++------ R/tm_t_summary.R | 12 ++++++------ R/tm_t_summary_by.R | 12 ++++++------ R/tm_t_tte.R | 14 +++++++------- 36 files changed, 227 insertions(+), 227 deletions(-) diff --git a/R/tm_a_gee.R b/R/tm_a_gee.R index ef27db8a6d..3654ef120e 100644 --- a/R/tm_a_gee.R +++ b/R/tm_a_gee.R @@ -354,7 +354,7 @@ ui_gee <- function(id, ...) { selected = "t_gee_lsmeans" ) ), - forms = tagList( + forms = shny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -442,7 +442,7 @@ srv_gee <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level.")) iv$add_rule( @@ -471,7 +471,7 @@ srv_gee <- function(id, join_keys = get_join_keys(data) ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -501,7 +501,7 @@ srv_gee <- function(id, col_source <- merged$anl_input_r()$columns_source filter_info <- merged$anl_input_r()$filter_info - req(output_table) + shiny::req(output_table) basic_table_args$subtitles <- paste0( "Analysis Variable: ", col_source$aval_var, @@ -552,15 +552,15 @@ srv_gee <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(table_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(table_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(table_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(table_q()))) ) # Render R code teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(table_q())), + verbatim_content = shiny::reactive(teal.code::get_code(table_q())), title = label ) diff --git a/R/tm_a_mmrm.R b/R/tm_a_mmrm.R index f7a6dd5331..e633ef5cfb 100644 --- a/R/tm_a_mmrm.R +++ b/R/tm_a_mmrm.R @@ -803,7 +803,7 @@ ui_mmrm <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") ), @@ -909,11 +909,11 @@ srv_mmrm <- function(id, # selector_list includes cov_var as it is needed for validation rules # but it is not needed for the merge so it is removed here - selector_list_without_cov <- reactive({ + selector_list_without_cov <- shiny::reactive({ selector_list()[names(selector_list()) != "cov_var"] }) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_validator(arm_ref_comp_iv) iv$add_rule("conf_level", shinyvalidate::sv_required("'Confidence Level' field is not selected")) @@ -941,7 +941,7 @@ srv_mmrm <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ qenv <- teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) qenv2 <- teal.code::eval_code(qenv, as.expression(anl_inputs()$expr)) teal.code::eval_code(qenv2, as.expression(adsl_merge_inputs()$expr)) @@ -1399,7 +1399,7 @@ srv_mmrm <- function(id, all_q <- shiny::reactive({ if (!is.null(plot_q()) && !is.null(table_q())) { - join(plot_q(), table_q()) + teal.code::join(plot_q(), table_q()) } else if (!is.null(plot_q())) { plot_q() } else { @@ -1441,7 +1441,7 @@ srv_mmrm <- function(id, # Optimizer that was selected. output$optimizer_selected <- shiny::renderText({ # First reassign reactive sources: - req(iv_r()$is_valid()) + shiny::req(iv_r()$is_valid()) fit_stack <- try(mmrm_fit(), silent = TRUE) result <- if (!inherits(fit_stack, "try-error")) { fit <- fit_stack[["fit"]] @@ -1467,15 +1467,15 @@ srv_mmrm <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(disable_r_code() || is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(disable_r_code() || is.null(teal.code::get_warnings(all_q()))) ) # Show R code once button is pressed. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), disabled = disable_r_code, title = "R Code for the Current MMRM Analysis" ) diff --git a/R/tm_g_barchart_simple.R b/R/tm_g_barchart_simple.R index 30143d74f1..922151c4c3 100644 --- a/R/tm_g_barchart_simple.R +++ b/R/tm_g_barchart_simple.R @@ -300,7 +300,7 @@ ui_g_barchart_simple <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -364,7 +364,7 @@ srv_g_barchart_simple <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() teal.transform::compose_and_enable_validators(iv, selector_list) }) @@ -515,14 +515,14 @@ srv_g_barchart_simple <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = "Bar Chart" ) diff --git a/R/tm_g_ci.R b/R/tm_g_ci.R index 9cf6119c6c..4df7ba3d02 100644 --- a/R/tm_g_ci.R +++ b/R/tm_g_ci.R @@ -352,7 +352,7 @@ ui_g_ci <- function(id, ...) { # nolint selected = args$stat ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") ), @@ -389,7 +389,7 @@ srv_g_ci <- function(id, # nolint ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level")) iv$add_rule( @@ -405,7 +405,7 @@ srv_g_ci <- function(id, # nolint selector_list = selector_list ) - anl_q <- reactive( + anl_q <- shiny::reactive( teal.code::eval_code( object = teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)), code = as.expression(anl_inputs()$expr) @@ -465,14 +465,14 @@ srv_g_ci <- function(id, # nolint teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_g_forest_rsp.R b/R/tm_g_forest_rsp.R index ff6eacf375..ba6049f58c 100644 --- a/R/tm_g_forest_rsp.R +++ b/R/tm_g_forest_rsp.R @@ -446,7 +446,7 @@ ui_g_forest_rsp <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") ), @@ -505,7 +505,7 @@ srv_g_forest_rsp <- function(id, filter_validation_rule = list(paramcd = shinyvalidate::sv_required(message = "Please select Endpoint filter.")) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1")) iv$add_rule( @@ -531,7 +531,7 @@ srv_g_forest_rsp <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ q <- teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) qenv <- teal.code::eval_code(q, as.expression(anl_inputs()$expr)) teal.code::eval_code(qenv, as.expression(adsl_inputs()$expr)) @@ -543,7 +543,7 @@ srv_g_forest_rsp <- function(id, input[[extract_input("paramcd", paramcd$filter[[1]]$dataname, filter = TRUE)]] ), handlerExpr = { - req(anl_q()) + shiny::req(anl_q()) anl <- anl_q()[["ANL"]] aval_var <- anl_inputs()$columns_source$aval_var paramcd_level <- unlist(anl_inputs()$filter_info$paramcd[[1]]$selected) @@ -587,7 +587,7 @@ srv_g_forest_rsp <- function(id, # Prepare the analysis environment (filter data, check data, populate envir). validate_checks <- shiny::reactive({ teal::validate_inputs(iv_r()) - req(anl_q()) + shiny::req(anl_q()) qenv <- anl_q() adsl_filtered <- qenv[[parentname]] anl_filtered <- qenv[[dataname]] @@ -701,7 +701,7 @@ srv_g_forest_rsp <- function(id, teal.code::eval_code(qenv, as.expression(my_calls)) }) - plot_r <- reactive(all_q()[["p"]]) + plot_r <- shiny::reactive(all_q()[["p"]]) pws <- teal.widgets::plot_with_settings_srv( id = "myplot", @@ -712,14 +712,14 @@ srv_g_forest_rsp <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_g_forest_tte.R b/R/tm_g_forest_tte.R index 04ffa56b1b..4e7b58b81b 100644 --- a/R/tm_g_forest_tte.R +++ b/R/tm_g_forest_tte.R @@ -451,7 +451,7 @@ ui_g_forest_tte <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -513,7 +513,7 @@ srv_g_forest_tte <- function(id, filter_validation_rule = list(paramcd = shinyvalidate::sv_required(message = "Please select Endpoint filter.")) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level")) iv$add_rule( @@ -538,7 +538,7 @@ srv_g_forest_tte <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ q <- teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) qenv <- teal.code::eval_code(q, as.expression(anl_inputs()$expr)) teal.code::eval_code(qenv, as.expression(adsl_inputs()$expr)) @@ -648,14 +648,14 @@ srv_g_forest_tte <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = "R Code for the Current Time-to-Event Forest Plot" ) diff --git a/R/tm_g_ipp.R b/R/tm_g_ipp.R index f414e9faec..645470eddb 100644 --- a/R/tm_g_ipp.R +++ b/R/tm_g_ipp.R @@ -443,7 +443,7 @@ ui_g_ipp <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -498,7 +498,7 @@ srv_g_ipp <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() teal.transform::compose_and_enable_validators(iv, selector_list) }) @@ -517,7 +517,7 @@ srv_g_ipp <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ q <- teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) qenv <- teal.code::eval_code(q, as.expression(anl_inputs()$expr)) teal.code::eval_code(qenv, as.expression(adsl_inputs()$expr)) @@ -613,14 +613,14 @@ srv_g_ipp <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_g_km.R b/R/tm_g_km.R index c843851e64..8fc7f33f19 100644 --- a/R/tm_g_km.R +++ b/R/tm_g_km.R @@ -597,7 +597,7 @@ ui_g_km <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -666,7 +666,7 @@ srv_g_km <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() if (isTRUE(input$compare_arms)) { @@ -706,7 +706,7 @@ srv_g_km <- function(id, merge_function = "dplyr::inner_join" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::eval_code( teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)), code = as.expression(anl_inputs()$expr) @@ -811,14 +811,14 @@ srv_g_km <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_g_lineplot.R b/R/tm_g_lineplot.R index d6ef39894a..3b23ea0b8d 100644 --- a/R/tm_g_lineplot.R +++ b/R/tm_g_lineplot.R @@ -484,7 +484,7 @@ ui_g_lineplot <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -531,7 +531,7 @@ srv_g_lineplot <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level")) iv$add_rule( @@ -553,7 +553,7 @@ srv_g_lineplot <- function(id, merge_function = "dplyr::inner_join" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) }) @@ -634,14 +634,14 @@ srv_g_lineplot <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_g_pp_adverse_events.R b/R/tm_g_pp_adverse_events.R index 66b46329c4..3be70305f7 100644 --- a/R/tm_g_pp_adverse_events.R +++ b/R/tm_g_pp_adverse_events.R @@ -392,7 +392,7 @@ ui_g_adverse_events <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -478,7 +478,7 @@ srv_g_adverse_events <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient")) teal.transform::compose_and_enable_validators(iv, selector_list) @@ -490,7 +490,7 @@ srv_g_adverse_events <- function(id, join_keys = get_join_keys(data) ) - anl_q <- reactive( + anl_q <- shiny::reactive( teal.code::eval_code( teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)), as.expression(anl_inputs()$expr) ) @@ -550,14 +550,14 @@ srv_g_adverse_events <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_g_pp_patient_timeline.R b/R/tm_g_pp_patient_timeline.R index cfd7a6fe44..d1c30090b6 100644 --- a/R/tm_g_pp_patient_timeline.R +++ b/R/tm_g_pp_patient_timeline.R @@ -687,7 +687,7 @@ ui_g_patient_timeline <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -753,7 +753,7 @@ srv_g_patient_timeline <- function(id, # Patient timeline tab ---- - check_box <- reactive(input$relday_x_axis) + check_box <- shiny::reactive(input$relday_x_axis) check_relative <- function(main_param, return_name) { function(value) { @@ -795,7 +795,7 @@ srv_g_patient_timeline <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient")) teal.transform::compose_and_enable_validators(iv, selector_list) @@ -807,7 +807,7 @@ srv_g_patient_timeline <- function(id, selector_list = selector_list ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) }) @@ -921,14 +921,14 @@ srv_g_patient_timeline <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_g_pp_therapy.R b/R/tm_g_pp_therapy.R index e36f5248b8..81acc30b69 100644 --- a/R/tm_g_pp_therapy.R +++ b/R/tm_g_pp_therapy.R @@ -539,7 +539,7 @@ ui_g_therapy <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -622,7 +622,7 @@ srv_g_therapy <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient.")) teal.transform::compose_and_enable_validators(iv, selector_list) @@ -635,7 +635,7 @@ srv_g_therapy <- function(id, merge_function = "dplyr::left_join" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) }) @@ -706,14 +706,14 @@ srv_g_therapy <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_g_pp_vitals.R b/R/tm_g_pp_vitals.R index e8ddcb281c..88674a56a0 100644 --- a/R/tm_g_pp_vitals.R +++ b/R/tm_g_pp_vitals.R @@ -352,7 +352,7 @@ ui_g_vitals <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -445,7 +445,7 @@ srv_g_vitals <- function(id, merge_function = "dplyr::left_join" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) }) @@ -530,14 +530,14 @@ srv_g_vitals <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_abnormality.R b/R/tm_t_abnormality.R index 48f31ed22a..103954ad02 100644 --- a/R/tm_t_abnormality.R +++ b/R/tm_t_abnormality.R @@ -466,7 +466,7 @@ ui_t_abnormality <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -531,7 +531,7 @@ srv_t_abnormality <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("treatment_flag", shinyvalidate::sv_required( "Please select indicator value for on treatment records." @@ -553,7 +553,7 @@ srv_t_abnormality <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -634,15 +634,15 @@ srv_t_abnormality <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_abnormality_by_worst_grade.R b/R/tm_t_abnormality_by_worst_grade.R index d596f59f82..7bedfb5426 100644 --- a/R/tm_t_abnormality_by_worst_grade.R +++ b/R/tm_t_abnormality_by_worst_grade.R @@ -452,7 +452,7 @@ ui_t_abnormality_by_worst_grade <- function(id, ...) { # nolint ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -506,7 +506,7 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() teal.transform::compose_and_enable_validators(iv, selector_list) }) @@ -525,7 +525,7 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -626,15 +626,15 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_ancova.R b/R/tm_t_ancova.R index ada7a82a43..abedaac2be 100644 --- a/R/tm_t_ancova.R +++ b/R/tm_t_ancova.R @@ -525,7 +525,7 @@ tm_t_ancova <- function(label, args <- c(as.list(environment())) if (is.null(interact_var)) { - interact_var <- choices_selected( + interact_var <- teal.transform::choices_selected( choices = cov_var$choices, selected = NULL ) @@ -660,7 +660,7 @@ ui_ancova <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -725,7 +725,7 @@ srv_ancova <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level.")) iv$add_rule("conf_level", shinyvalidate::sv_between( @@ -750,7 +750,7 @@ srv_ancova <- function(id, join_keys = get_join_keys(data) ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -938,15 +938,15 @@ srv_ancova <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(table_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(table_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(table_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(table_q()))) ) # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(table_q())), + verbatim_content = shiny::reactive(teal.code::get_code(table_q())), title = label ) diff --git a/R/tm_t_binary_outcome.R b/R/tm_t_binary_outcome.R index 7651d10b70..2961096b09 100644 --- a/R/tm_t_binary_outcome.R +++ b/R/tm_t_binary_outcome.R @@ -710,7 +710,7 @@ ui_t_binary_outcome <- function(id, ...) { is_single_dataset = is_single_dataset_value ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -764,7 +764,7 @@ srv_t_binary_outcome <- function(id, filter_validation_rule = list(paramcd = shinyvalidate::sv_required(message = "Please select a filter.")) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() if (isTRUE(input$compare_arms)) { @@ -794,7 +794,7 @@ srv_t_binary_outcome <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ q <- teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) qenv <- teal.code::eval_code(q, as.expression(anl_inputs()$expr)) teal.code::eval_code(qenv, as.expression(adsl_inputs()$expr)) @@ -992,15 +992,15 @@ srv_t_binary_outcome <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(table_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(table_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(table_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(table_q()))) ) # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive({ + verbatim_content = shiny::reactive({ teal.code::get_code(table_q()) }), title = label diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index 6b30c374db..68bd8cc295 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -725,7 +725,7 @@ ui_t_coxreg <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -766,7 +766,7 @@ srv_t_coxreg <- function(id, module = "tm_t_coxreg" ) - use_interactions <- reactive({ + use_interactions <- shiny::reactive({ input$type == "Univariate" && !is.null(input$interactions) && input$interactions }) @@ -827,7 +827,7 @@ srv_t_coxreg <- function(id, } - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_validator(iv_arm_ref) iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level")) @@ -859,7 +859,7 @@ srv_t_coxreg <- function(id, merge_function = "dplyr::inner_join" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) }) @@ -881,7 +881,7 @@ srv_t_coxreg <- function(id, ) } - interaction_var_r <- reactive({ + interaction_var_r <- shiny::reactive({ # exclude cases when increments are not necessary and # finally accessing the UI-rendering function defined above. if (use_interactions()) { @@ -1111,14 +1111,14 @@ srv_t_coxreg <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = "R Code for the Current (Multi-variable) Cox proportional hazard regression model" ) diff --git a/R/tm_t_events.R b/R/tm_t_events.R index 88ce77c57d..f067ffcd1d 100644 --- a/R/tm_t_events.R +++ b/R/tm_t_events.R @@ -611,7 +611,7 @@ ui_t_events_byterm <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -655,7 +655,7 @@ srv_t_events_byterm <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("prune_freq", shinyvalidate::sv_required("Please provide an Incidence Rate between 0 and 100 (%).")) iv$add_rule( @@ -684,7 +684,7 @@ srv_t_events_byterm <- function(id, join_keys = get_join_keys(data) ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -774,15 +774,15 @@ srv_t_events_byterm <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(table_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(table_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(table_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(table_q()))) ) # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(table_q())), + verbatim_content = shiny::reactive(teal.code::get_code(table_q())), title = label ) diff --git a/R/tm_t_events_by_grade.R b/R/tm_t_events_by_grade.R index 2788b5f110..c1a3e4dee2 100644 --- a/R/tm_t_events_by_grade.R +++ b/R/tm_t_events_by_grade.R @@ -957,7 +957,7 @@ ui_t_events_by_grade <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -1007,11 +1007,11 @@ srv_t_events_by_grade <- function(id, ) ) - col_by_grade <- reactive({ + col_by_grade <- shiny::reactive({ input$col_by_grade }) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule( "prune_freq", shinyvalidate::sv_required("Please provide an Incidence Rate between 0 and 100 (%).") @@ -1044,7 +1044,7 @@ srv_t_events_by_grade <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -1167,15 +1167,15 @@ srv_t_events_by_grade <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(table_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(table_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(table_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(table_q()))) ) # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(table_q())), + verbatim_content = shiny::reactive(teal.code::get_code(table_q())), title = label ) diff --git a/R/tm_t_events_patyear.R b/R/tm_t_events_patyear.R index 75ba6017ec..7df56b2d87 100644 --- a/R/tm_t_events_patyear.R +++ b/R/tm_t_events_patyear.R @@ -358,7 +358,7 @@ ui_events_patyear <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -423,7 +423,7 @@ srv_events_patyear <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level")) iv$add_rule( @@ -453,7 +453,7 @@ srv_events_patyear <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -546,15 +546,15 @@ srv_events_patyear <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(table_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(table_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(table_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(table_q()))) ) # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(table_q())), + verbatim_content = shiny::reactive(teal.code::get_code(table_q())), title = label ) diff --git a/R/tm_t_events_summary.R b/R/tm_t_events_summary.R index d0165d4d34..da9fd9cce0 100644 --- a/R/tm_t_events_summary.R +++ b/R/tm_t_events_summary.R @@ -790,7 +790,7 @@ ui_t_events_summary <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -845,7 +845,7 @@ srv_t_events_summary <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() teal.transform::compose_and_enable_validators(iv, selector_list) }) @@ -864,7 +864,7 @@ srv_t_events_summary <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -984,14 +984,14 @@ srv_t_events_summary <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(table_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(table_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(table_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(table_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(table_q())), + verbatim_content = shiny::reactive(teal.code::get_code(table_q())), title = label ) diff --git a/R/tm_t_exposure.R b/R/tm_t_exposure.R index 253728a092..eb1eccfa7e 100644 --- a/R/tm_t_exposure.R +++ b/R/tm_t_exposure.R @@ -460,7 +460,7 @@ ui_t_exposure <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -530,7 +530,7 @@ srv_t_exposure <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() teal.transform::compose_and_enable_validators(iv, selector_list) }) @@ -549,7 +549,7 @@ srv_t_exposure <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -642,15 +642,15 @@ srv_t_exposure <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_logistic.R b/R/tm_t_logistic.R index 420c805b76..8508408f58 100644 --- a/R/tm_t_logistic.R +++ b/R/tm_t_logistic.R @@ -431,7 +431,7 @@ ui_t_logistic <- function(id, ...) { fixed = a$conf_level$fixed ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -490,7 +490,7 @@ srv_t_logistic <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("responders", shinyvalidate::sv_required("`Responders` field is empty")) iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level.")) @@ -536,7 +536,7 @@ srv_t_logistic <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -709,14 +709,14 @@ srv_t_logistic <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_mult_events.R b/R/tm_t_mult_events.R index 422f18831e..9fd7ada44d 100644 --- a/R/tm_t_mult_events.R +++ b/R/tm_t_mult_events.R @@ -429,7 +429,7 @@ ui_t_mult_events_byterm <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -472,7 +472,7 @@ srv_t_mult_events_byterm <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() teal.transform::compose_and_enable_validators(iv, selector_list, c("arm_var", "llt")) }) @@ -493,7 +493,7 @@ srv_t_mult_events_byterm <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ qenv <- teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) qenv2 <- teal.code::eval_code(qenv, as.expression(anl_merge_inputs()$expr)) teal.code::eval_code(qenv2, as.expression(adsl_merge_inputs()$expr)) @@ -575,15 +575,15 @@ srv_t_mult_events_byterm <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_pp_basic_info.R b/R/tm_t_pp_basic_info.R index 95708b3f1d..e4f316a343 100644 --- a/R/tm_t_pp_basic_info.R +++ b/R/tm_t_pp_basic_info.R @@ -143,7 +143,7 @@ ui_t_basic_info <- function(id, ...) { is_single_dataset = is_single_dataset_value ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -202,7 +202,7 @@ srv_t_basic_info <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient")) teal.transform::compose_and_enable_validators(iv, selector_list) @@ -215,7 +215,7 @@ srv_t_basic_info <- function(id, merge_function = "dplyr::left_join" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) }) @@ -250,14 +250,14 @@ srv_t_basic_info <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_pp_laboratory.R b/R/tm_t_pp_laboratory.R index a9e9aa97ea..8fe19fc9e2 100644 --- a/R/tm_t_pp_laboratory.R +++ b/R/tm_t_pp_laboratory.R @@ -276,7 +276,7 @@ ui_g_laboratory <- function(id, ...) { choices = NULL ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -364,7 +364,7 @@ srv_g_laboratory <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient")) teal.transform::compose_and_enable_validators(iv, selector_list) @@ -376,7 +376,7 @@ srv_g_laboratory <- function(id, selector_list = selector_list ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) }) @@ -425,14 +425,14 @@ srv_g_laboratory <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_pp_medical_history.R b/R/tm_t_pp_medical_history.R index 970ea118ed..ebc481ce1f 100644 --- a/R/tm_t_pp_medical_history.R +++ b/R/tm_t_pp_medical_history.R @@ -214,7 +214,7 @@ ui_t_medical_history <- function(id, ...) { is_single_dataset = is_single_dataset_value ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -276,7 +276,7 @@ srv_t_medical_history <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient")) teal.transform::compose_and_enable_validators(iv, selector_list) @@ -289,7 +289,7 @@ srv_t_medical_history <- function(id, merge_function = "dplyr::left_join" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) }) @@ -334,14 +334,14 @@ srv_t_medical_history <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_pp_prior_medication.R b/R/tm_t_pp_prior_medication.R index 03b885c1b1..8d4221c458 100644 --- a/R/tm_t_pp_prior_medication.R +++ b/R/tm_t_pp_prior_medication.R @@ -243,7 +243,7 @@ ui_t_prior_medication <- function(id, ...) { is_single_dataset = is_single_dataset_value ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -288,7 +288,7 @@ srv_t_prior_medication <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("patient_id", shinyvalidate::sv_required("Please select patient id")) teal.transform::compose_and_enable_validators(iv, selector_list) @@ -327,7 +327,7 @@ srv_t_prior_medication <- function(id, merge_function = "dplyr::left_join" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) }) @@ -366,14 +366,14 @@ srv_t_prior_medication <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_shift_by_arm.R b/R/tm_t_shift_by_arm.R index 6926f9b064..33c700e5d8 100644 --- a/R/tm_t_shift_by_arm.R +++ b/R/tm_t_shift_by_arm.R @@ -364,7 +364,7 @@ ui_shift_by_arm <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -416,7 +416,7 @@ srv_shift_by_arm <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule( "treatment_flag", @@ -439,7 +439,7 @@ srv_shift_by_arm <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -515,15 +515,15 @@ srv_shift_by_arm <- function(id, # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) ### REPORTER diff --git a/R/tm_t_shift_by_arm_by_worst.R b/R/tm_t_shift_by_arm_by_worst.R index 18e26c6634..ca1898d59f 100644 --- a/R/tm_t_shift_by_arm_by_worst.R +++ b/R/tm_t_shift_by_arm_by_worst.R @@ -387,7 +387,7 @@ ui_shift_by_arm_by_worst <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -439,7 +439,7 @@ srv_shift_by_arm_by_worst <- function(id, ) ) - iv_r <- reactive({ + iv_r <-shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule( "treatment_flag", @@ -462,7 +462,7 @@ srv_shift_by_arm_by_worst <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -552,15 +552,15 @@ srv_shift_by_arm_by_worst <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_shift_by_grade.R b/R/tm_t_shift_by_grade.R index 28fbf5416f..da0531d3d8 100644 --- a/R/tm_t_shift_by_grade.R +++ b/R/tm_t_shift_by_grade.R @@ -718,7 +718,7 @@ ui_t_shift_by_grade <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -775,7 +775,7 @@ srv_t_shift_by_grade <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("worst_flag_indicator", shinyvalidate::sv_required("Please select the value indicating worst grade.")) teal.transform::compose_and_enable_validators(iv, selector_list) @@ -795,7 +795,7 @@ srv_t_shift_by_grade <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -868,15 +868,15 @@ srv_t_shift_by_grade <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_smq.R b/R/tm_t_smq.R index 75b359cf3e..a8608dfbb4 100644 --- a/R/tm_t_smq.R +++ b/R/tm_t_smq.R @@ -509,7 +509,7 @@ ui_t_smq <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -557,7 +557,7 @@ srv_t_smq <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() teal.transform::compose_and_enable_validators(iv, selector_list) }) @@ -576,7 +576,7 @@ srv_t_smq <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -642,15 +642,15 @@ srv_t_smq <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_summary.R b/R/tm_t_summary.R index 1542f384fb..e5ac78b6b2 100644 --- a/R/tm_t_summary.R +++ b/R/tm_t_summary.R @@ -397,7 +397,7 @@ ui_summary <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -435,7 +435,7 @@ srv_summary <- function(id, ) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("numeric_stats", shinyvalidate::sv_required("Please select at least one statistic to display.")) teal.transform::compose_and_enable_validators(iv, selector_list) @@ -457,7 +457,7 @@ srv_summary <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -560,15 +560,15 @@ srv_summary <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_summary_by.R b/R/tm_t_summary_by.R index f4fb842c54..75c845dd9c 100644 --- a/R/tm_t_summary_by.R +++ b/R/tm_t_summary_by.R @@ -557,7 +557,7 @@ ui_summary_by <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -609,7 +609,7 @@ srv_summary_by <- function(id, filter_validation_rule = list(paramcd = shinyvalidate::sv_required(message = "Please select a filter.")) ) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("numeric_stats", shinyvalidate::sv_required("Please select at least one statistic to display.")) teal.transform::compose_and_enable_validators(iv, selector_list) @@ -630,7 +630,7 @@ srv_summary_by <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% teal.code::eval_code(as.expression(anl_inputs()$expr)) %>% teal.code::eval_code(as.expression(adsl_inputs()$expr)) @@ -710,15 +710,15 @@ srv_summary_by <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) diff --git a/R/tm_t_tte.R b/R/tm_t_tte.R index aa585baed3..c5e0656109 100644 --- a/R/tm_t_tte.R +++ b/R/tm_t_tte.R @@ -687,7 +687,7 @@ ui_t_tte <- function(id, ...) { ) ) ), - forms = tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), @@ -755,11 +755,11 @@ srv_t_tte <- function(id, ) output$helptext_ui <- renderUI({ - req(selector_list()$arm_var()$select) + shiny::req(selector_list()$arm_var()$select) shiny::helpText("Multiple reference groups are automatically combined into a single group.") }) - iv_r <- reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() if (isTRUE(input$compare_arms)) { @@ -801,7 +801,7 @@ srv_t_tte <- function(id, anl_name = "ANL_ADSL" ) - anl_q <- reactive({ + anl_q <- shiny::reactive({ qenv <- teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) qenv1 <- teal.code::eval_code(qenv, as.expression(anl_merge_inputs()$expr)) teal.code::eval_code(qenv1, as.expression(adsl_merge_inputs()$expr)) @@ -911,14 +911,14 @@ srv_t_tte <- function(id, teal.widgets::verbatim_popup_srv( id = "warning", - verbatim_content = reactive(teal.code::get_warnings(all_q())), + verbatim_content = shiny::reactive(teal.code::get_warnings(all_q())), title = "Warning", - disabled = reactive(is.null(teal.code::get_warnings(all_q()))) + disabled = shiny::reactive(is.null(teal.code::get_warnings(all_q()))) ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = shiny::reactive(teal.code::get_code(all_q())), title = label ) From d4582f47a38527e4672e0de127a169fc414c2305 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 22 Dec 2022 15:26:39 +0000 Subject: [PATCH 56/69] fix imports --- R/tm_a_gee.R | 2 +- R/tm_t_tte.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/tm_a_gee.R b/R/tm_a_gee.R index 3654ef120e..1c92d94215 100644 --- a/R/tm_a_gee.R +++ b/R/tm_a_gee.R @@ -354,7 +354,7 @@ ui_gee <- function(id, ...) { selected = "t_gee_lsmeans" ) ), - forms = shny::tagList( + forms = shiny::tagList( teal.widgets::verbatim_popup_ui(ns("warning"), button_label = "Show Warnings"), teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") ), diff --git a/R/tm_t_tte.R b/R/tm_t_tte.R index c5e0656109..6974e3b6a5 100644 --- a/R/tm_t_tte.R +++ b/R/tm_t_tte.R @@ -754,7 +754,7 @@ srv_t_tte <- function(id, ) ) - output$helptext_ui <- renderUI({ + output$helptext_ui <- shiny::renderUI({ shiny::req(selector_list()$arm_var()$select) shiny::helpText("Multiple reference groups are automatically combined into a single group.") }) From 16e745e531054db68e6275d15b2e4c5d396a1b74 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 22 Dec 2022 16:01:16 +0000 Subject: [PATCH 57/69] lintr --- R/tm_t_shift_by_arm_by_worst.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tm_t_shift_by_arm_by_worst.R b/R/tm_t_shift_by_arm_by_worst.R index ca1898d59f..5e18bde679 100644 --- a/R/tm_t_shift_by_arm_by_worst.R +++ b/R/tm_t_shift_by_arm_by_worst.R @@ -439,7 +439,7 @@ srv_shift_by_arm_by_worst <- function(id, ) ) - iv_r <-shiny::reactive({ + iv_r <- shiny::reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule( "treatment_flag", From 566a92d0f950abcc618219b821aba897b53e8570 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 22 Dec 2022 16:12:31 +0000 Subject: [PATCH 58/69] fix import --- R/tm_g_barchart_simple.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/tm_g_barchart_simple.R b/R/tm_g_barchart_simple.R index 922151c4c3..f09155b87f 100644 --- a/R/tm_g_barchart_simple.R +++ b/R/tm_g_barchart_simple.R @@ -432,6 +432,7 @@ srv_g_barchart_simple <- function(id, all_q <- shiny::reactive({ teal::validate_inputs(iv_r()) groupby_vars <- as.list(r_groupby_vars()) # so $ access works below + ANL <- count_q()[["ANL"]] qenv2 <- teal.code::eval_code(count_q(), substitute( env = list(groupby_vars = paste(groupby_vars, collapse = ", ")), From 35c46258d10206cad055c541f41b4294418ca88f Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 22 Dec 2022 16:18:46 +0000 Subject: [PATCH 59/69] linter --- R/tm_g_barchart_simple.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tm_g_barchart_simple.R b/R/tm_g_barchart_simple.R index f09155b87f..5d49db5e1e 100644 --- a/R/tm_g_barchart_simple.R +++ b/R/tm_g_barchart_simple.R @@ -432,7 +432,7 @@ srv_g_barchart_simple <- function(id, all_q <- shiny::reactive({ teal::validate_inputs(iv_r()) groupby_vars <- as.list(r_groupby_vars()) # so $ access works below - ANL <- count_q()[["ANL"]] + ANL <- count_q()[["ANL"]] # nolint qenv2 <- teal.code::eval_code(count_q(), substitute( env = list(groupby_vars = paste(groupby_vars, collapse = ", ")), From 5a9b14f4b693d7a29eb14530e789527168b097e0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dawid=20Ka=C5=82=C4=99dkowski?= Date: Tue, 3 Jan 2023 10:05:20 +0100 Subject: [PATCH 60/69] handle missing selectors --- R/tm_g_barchart_simple.R | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/R/tm_g_barchart_simple.R b/R/tm_g_barchart_simple.R index 5d49db5e1e..753c074f39 100644 --- a/R/tm_g_barchart_simple.R +++ b/R/tm_g_barchart_simple.R @@ -327,7 +327,10 @@ srv_g_barchart_simple <- function(id, shiny::moduleServer(id, function(input, output, session) { rule_dupl <- function(others) { function(value) { - othervals <- lapply(others, function(x) selector_list()[[x]]()$select) + othervals <- lapply( + Filter(Negate(is.null), selector_list()[others]), # some selectors could be ommited in tm_g_barchart_simple + function(x) x()$select + ) vars <- c(value, unlist(othervals)) dups <- unique(vars[duplicated(vars)]) if (value %in% dups) { @@ -461,10 +464,10 @@ srv_g_barchart_simple <- function(id, plot_call <- make_barchart_simple_call( y_name = get_n_name(groupby_vars), - x_name = groupby_vars$x_name, - fill_name = groupby_vars$fill_name, - x_facet_name = groupby_vars$x_facet_name, - y_facet_name = groupby_vars$y_facet_name, + x_name = groupby_vars$x, + fill_name = groupby_vars$fill, + x_facet_name = groupby_vars$x_facet, + y_facet_name = groupby_vars$y_facet, label_bars = input$label_bars, barlayout = input$barlayout, flip_axis = input$flip_axis, @@ -492,17 +495,15 @@ srv_g_barchart_simple <- function(id, # get grouping variables # NULL: not present in UI, vs character(0): no selection ## helper function - resolve_argument <- function(x) { - ans <- if (is.null(x)) NULL else selector_list()[[deparse(substitute(x))]]()$select - if (identical(ans, character(0L))) NULL else ans - } ## returns named vector of non-NULL variables to group by r_groupby_vars <- function() { - c( - x_name = resolve_argument(x), - fill_name = resolve_argument(fill), - x_facet_name = resolve_argument(x_facet), - y_facet_name = resolve_argument(y_facet) + unlist( + lapply( + selector_list(), + function(selector) { + if (is.null(selector)) character(0L) else selector()$select + } + ) ) } From b3da6f8acdda1ea6a9e6bb7b44a22f38ed99a4ce Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 3 Jan 2023 14:12:00 +0000 Subject: [PATCH 61/69] Update R/tm_g_km.R MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Dawid Kałędkowski <6959016+gogonzo@users.noreply.github.com> Signed-off-by: Nikolas Burkoff --- R/tm_g_km.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tm_g_km.R b/R/tm_g_km.R index 8fc7f33f19..bd32d9d737 100644 --- a/R/tm_g_km.R +++ b/R/tm_g_km.R @@ -690,7 +690,7 @@ srv_g_km <- function(id, function(value) { val <- as_numeric_from_comma_sep_str(value, sep = ";") if (anyNA(val) || any(val < 0)) { - "All break intervals for x-axis must be non-negative numbers" + "All break intervals for x-axis must be non-negative numbers separated by semicolons" } else if (all(val == 0)) { "At least one break interval for x-axis must be > 0" } From 270881a537b58d5019df9c023e628c3e8241270a Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 3 Jan 2023 14:12:14 +0000 Subject: [PATCH 62/69] Update R/tm_g_km.R MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Dawid Kałędkowski <6959016+gogonzo@users.noreply.github.com> Signed-off-by: Nikolas Burkoff --- R/tm_g_km.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/tm_g_km.R b/R/tm_g_km.R index bd32d9d737..f4ce8c93b6 100644 --- a/R/tm_g_km.R +++ b/R/tm_g_km.R @@ -764,8 +764,7 @@ srv_g_km <- function(id, input_xticks <- if (!is.null(input$xticks)) { as_numeric_from_comma_sep_str(input$xticks, sep = ";") - } else { - NULL + } } input_paramcd <- as.character(unique(anl[[as.vector(anl_m$columns_source$paramcd)]])) From ec596aa974f478579278e13cee523664fb8e0b51 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 3 Jan 2023 14:12:59 +0000 Subject: [PATCH 63/69] Update R/tm_t_coxreg.R MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Dawid Kałędkowski <6959016+gogonzo@users.noreply.github.com> Signed-off-by: Nikolas Burkoff --- R/tm_t_coxreg.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index 68bd8cc295..4c5c6bc8db 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -767,7 +767,7 @@ srv_t_coxreg <- function(id, ) use_interactions <- shiny::reactive({ - input$type == "Univariate" && !is.null(input$interactions) && input$interactions + input$type == "Univariate" && isTRUE(input$interactions) }) overlap_rule <- function(other_var, var_name) { From 9923bd8f43af1277e1ccfc32d39a51f6181d6c6b Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 3 Jan 2023 14:21:07 +0000 Subject: [PATCH 64/69] remove bracket --- R/tm_g_km.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/tm_g_km.R b/R/tm_g_km.R index f4ce8c93b6..da0c27d06c 100644 --- a/R/tm_g_km.R +++ b/R/tm_g_km.R @@ -765,7 +765,6 @@ srv_g_km <- function(id, input_xticks <- if (!is.null(input$xticks)) { as_numeric_from_comma_sep_str(input$xticks, sep = ";") } - } input_paramcd <- as.character(unique(anl[[as.vector(anl_m$columns_source$paramcd)]])) title <- paste("KM Plot of", input_paramcd) From 5937a6eaf8b2d1f771dcf1cdeb19c3079b6dd654 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Tue, 3 Jan 2023 14:37:52 +0000 Subject: [PATCH 65/69] Update R/tm_g_pp_vitals.R Signed-off-by: Nikolas Burkoff --- R/tm_g_pp_vitals.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/tm_g_pp_vitals.R b/R/tm_g_pp_vitals.R index 4998e06bf8..c03dcc5398 100644 --- a/R/tm_g_pp_vitals.R +++ b/R/tm_g_pp_vitals.R @@ -260,7 +260,6 @@ tm_g_pp_vitals <- function(label, checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(ggplot2_args, "ggplot2_args") checkmate::assert_multi_class(paramcd, c("choices_selected", "data_extract_spec"), null.ok = TRUE) - checkmate::assert_multi_class(param, c("choices_selected", "data_extract_spec"), null.ok = TRUE) checkmate::assert_multi_class(aval, c("choices_selected", "data_extract_spec"), null.ok = TRUE) checkmate::assert_multi_class(xaxis, c("choices_selected", "data_extract_spec"), null.ok = TRUE) From 9d8c2062c5392d434ecfa6fd94facfa9bd070a46 Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 5 Jan 2023 09:38:13 +0000 Subject: [PATCH 66/69] ancova fix --- R/tm_t_ancova.R | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/R/tm_t_ancova.R b/R/tm_t_ancova.R index abedaac2be..07778b0392 100644 --- a/R/tm_t_ancova.R +++ b/R/tm_t_ancova.R @@ -608,11 +608,7 @@ ui_ancova <- function(id, ...) { "when more than one value is selected." ) ), - shiny::conditionalPanel( - condition = "input['arm_var-dataset_ADSL_singleextract-select'].length != 0", - ns = ns, - shiny::helpText("Multiple reference groups are automatically combined into a single group.") - ), + shiny::uiOutput(ns("helptext_ui")), shiny::checkboxInput( ns("combine_comp_arms"), "Combine all comparison groups?", @@ -762,6 +758,12 @@ srv_ancova <- function(id, anl_q = anl_q ) + output$helptext_ui <- shiny::renderUI({ + if (length(selector_list()$arm_var()$select) != 0) { + shiny::helpText("Multiple reference groups are automatically combined into a single group.") + } + }) + # Event handler: # Update interact_y choices to all levels of selected interact_var shiny::observeEvent( From 1ae4998d26477b4271dd8719782f60b8c49e1d5a Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 5 Jan 2023 10:09:28 +0000 Subject: [PATCH 67/69] Update R/tm_g_lineplot.R Signed-off-by: Nikolas Burkoff --- R/tm_g_lineplot.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/tm_g_lineplot.R b/R/tm_g_lineplot.R index 3b23ea0b8d..c2c91bf2ce 100644 --- a/R/tm_g_lineplot.R +++ b/R/tm_g_lineplot.R @@ -522,8 +522,8 @@ srv_g_lineplot <- function(id, data_extract = list(x = x, y = y, strata = strata, paramcd = paramcd, y_unit = y_unit, param = param), datasets = data, select_validation_rule = list( - x = shinyvalidate::sv_required("Please select a single time variable"), - y = shinyvalidate::sv_required("Please select a single analysis variable"), + x = shinyvalidate::sv_required("Please select a time variable"), + y = shinyvalidate::sv_required("Please select an analysis variable"), strata = shinyvalidate::sv_required("Please select a treatment variable") ), filter_validation_rule = list( From fe986d4a9bc7f9bbe6682bd4cf3929a8f916dd33 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> Date: Thu, 5 Jan 2023 11:53:48 +0100 Subject: [PATCH 68/69] Update R/tm_g_barchart_simple.R remove obsolete comment Signed-off-by: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> --- R/tm_g_barchart_simple.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/tm_g_barchart_simple.R b/R/tm_g_barchart_simple.R index 753c074f39..3d4182f420 100644 --- a/R/tm_g_barchart_simple.R +++ b/R/tm_g_barchart_simple.R @@ -494,7 +494,6 @@ srv_g_barchart_simple <- function(id, # get grouping variables # NULL: not present in UI, vs character(0): no selection - ## helper function ## returns named vector of non-NULL variables to group by r_groupby_vars <- function() { unlist( From 6ea9f9949e1639692b416fb40b7caf1264ac732f Mon Sep 17 00:00:00 2001 From: Nikolas Burkoff Date: Thu, 5 Jan 2023 10:57:38 +0000 Subject: [PATCH 69/69] barchart simple revert --- R/tm_g_barchart_simple.R | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/R/tm_g_barchart_simple.R b/R/tm_g_barchart_simple.R index 3d4182f420..3a9329b450 100644 --- a/R/tm_g_barchart_simple.R +++ b/R/tm_g_barchart_simple.R @@ -496,14 +496,21 @@ srv_g_barchart_simple <- function(id, # NULL: not present in UI, vs character(0): no selection ## returns named vector of non-NULL variables to group by r_groupby_vars <- function() { - unlist( - lapply( - selector_list(), - function(selector) { - if (is.null(selector)) character(0L) else selector()$select - } - ) - ) + x_name <- if (is.null(x)) NULL else as.vector(anl_inputs()$columns_source$x) + fill_name <- if (is.null(fill)) NULL else as.vector(anl_inputs()$columns_source$fill) + x_facet_name <- if (is.null(x_facet)) NULL else as.vector(anl_inputs()$columns_source$x_facet) + y_facet_name <- if (is.null(y_facet)) NULL else as.vector(anl_inputs()$columns_source$y_facet) + + # set to NULL when empty character + if (identical(x_name, character(0))) x_name <- NULL + if (identical(fill_name, character(0))) fill_name <- NULL + if (identical(x_facet_name, character(0))) x_facet_name <- NULL + if (identical(y_facet_name, character(0))) y_facet_name <- NULL + + c( + x_name = x_name, fill_name = fill_name, + x_facet_name = x_facet_name, y_facet_name = y_facet_name + ) # c() -> NULL entries are omitted } # Insert the plot into a plot with settings module from teal.widgets