tmc shinyvalidate

DESCRIPTION

@@ -48,6 +48,7 @@ Imports:
     scales,
     shiny,
     shinyjs,
+    shinyvalidate,
     shinyWidgets,
     stats,
     styler,
@@ -89,4 +90,4 @@ Encoding: UTF-8
 Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.2

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 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. 

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
-#' ds <- teal:::get_dummy_datasets()
 #'
 #' 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",
-#'           datasets = ds,
-#'           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

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(
@@ -377,10 +377,30 @@ 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 analysis 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")
+      )
+      teal.transform::compose_and_enable_validators(iv, selector_list, c("x_var", "y_var"))
+    })
+
+    anl_inputs <- teal.transform::merge_expression_srv(
+      datasets = data,
+      join_keys = get_join_keys(data),
+      selector_list = selector_list
     )
 
     anl_q <- reactive(
@@ -390,33 +410,21 @@ 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
 
+      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)) {

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
     })
 

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]]