Refactor slider state management (#322)

Closes #321 Changes: 1. The `toggle_slider_ui` and `toggle_slider_server` can only be used to create dichotomous slider now. There was no instance of single value slider created. So, there is no need to create it and increase the complexity. 2. Removal of the `keep_range_slider_updated` in favor of `keep_slider_state_updated` to keep the states updated based on other widget inputs. 3. Updated the modules that uses this widget. Note that the `tm_g_gh_lineplot` does not use the `keep_slider_state_updated` and directly updates the state reactiveValues. Check all the modules that use the `toggle_slider` module: - [ ] `tm_g_gh_boxplot` - [ ] `tm_g_gh_correlationplot` - [ ] `tm_g_gh_density_distribution_plot` - [ ] `tm_g_gh_lineplot` - [ ] `tm_g_gh_spaghettiplot` - [ ] `tm_g_gh_scatterplot `(deprecate in favor of `tm_g_gh_correlationplot`) --------- Co-authored-by: go_gonzo <[email protected]>
insightsengineering · Oct 28, 2024 · 665019c · 665019c
1 parent 05befbf
commit 665019c
Show file tree

Hide file tree

Showing 16 changed files with 539 additions and 489 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -78,3 +78,4 @@ Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
+Config/testthat/edition: 3
diff --git a/R/tm_g_gh_boxplot.R b/R/tm_g_gh_boxplot.R
@@ -263,10 +263,7 @@ ui_g_boxplot <- function(id, ...) {
           title = "Plot Aesthetic Settings",
           toggle_slider_ui(
             ns("yrange_scale"),
-            label = "Y-Axis Range Zoom",
-            min = -1000000,
-            max = 1000000,
-            value = c(-1000000, 1000000)
+            label = "Y-Axis Range Zoom"
           ),
           numericInput(ns("facet_ncol"), "Number of Plots Per Row:", a$facet_ncol, min = 1),
           checkboxInput(ns("loq_legend"), "Display LoQ Legend", a$loq_legend),
@@ -342,15 +339,14 @@ srv_g_boxplot <- function(id,
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    yrange_slider <- toggle_slider_server("yrange_scale")
-    keep_range_slider_updated(
-      session,
-      input,
-      update_slider_fcn = yrange_slider$update_state,
-      id_var = "yaxis_var",
-      id_param_var = "xaxis_param",
-      reactive_ANL = anl_q
-    )
+    data_state <- reactive({
+      get_data_range_states(
+        varname = input$yaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_q()$ANL
+      )
+    })
+    yrange_slider_state <- toggle_slider_server("yrange_scale", data_state)
     keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
 
     horizontal_line <- srv_arbitrary_lines("hline_arb")
@@ -395,7 +391,7 @@ srv_g_boxplot <- function(id,
       yaxis <- input$yaxis_var
       xaxis <- input$xaxis_var
       facet_var <- `if`(is.null(input$facet_var), "None", input$facet_var)
-      ylim <- yrange_slider$state()$value
+      ylim <- yrange_slider_state$value
       facet_ncol <- input$facet_ncol
 
       alpha <- input$alpha

diff --git a/R/tm_g_gh_correlationplot.R b/R/tm_g_gh_correlationplot.R
@@ -315,13 +315,11 @@ ui_g_correlationplot <- function(id, ...) {
           title = "Plot Aesthetic Settings",
           toggle_slider_ui(
             ns("xrange_scale"),
-            label = "X-Axis Range Zoom",
-            min = -1000000, max = 1000000, value = c(-1000000, 1000000)
+            label = "X-Axis Range Zoom"
           ),
           toggle_slider_ui(
             ns("yrange_scale"),
-            label = "Y-Axis Range Zoom",
-            min = -1000000, max = 1000000, value = c(-1000000, 1000000)
+            label = "Y-Axis Range Zoom"
           ),
           numericInput(ns("facet_ncol"), "Number of Plots Per Row:", a$facet_ncol, min = 1),
           checkboxInput(ns("trt_facet"), "Treatment Variable Faceting", a$trt_facet),
@@ -599,10 +597,23 @@ srv_g_correlationplot <- function(id,
     anl_constraint <- anl_constraint_output()$value
 
     # update sliders for axes taking constraints into account
-    xrange_slider <- toggle_slider_server("xrange_scale")
-    yrange_slider <- toggle_slider_server("yrange_scale")
-    keep_range_slider_updated(session, input, xrange_slider$update_state, "xaxis_var", "xaxis_param", anl_constraint)
-    keep_range_slider_updated(session, input, yrange_slider$update_state, "yaxis_var", "yaxis_param", anl_constraint)
+    data_state_x <- reactive({
+      get_data_range_states(
+        varname = input$xaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_constraint()$ANL
+      )
+    })
+    xrange_slider <- toggle_slider_server("xrange_scale", data_state_x)
+    data_state_y <- reactive({
+      get_data_range_states(
+        varname = input$yaxis_var,
+        paramname = input$yaxis_param,
+        ANL = anl_constraint()$ANL
+      )
+    })
+    yrange_slider <- toggle_slider_server("yrange_scale", data_state_y)
+
     keep_data_const_opts_updated(session, input, anl_constraint, "xaxis_param")
 
     # selector names after transposition
@@ -725,8 +736,8 @@ srv_g_correlationplot <- function(id,
       xaxis_var <- input$xaxis_var
       yaxis_param <- input$yaxis_param
       yaxis_var <- input$yaxis_var
-      xlim <- xrange_slider$state()$value
-      ylim <- yrange_slider$state()$value
+      xlim <- xrange_slider$value
+      ylim <- yrange_slider$value
       font_size <- input$font_size
       dot_size <- input$dot_size
       reg_text_size <- input$reg_text_size

diff --git a/R/tm_g_gh_density_distribution_plot.R b/R/tm_g_gh_density_distribution_plot.R
@@ -203,17 +203,11 @@ ui_g_density_distribution_plot <- function(id, ...) {
           title = "Plot Aesthetic Settings",
           toggle_slider_ui(
             ns("xrange_scale"),
-            label = "X-Axis Range Zoom",
-            min = -1000000,
-            max = 1000000,
-            value = c(-1000000, 1000000)
+            label = "X-Axis Range Zoom"
           ),
           toggle_slider_ui(
             ns("yrange_scale"),
-            label = "Y-Axis Range Zoom",
-            min = -1000000,
-            max = 1000000,
-            value = c(-1000000, 1000000)
+            label = "Y-Axis Range Zoom"
           ),
           numericInput(ns("facet_ncol"), "Number of Plots Per Row:", a$facet_ncol, min = 1),
           checkboxInput(ns("comb_line"), "Display Combined line", a$comb_line),
@@ -287,19 +281,24 @@ srv_g_density_distribution_plot <- function(id, # nolint
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    xrange_slider <- toggle_slider_server("xrange_scale")
-    yrange_slider <- toggle_slider_server("yrange_scale")
-    keep_range_slider_updated(session, input, xrange_slider$update_state, "xaxis_var", "xaxis_param", anl_q)
-    keep_range_slider_updated(
-      session,
-      input,
-      yrange_slider$update_state,
-      "xaxis_var",
-      "xaxis_param",
-      anl_q,
-      is_density = TRUE,
-      "trt_group"
-    )
+    data_state_x <- reactive({
+      get_data_range_states(
+        varname = input$xaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_q()$ANL
+      )
+    })
+    xrange_slider <- toggle_slider_server("xrange_scale", data_state_x)
+    data_state_y <- reactive({
+      get_data_range_states(
+        varname = input$xaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_q()$ANL,
+        trt_group = "trt_group"
+      )
+    })
+    yrange_slider <- toggle_slider_server("yrange_scale", data_state_y)
+
     keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
 
     horizontal_line <- srv_arbitrary_lines("hline_arb")
@@ -326,8 +325,8 @@ srv_g_density_distribution_plot <- function(id, # nolint
       # nolint start
       param <- input$xaxis_param
       xaxis_var <- input$xaxis_var
-      xlim <- xrange_slider$state()$value
-      ylim <- yrange_slider$state()$value
+      xlim <- xrange_slider$value
+      ylim <- yrange_slider$value
       font_size <- input$font_size
       line_size <- input$line_size
       hline_arb <- horizontal_line()$line_arb

diff --git a/R/tm_g_gh_lineplot.R b/R/tm_g_gh_lineplot.R
@@ -271,10 +271,7 @@ ui_lineplot <- function(id, ...) {
             title = "Plot Aesthetic Settings",
             toggle_slider_ui(
               ns("yrange_scale"),
-              label = "Y-Axis Range Zoom",
-              min = -1000000,
-              max = 1000000,
-              value = c(-1000000, 1000000)
+              label = "Y-Axis Range Zoom"
             ),
             checkboxInput(ns("rotate_xlab"), "Rotate X-axis Label", a$rotate_xlab),
             numericInput(ns("count_threshold"), "Contributing Observations Threshold:", a$count_threshold)
@@ -404,8 +401,6 @@ srv_lineplot <- function(id,
 
     keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
 
-    yrange_slider <- toggle_slider_server("yrange_scale")
-
     horizontal_line <- srv_arbitrary_lines("hline_arb")
 
     iv_r <- reactive({
@@ -423,7 +418,7 @@ srv_lineplot <- function(id,
 
 
     # update sliders for axes
-    observe({
+    data_state <- reactive({
       varname <- input[["yaxis_var"]]
       validate(need(varname, "Please select variable"))
 
@@ -436,7 +431,7 @@ srv_lineplot <- function(id,
         NULL
       }
 
-      # we don't need to additionally filter for paramvar here as in keep_range_slider_updated because
+      # we don't need to additionally filter for paramvar here as in get_data_range_states because
       # xaxis_var and yaxis_var are always distinct
       sum_data <- ANL %>%
         dplyr::group_by_at(c(input$xaxis_var, input$trt_group, shape)) %>%
@@ -463,15 +458,14 @@ srv_lineplot <- function(id,
         f = 0.05
       )
 
-      # we don't use keep_range_slider_updated because this module computes the min, max
+      # we don't use get_data_range_states because this module computes the data ranges
       # not from the constrained ANL, but rather by first grouping and computing confidence
       # intervals
-      isolate(yrange_slider$update_state(
-        min = minmax[[1]],
-        max = minmax[[2]],
-        value = minmax
-      ))
+      list(
+        range = c(min = minmax[[1]], max = minmax[[2]])
+      )
     })
+    yrange_slider <- toggle_slider_server("yrange_scale", data_state)
 
     line_color_defaults <- color_manual
     line_type_defaults <- c(
@@ -667,7 +661,7 @@ srv_lineplot <- function(id,
       teal::validate_inputs(iv_r())
       req(anl_q(), line_color_selected(), line_type_selected())
       # nolint start
-      ylim <- yrange_slider$state()$value
+      ylim <- yrange_slider$value
       plot_font_size <- input$plot_font_size
       dot_size <- input$dot_size
       dodge <- input$dodge

diff --git a/R/tm_g_gh_scatterplot.R b/R/tm_g_gh_scatterplot.R
@@ -200,17 +200,13 @@ ui_g_scatterplot <- function(id, ...) {
       teal.widgets::panel_group(
         teal.widgets::panel_item(
           title = "Plot Aesthetic Settings",
-          toggle_slider_ui(ns("xrange_scale"),
-            label = "X-Axis Range Zoom",
-            min = -1000000,
-            max = 1000000,
-            value = c(-1000000, 1000000)
+          toggle_slider_ui(
+            ns("xrange_scale"),
+            label = "X-Axis Range Zoom"
           ),
-          toggle_slider_ui(ns("yrange_scale"),
-            label = "Y-Axis Range Zoom",
-            min = -1000000,
-            max = 1000000,
-            value = c(-1000000, 1000000)
+          toggle_slider_ui(
+            ns("yrange_scale"),
+            label = "Y-Axis Range Zoom"
           ),
           numericInput(ns("facet_ncol"), "Number of Plots Per Row:", a$facet_ncol, min = 1),
           checkboxInput(ns("trt_facet"), "Treatment Variable Faceting", a$trt_facet),
@@ -290,18 +286,31 @@ srv_g_scatterplot <- function(id,
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    xrange_slider <- toggle_slider_server("xrange_scale")
-    yrange_slider <- toggle_slider_server("yrange_scale")
-    keep_range_slider_updated(session, input, xrange_slider$update_state, "xaxis_var", "xaxis_param", anl_q)
-    keep_range_slider_updated(session, input, yrange_slider$update_state, "yaxis_var", "xaxis_param", anl_q)
+    data_state_x <- reactive({
+      get_data_range_states(
+        varname = input$xaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_q()$ANL
+      )
+    })
+    xrange_slider <- toggle_slider_server("xrange_scale", data_state_x)
+    data_state_y <- reactive({
+      get_data_range_states(
+        varname = input$yaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_q()$ANL
+      )
+    })
+    yrange_slider <- toggle_slider_server("yrange_scale", data_state_y)
+
     keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
 
     # plot
     plot_q <- debounce(reactive({
       req(anl_q())
       # nolint start
-      xlim <- xrange_slider$state()$value
-      ylim <- yrange_slider$state()$value
+      xlim <- xrange_slider$value
+      ylim <- yrange_slider$value
       facet_ncol <- input$facet_ncol
       validate(need(
         is.na(facet_ncol) || (as.numeric(facet_ncol) > 0 && as.numeric(facet_ncol) %% 1 == 0),

diff --git a/R/tm_g_gh_spaghettiplot.R b/R/tm_g_gh_spaghettiplot.R
@@ -301,10 +301,7 @@ g_ui_spaghettiplot <- function(id, ...) {
             tags$div(
               toggle_slider_ui(
                 ns("yrange_scale"),
-                label = "Y-Axis Range Zoom",
-                min = -1000000,
-                max = 1000000,
-                value = c(-1000000, 1000000)
+                label = "Y-Axis Range Zoom"
               ),
               tags$div(
                 class = "flex flex-wrap items-center",
@@ -399,8 +396,14 @@ srv_g_spaghettiplot <- function(id,
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    yrange_slider <- toggle_slider_server("yrange_scale")
-    keep_range_slider_updated(session, input, yrange_slider$update_state, "yaxis_var", "xaxis_param", anl_q)
+    data_state <- reactive({
+      get_data_range_states(
+        varname = input$yaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_q()$ANL
+      )
+    })
+    yrange_slider <- toggle_slider_server("yrange_scale", data_state)
     keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
 
     horizontal_line <- srv_arbitrary_lines("hline_arb")
@@ -425,7 +428,7 @@ srv_g_spaghettiplot <- function(id,
       teal::validate_inputs(iv_r())
       req(anl_q())
       # nolint start
-      ylim <- yrange_slider$state()$value
+      ylim <- yrange_slider$value
       facet_ncol <- input$facet_ncol
       facet_scales <- ifelse(input$free_x, "free_x", "fixed")