Refactor slider state management

DESCRIPTION

@@ -78,3 +78,4 @@ Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
+Config/testthat/edition: 3

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,16 @@ 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
-    )
+    slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, step = NULL, change_counter = 0)
+    yrange_slider_state <- toggle_slider_server("yrange_scale", slider_state)
+    observe({
+      slider_state <- keep_slider_state_updated(
+        intial_state = slider_state,
+        varname = input$yaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_q()$ANL
+      )
+    })
     keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
 
     horizontal_line <- srv_arbitrary_lines("hline_arb")
@@ -395,7 +393,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

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,26 @@ 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)
+    x_slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, step = NULL, change_counter = 0)
+    xrange_slider <- toggle_slider_server("xrange_scale", x_slider_state)
+    y_slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, step = NULL, change_counter = 0)
+    yrange_slider <- toggle_slider_server("yrange_scale", y_slider_state, print = TRUE)
+
+    observe({
+      x_slider_state <- keep_slider_state_updated(
+        intial_state = x_slider_state,
+        varname = input$xaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_constraint()$ANL
+      )
+      y_slider_state <- keep_slider_state_updated(
+        intial_state = y_slider_state,
+        varname = input$yaxis_var,
+        paramname = input$yaxis_param,
+        ANL = anl_constraint()$ANL
+      )
+    })
+
     keep_data_const_opts_updated(session, input, anl_constraint, "xaxis_param")
 
     # selector names after transposition
@@ -725,8 +739,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

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,27 @@ 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"
-    )
+    x_slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, step = NULL, change_counter = 0)
+    xrange_slider <- toggle_slider_server("xrange_scale", x_slider_state)
+    y_slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, step = NULL, change_counter = 0)
+    yrange_slider <- toggle_slider_server("yrange_scale", y_slider_state)
+
+    observe({
+      x_slider_state <- keep_slider_state_updated(
+        intial_state = x_slider_state,
+        varname = input$xaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_q()$ANL
+      )
+      y_slider_state <- keep_slider_state_updated(
+        intial_state = y_slider_state,
+        varname = input$xaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_q()$ANL,
+        trt_group = "trt_group"
+      )
+    })
+
     keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
 
     horizontal_line <- srv_arbitrary_lines("hline_arb")
@@ -326,8 +328,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

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,7 +401,8 @@ srv_lineplot <- function(id,
 
     keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
 
-    yrange_slider <- toggle_slider_server("yrange_scale")
+    y_slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, step = NULL, change_counter = 0)
+    yrange_slider <- toggle_slider_server("yrange_scale", y_slider_state)
 
     horizontal_line <- srv_arbitrary_lines("hline_arb")
 
@@ -436,7 +434,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 keep_slider_state_updated 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,14 +461,13 @@ 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 keep_slider_state_updated because this module computes the min, max
       # 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
-      ))
+      y_slider_state$min <- minmax[[1]]
+      y_slider_state$max <- minmax[[2]]
+      y_slider_state$value <- minmax
+      y_slider_state$change_counter <- isolate(y_slider_state$change_counter) + 1
     })
 
     line_color_defaults <- color_manual
@@ -667,7 +664,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

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,34 @@ 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)
+    x_slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, step = NULL, change_counter = 0)
+    xrange_slider <- toggle_slider_server("xrange_scale", x_slider_state)
+    y_slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, step = NULL, change_counter = 0)
+    yrange_slider <- toggle_slider_server("yrange_scale", y_slider_state)
+
+    observe({
+      x_slider_state <- keep_slider_state_updated(
+        intial_state = x_slider_state,
+        varname = input$xaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_q()$ANL
+      )
+      y_slider_state <- keep_slider_state_updated(
+        intial_state = y_slider_state,
+        varname = input$yaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_q()$ANL
+      )
+    })
+
     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),

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,16 @@ 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)
+    y_slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, step = NULL, change_counter = 0)
+    yrange_slider <- toggle_slider_server("yrange_scale", y_slider_state)
+    observe({
+      y_slider_state <- keep_slider_state_updated(
+        intial_state = y_slider_state,
+        varname = input$yaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_q()$ANL
+      )
+    })
     keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
 
     horizontal_line <- srv_arbitrary_lines("hline_arb")
@@ -425,7 +430,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")