add shinyvalidate to tmg

DESCRIPTION

@@ -32,6 +32,7 @@ Imports:
     magrittr,
     scales,
     shinyjs,
+    shinyvalidate,
     shinyWidgets,
     stats,
     stringr,
@@ -88,4 +89,4 @@ Encoding: UTF-8
 Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3

NEWS.md

@@ -12,6 +12,7 @@
 * Added `parent_dataname` argument to `tm_variable_browser` and `tm_missing_data` to allow specification of parent dataset for these modules.
 * Improved UI labels and plot panel title in `tm_g_association`.
 * Added inputs `tm_variable_browser` module for text size and plot theme.
+* Updated encodings input checks to use `shinyvalidate::InputValidator` instead of `shiny::validate` for better UI experience.   
 
 ### Bug fixes
 * Fixed a bug in `tm_g_scatterplot` when selected x and y facets were the same.

R/tm_data_table.R

@@ -251,16 +251,18 @@ srv_data_table <- function(id,
                            server_rendering) {
   moduleServer(id, function(input, output, session) {
     output$data_table <- DT::renderDataTable(server = server_rendering, {
-      variables <- input$variables
+      df <- data[[dataname]]()
 
-      validate(need(variables, "need valid variable names"))
+      iv <- shinyvalidate::InputValidator$new()
+      iv$add_rule("variables", shinyvalidate::sv_required("Please select valid variable names"))
+      iv$add_rule("variables", ~ if (!all((.) %in% names(df))) "Not all selected variables exist in the data")
+      iv$enable()
+      validate_inputs(iv)
 
-      df <- data[[dataname]]()
+      variables <- input$variables
 
       validate(need(df, paste("data", dataname, "is empty")))
 
-      validate(need(all(variables %in% names(df)), "not all selected variables exist"))
-
       dataframe_selected <- if (if_distinct()) {
         dplyr::count(df, dplyr::across(tidyselect::all_of(variables)))
       } else {

R/tm_g_association.R

@@ -222,11 +222,31 @@ srv_tm_g_association <- function(id,
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
   checkmate::assert_class(data, "tdata")
   moduleServer(id, function(input, output, session) {
+    overlap_vars <- function(value) {
+      if (length(selector_list()$ref()$select) != 0 &&
+        selector_list()$ref()$select %in% selector_list()$vars()$select) {
+        "Associated variables and reference variable cannot overlap"
+      }
+    }
     selector_list <- teal.transform::data_extract_multiple_srv(
       data_extract = list(ref = ref, vars = vars),
-      datasets = data
+      datasets = data,
+      select_validation_rule = list(
+        ref = shinyvalidate::compose_rules(
+          shinyvalidate::sv_required("At least one reference variable needs to be selected."),
+          overlap_vars
+        ),
+        vars = overlap_vars
+      )
     )
 
+    iv_r <- reactive({
+      iv <- shinyvalidate::InputValidator$new()
+      iv$add_rule("distribution_theme", shinyvalidate::sv_required("Please select a theme"))
+      iv$add_rule("association_theme", shinyvalidate::sv_required("Please select a theme"))
+      teal.transform::compose_and_enable_validators(iv, selector_list)
+    })
+
     anl_merged_input <- teal.transform::merge_expression_srv(
       datasets = data,
       selector_list = selector_list,
@@ -245,12 +265,7 @@ srv_tm_g_association <- function(id,
     )
 
     output_q <- reactive({
-      validate({
-        need(
-          !is.null(selector_list()$ref()) && !is.null(selector_list()$vars()),
-          "Please select reference and associated variables"
-        )
-      })
+      teal::validate_inputs(iv_r())
 
       ANL <- merged$anl_q_r()[["ANL"]] # nolint
       teal::validate_has_data(ANL, 3)
@@ -266,8 +281,7 @@ srv_tm_g_association <- function(id,
       distribution_theme <- input$distribution_theme
       association_theme <- input$association_theme
 
-      validate(need(ref_name, "need at least one variable selected"))
-
+      req(ref_name)
       is_scatterplot <- is.numeric(ANL[[ref_name]]) && any(vapply(ANL[vars_names], is.numeric, logical(1)))
       if (is_scatterplot) {
         shinyjs::show("alpha")
@@ -281,9 +295,6 @@ srv_tm_g_association <- function(id,
         size <- 2
       }
 
-      validate(need(!(ref_name %in% vars_names), "associated variables and reference variable cannot overlap"))
-      validate(need(!is.null(distribution_theme) && !is.null(association_theme), "Please select a theme."))
-
       teal::validate_has_data(ANL[, c(ref_name, vars_names)], 3, complete = TRUE, allow_inf = FALSE)
 
       # reference
@@ -417,7 +428,10 @@ srv_tm_g_association <- function(id,
         )
     })
 
-    plot_r <- shiny::reactive(output_q()[["p"]])
+    plot_r <- shiny::reactive({
+      shiny::req(iv_r()$is_valid())
+      output_q()[["p"]]
+    })
 
     pws <- teal.widgets::plot_with_settings_srv(
       id = "myplot",

R/tm_g_bivariate.R

@@ -363,7 +363,26 @@ srv_g_bivariate <- function(id,
       color = color, fill = fill, size = size
     )
 
-    selector_list <- teal.transform::data_extract_multiple_srv(data_extract, data)
+    x_y_selection <- function(value) {
+      if (length(selector_list()$x()$select) == 0 && length(selector_list()$y()$select) == 0) {
+        "Please select at least one of x-variable or y-variable"
+      }
+    }
+
+    selector_list <- teal.transform::data_extract_multiple_srv(
+      data_extract = data_extract,
+      datasets = data,
+      select_validation_rule = list(
+        x = x_y_selection,
+        y = x_y_selection
+      )
+    )
+
+    iv_r <- reactive({
+      iv <- shinyvalidate::InputValidator$new()
+      iv$add_rule("ggtheme", shinyvalidate::sv_required("Please select a theme"))
+      teal.transform::compose_and_enable_validators(iv, selector_list)
+    })
 
     anl_merged_input <- teal.transform::merge_expression_srv(
       selector_list = selector_list,
@@ -383,12 +402,7 @@ srv_g_bivariate <- function(id,
     )
 
     output_q <- reactive({
-      validate({
-        need(
-          length(merged$anl_input_r()$columns_source$x) > 0 || length(merged$anl_input_r()$columns_source$y) > 0,
-          "x-variable and y-variable aren't correctly specified. At least one should be valid."
-        )
-      })
+      teal::validate_inputs(iv_r())
 
       ANL <- merged$anl_q_r()[["ANL"]] # nolint
       teal::validate_has_data(ANL, 3)
@@ -450,7 +464,6 @@ srv_g_bivariate <- function(id,
 
 
       teal::validate_has_data(ANL[, c(x_name, y_name)], 3, complete = TRUE, allow_inf = FALSE)
-      validate(need(!is.null(ggtheme), "Please select a theme."))
 
       cl <- bivariate_plot_call(
         data_name = "ANL",

R/tm_g_response.R

@@ -234,7 +234,20 @@ srv_g_response <- function(id,
   moduleServer(id, function(input, output, session) {
     data_extract <- list(response = response, x = x, row_facet = row_facet, col_facet = col_facet)
 
-    selector_list <- teal.transform::data_extract_multiple_srv(data_extract, data)
+    selector_list <- teal.transform::data_extract_multiple_srv(
+      data_extract = data_extract,
+      datasets = data,
+      select_validation_rule = list(
+        response = shinyvalidate::sv_required("Please define a column for the response variable"),
+        x = shinyvalidate::sv_required("Please define a column for X variable")
+      )
+    )
+
+    iv_r <- reactive({
+      iv <- shinyvalidate::InputValidator$new()
+      iv$add_rule("ggtheme", shinyvalidate::sv_required("Please select a theme"))
+      teal.transform::compose_and_enable_validators(iv, selector_list)
+    })
 
     anl_merged_input <- teal.transform::merge_expression_srv(
       selector_list = selector_list,
@@ -254,15 +267,13 @@ srv_g_response <- function(id,
     )
 
     output_q <- reactive({
+      teal::validate_inputs(iv_r())
+
       qenv <- merged$anl_q_r()
       ANL <- qenv[["ANL"]] # nolint
       resp_var <- as.vector(merged$anl_input_r()$columns_source$response)
       x <- as.vector(merged$anl_input_r()$columns_source$x)
 
-      validate(need(!identical(resp_var, character(0)), "Please define a valid column for the response variable"))
-      validate(need(!identical(x, character(0)), "Please define a valid column for the X-variable"))
-      validate(need(length(resp_var) == 1, "Please define a column for Response variable"))
-      validate(need(length(x) == 1, "Please define a column for X variable"))
       validate(need(is.factor(ANL[[resp_var]]), "Please select a factor variable as the response."))
       validate(need(is.factor(ANL[[x]]), "Please select a factor variable as the X-Variable."))
       teal::validate_has_data(ANL, 10)
@@ -285,8 +296,6 @@ srv_g_response <- function(id,
       rotate_xaxis_labels <- input$rotate_xaxis_labels
       ggtheme <- input$ggtheme
 
-      validate(need(!is.null(ggtheme), "Please select a theme."))
-
       arg_position <- if (freq) "stack" else "fill" # nolint
 
       rowf <- if (length(row_facet_name) == 0) NULL else as.name(row_facet_name) # nolint

R/tm_g_scatterplot.R

@@ -391,7 +391,38 @@ srv_g_scatterplot <- function(id,
     data_extract <- list(
       x = x, y = y, color_by = color_by, size_by = size_by, row_facet = row_facet, col_facet = col_facet
     )
-    selector_list <- teal.transform::data_extract_multiple_srv(data_extract, data)
+    selector_list <- teal.transform::data_extract_multiple_srv(
+      data_extract = data_extract,
+      datasets = data,
+      select_validation_rule = list(
+        x = ~ if (length(.) != 1) "Please select exactly one x var.",
+        y = ~ if (length(.) != 1) "Please select exactly one y var.",
+        color_by = ~ if (length(.) > 1) "There must be 1 or no color variable.",
+        size_by = ~ if (length(.) > 1) "There must be 1 or no size variable.",
+        row_facet = shinyvalidate::compose_rules(
+          ~ if (length(.) > 1) "There must be 1 or no column facetting variable.",
+          ~ if (length(.) == 1 &&
+            length(selector_list()$col_facet()$select) == 1 &&
+            (.) == selector_list()$col_facet()$select) {
+            "Row and column facetting variables must be different."
+          }
+        ),
+        col_facet = shinyvalidate::compose_rules(
+          ~ if (length(.) > 1) "There must be 1 or no row facetting variable.",
+          ~ if (length(.) == 1 &&
+            length(selector_list()$row_facet()$select) == 1 &&
+            (.) == selector_list()$row_facet()$select) {
+            "Row and column facetting variables must be different."
+          }
+        )
+      )
+    )
+
+    iv_r <- reactive({
+      iv <- shinyvalidate::InputValidator$new()
+      iv$add_rule("ggtheme", shinyvalidate::sv_required("Please select a theme"))
+      teal.transform::compose_and_enable_validators(iv, selector_list)
+    })
 
     anl_merged_input <- teal.transform::merge_expression_srv(
       selector_list = selector_list,
@@ -462,6 +493,8 @@ srv_g_scatterplot <- function(id,
     )
 
     output_q <- reactive({
+      teal::validate_inputs(iv_r())
+
       ANL <- merged$anl_q_r()[["ANL"]] # nolint
 
       x_var <- as.vector(merged$anl_input_r()$columns_source$x)
@@ -492,16 +525,6 @@ srv_g_scatterplot <- function(id,
       log_x <- input$log_x
       log_y <- input$log_y
 
-      validate(need(!is.null(ggtheme), "Please select a theme."))
-      validate(need(length(x_var) == 1, "There must be exactly one x var."))
-      validate(need(length(y_var) == 1, "There must be exactly one y var."))
-      validate(need(is.null(color_by_var) || length(color_by_var) <= 1, "There must be 1 or no color variable."))
-      validate(need(is.null(size_by_var) || length(size_by_var) <= 1, "There must be 1 or no size variable."))
-      validate(need(length(row_facet_name) <= 1, "There must be 1 or no row facetting variable."))
-      validate(need(length(col_facet_name) <= 1, "There must be 1 or no column facetting variable."))
-      if (length(row_facet_name) * length(col_facet_name) > 0) {
-        validate(need(row_facet_name != col_facet_name, "Row and column facetting variables must be different."))
-      }
       validate(need(
         length(row_facet_name) == 0 || inherits(ANL[[row_facet_name]], c("character", "factor", "Date", "integer")),
         "`Row facetting` variable must be of class `character`, `factor`, `Date`, or `integer`"

R/tm_g_scatterplotmatrix.R

@@ -166,9 +166,17 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab
   moduleServer(id, function(input, output, session) {
     selector_list <- teal.transform::data_extract_multiple_srv(
       data_extract = list(variables = variables),
-      datasets = data
+      datasets = data,
+      select_validation_rule = list(
+        variables = ~ if (length(.) <= 1) "Please select at least 2 columns."
+      )
     )
 
+    iv_r <- reactive({
+      iv <- shinyvalidate::InputValidator$new()
+      teal.transform::compose_and_enable_validators(iv, selector_list)
+    })
+
     anl_merged_input <- teal.transform::merge_expression_srv(
       datasets = data,
       join_keys = get_join_keys(data),
@@ -188,6 +196,8 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab
 
     # plot
     output_q <- reactive({
+      teal::validate_inputs(iv_r())
+
       qenv <- merged$anl_q_r()
       ANL <- qenv[["ANL"]] # nolint
 
@@ -204,7 +214,6 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab
         "na.fail"
       }
 
-      validate(need(length(cols_names) > 1, "Need at least 2 columns."))
       teal::validate_has_data(ANL, 10)
       teal::validate_has_data(ANL[, cols_names], 10, complete = TRUE, allow_inf = FALSE)