tmc shinyvalidate

DESCRIPTION

@@ -48,6 +48,7 @@ Imports:
     scales,
     shiny,
     shinyjs,
+    shinyvalidate,
     shinyWidgets,
     stats,
     styler,

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/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_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(