From 305249f31f6173e7fd6ddb7b09268c1d88aa5609 Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Mon, 21 Oct 2024 15:26:15 +0530
Subject: [PATCH 01/16] feat: simplify slider state management for one module

---
 R/tm_g_gh_boxplot.R   |  30 +++---
 R/toggleable_slider.R | 212 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 228 insertions(+), 14 deletions(-)

diff --git a/R/tm_g_gh_boxplot.R b/R/tm_g_gh_boxplot.R
index 4f262c13..6ed9cf18 100644
--- a/R/tm_g_gh_boxplot.R
+++ b/R/tm_g_gh_boxplot.R
@@ -261,12 +261,9 @@ ui_g_boxplot <- function(id, ...) {
       teal.widgets::panel_group(
         teal.widgets::panel_item(
           title = "Plot Aesthetic Settings",
-          toggle_slider_ui(
+          toggle_slider_ui_new(
             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,20 @@ 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
     )
+    yrange_slider_state <- toggle_slider_server_new("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 +397,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/toggleable_slider.R b/R/toggleable_slider.R
index 45419a15..c576ca9e 100644
--- a/R/toggleable_slider.R
+++ b/R/toggleable_slider.R
@@ -306,3 +306,215 @@ toggle_slider_server <- function(id, is_dichotomous_slider = TRUE, step_slider =
     ))
   })
 }
+
+
+#' UI with a toggleable slider to change between slider and numeric input fields
+#'
+#' This is useful when a slider should be shown, but it is sometimes hard to configure sliders,
+#' so one can toggle to one or two numeric input fields to set slider instead.
+#' Both normal sliders (for a single number in a range) and dichotomous sliders (for a range
+#' within the slider range) are supported. In the former case, the toggle button
+#' will show one numeric input field, in the latter case two.
+#'
+#' Value is not checked to be within minmax range
+#'
+#' @md
+#' @param id `character` module id
+#' @param label `label` label for input field, e.g. slider or numeric inputs
+#'
+#' @examples
+#' value <- c(20.3, 81.5) # dichotomous slider
+#' # value <- c(50.1) # normal slider
+#'
+#' # use non-exported function from teal.goshawk
+#' toggle_slider_ui <- getFromNamespace("toggle_slider_ui", "teal.goshawk")
+#' toggle_slider_server <- getFromNamespace("toggle_slider_server", "teal.goshawk")
+#'
+#' ui <- div(
+#'   toggle_slider_ui(
+#'     "toggle_slider", "Select value"
+#'   ),
+#'   verbatimTextOutput("value")
+#' )
+#'
+#' server <- function(input, output, session) {
+#'   is_dichotomous_slider <- (length(value) == 2)
+#'   range_value <- toggle_slider_server("toggle_slider")
+#'   messages <- reactiveVal() # to keep history
+#'   observeEvent(range_value$state(), {
+#'     list_with_names_str <- function(x) paste(names(x), x, sep = ": ", collapse = ", ")
+#'     messages(c(messages(), list_with_names_str(range_value$state())))
+#'   })
+#'   output$value <- renderText({
+#'     paste(messages(), collapse = "\n")
+#'   })
+#' }
+#'
+#' if (interactive()) {
+#'   shinyApp(ui, server)
+#' }
+#' @name toggle_sidebar
+#' @keywords internal
+#' @return `NULL`.
+NULL
+
+
+#' @rdname toggle_sidebar
+toggle_slider_ui_new <- function(id, label) {
+  ns <- NS(id)
+  tags$div(
+    tags$div(
+      class = "flex justify-between mb-1",
+      tags$span(tags$strong(label)),
+      actionButton(ns("toggle"), "Toggle", class = "btn-xs")
+    ),
+    uiOutput(ns("slider_view")),
+    shinyjs::hidden(
+      tags$div(
+        id = ns("numeric_view"),
+        numericInput(
+          ns("value_low"),
+          "From:",
+          value = 0
+        ),
+        numericInput(
+          ns("value_high"),
+          "- to:",
+          value = 0
+        )
+      )
+    )
+  )
+}
+
+#' @param ... additional parameters to pass to `sliderInput`
+#' @param initial_state `reactiveValues` list with min, max and value.
+#' @keywords internal
+#' @rdname toggle_slider
+toggle_slider_server_new <- function(id, initial_state, ...) {
+  moduleServer(id, function(input, output, session) {
+    selected_state <- reactiveVal(NULL)
+    slider_update_state <- reactiveVal(NULL)
+    numeric_update_state <- reactiveVal(NULL)
+    slider_shown <- reactive(input$toggle %% 2 == 0)
+    observeEvent(c(initial_state$min, initial_state$max, initial_state$value), {
+      selected_state(
+        list(
+          min = initial_state$min,
+          max = initial_state$max,
+          value = initial_state$value
+        )
+      )
+      slider_update_state(
+        list(
+          min = initial_state$min,
+          max = initial_state$max,
+          value = initial_state$value
+        )
+      )
+      numeric_update_state(list(min = initial_state$value[1], max = initial_state$value[2]))
+    })
+    output$slider_view <- renderUI({
+      req(slider_update_state())
+      args <- list(
+        inputId = session$ns("slider"),
+        label = NULL,
+        min = slider_update_state()$min,
+        max = slider_update_state()$max,
+        value = slider_update_state()$value,
+        step = NULL,
+        ...
+      )
+      if (length(seq(slider_update_state()$min, slider_update_state()$max)) < 10) {
+        args$ticks <- TRUE
+        html <- do.call("sliderInput", args)
+      } else {
+        html <- do.call("sliderInput", args)
+      }
+      tags$div(
+        class = "teal-goshawk toggle-slider-container",
+        html,
+        tags$script(HTML(sprintf(
+          '
+          $(".teal-goshawk.toggle-slider-container #%s").ready(function () {
+            var tickLabel = document.querySelector(
+              ".teal-goshawk.toggle-slider-container .irs-grid-text.js-grid-text-9"
+            );
+            var tick = document.querySelector(
+              ".teal-goshawk.toggle-slider-container .irs-grid-pol:nth-last-child(6)"
+            );
+            if (tickLabel) {
+              if (parseFloat(tickLabel.style.left) > 95) {
+                tickLabel.style.opacity = "0";
+                tick.style.opacity = "0";
+              }
+            } else {
+              console.log("Toggle slider element not found.");
+            }
+          });
+        ',
+          session$ns("slider")
+        )))
+      )
+    })
+
+    observeEvent(input$toggle, {
+      shinyjs::toggle("slider_view", condition = slider_shown())
+      shinyjs::toggle("numeric_view", condition = !slider_shown())
+    })
+    observeEvent(input$slider, {
+      if (slider_shown()) {
+        selected_state(
+          list(
+            min = selected_state()$min,
+            max = selected_state()$max,
+            value = input$slider
+          )
+        )
+        numeric_update_state(list(min = input$slider[1], max = input$slider[2]))
+      }
+    })
+    observeEvent(c(input$value_low, input$value_high), ignoreInit = TRUE, {
+      if (!slider_shown()) {
+        selected_state(
+          list(
+            min = min(initial_state$min, input$value_low),
+            max = max(initial_state$max, input$value_high),
+            value = c(input$value_low, input$value_high)
+          )
+        )
+        slider_update_state(
+          list(
+            min = selected_state()$min,
+            max = selected_state()$max,
+            value = selected_state()$value
+          )
+        )
+      }
+    })
+    observeEvent(numeric_update_state(), {
+      updateNumericInput(session, "value_low", value = numeric_update_state()$min)
+      updateNumericInput(session, "value_high", value = numeric_update_state()$max)
+    })
+
+    return(selected_state)
+  })
+}
+
+#' @keywords internal
+#' @rdname toggle_slider
+keep_slider_state_updated <- function(intial_state, varname, paramname, ANL) { # nolint object_name_linter
+  validate(need(varname, "Please select variable"))
+  validate(need(paramname, "Please select variable"))
+  req(length(paramname) == 1)
+
+  ANL <- ANL %>% dplyr::filter(.data$PARAMCD == paramname) # nolint object_name_linter
+  validate_has_variable(ANL, varname, paste("variable", varname, "does not exist"))
+
+  var <- stats::na.omit(ANL[[varname]])
+  minmax <- if (length(var)) c(floor(min(var)), ceiling(max(var))) else c(0, 0)
+  intial_state$min <- minmax[[1]]
+  intial_state$max <- minmax[[2]]
+  intial_state$value <- minmax
+  intial_state
+}

From b93acbfc6e01fff997e0cf33d45ef3108ea0df25 Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Mon, 21 Oct 2024 18:03:33 +0530
Subject: [PATCH 02/16] feat: extend the new slider shiny module to other teal
 modules

---
 R/tm_g_gh_boxplot.R                   |  10 +-
 R/tm_g_gh_correlationplot.R           |  34 ++-
 R/tm_g_gh_density_distribution_plot.R |  48 ++--
 R/tm_g_gh_lineplot.R                  |  19 +-
 R/tm_g_gh_scatterplot.R               |  44 ++--
 R/tm_g_gh_spaghettiplot.R             |  19 +-
 R/toggleable_slider.R                 | 339 ++------------------------
 7 files changed, 123 insertions(+), 390 deletions(-)

diff --git a/R/tm_g_gh_boxplot.R b/R/tm_g_gh_boxplot.R
index 6ed9cf18..78fb9ccb 100644
--- a/R/tm_g_gh_boxplot.R
+++ b/R/tm_g_gh_boxplot.R
@@ -261,7 +261,7 @@ ui_g_boxplot <- function(id, ...) {
       teal.widgets::panel_group(
         teal.widgets::panel_item(
           title = "Plot Aesthetic Settings",
-          toggle_slider_ui_new(
+          toggle_slider_ui(
             ns("yrange_scale"),
             label = "Y-Axis Range Zoom"
           ),
@@ -339,12 +339,8 @@ srv_g_boxplot <- function(id,
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    slider_state <- reactiveValues(
-      min = NULL,
-      max = NULL,
-      value = NULL
-    )
-    yrange_slider_state <- toggle_slider_server_new("yrange_scale", slider_state)
+    slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL)
+    yrange_slider_state <- toggle_slider_server("yrange_scale", slider_state)
     observe({
       slider_state <- keep_slider_state_updated(
         intial_state = slider_state,
diff --git a/R/tm_g_gh_correlationplot.R b/R/tm_g_gh_correlationplot.R
index f26a282b..e15a24a4 100644
--- 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,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, change_counter = 0)
+    xrange_slider <- toggle_slider_server("xrange_scale", x_slider_state)
+    y_slider_state <- reactiveValues(min = NULL, max = NULL, value = 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
diff --git a/R/tm_g_gh_density_distribution_plot.R b/R/tm_g_gh_density_distribution_plot.R
index 3d3a2f85..558f9481 100644
--- 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,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, change_counter = 0)
+    xrange_slider <- toggle_slider_server("xrange_scale", x_slider_state)
+    y_slider_state <- reactiveValues(min = NULL, max = NULL, value = 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
diff --git a/R/tm_g_gh_lineplot.R b/R/tm_g_gh_lineplot.R
index 516c13fd..34239682 100644
--- 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,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, change_counter = 0)
+    yrange_slider <- toggle_slider_server("yrange_scale", y_slider_state)
 
     horizontal_line <- srv_arbitrary_lines("hline_arb")
 
@@ -466,11 +464,10 @@ srv_lineplot <- function(id,
       # we don't use keep_range_slider_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
diff --git a/R/tm_g_gh_scatterplot.R b/R/tm_g_gh_scatterplot.R
index 916876b3..d443fa7f 100644
--- 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,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, change_counter = 0)
+    xrange_slider <- toggle_slider_server("xrange_scale", x_slider_state)
+    y_slider_state <- reactiveValues(min = NULL, max = NULL, value = 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),
diff --git a/R/tm_g_gh_spaghettiplot.R b/R/tm_g_gh_spaghettiplot.R
index 3077d655..bca11af9 100644
--- 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,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, 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")
 
diff --git a/R/toggleable_slider.R b/R/toggleable_slider.R
index c576ca9e..0cb98209 100644
--- a/R/toggleable_slider.R
+++ b/R/toggleable_slider.R
@@ -1,313 +1,3 @@
-#' UI with a toggleable slider to change between slider and numeric input fields
-#'
-#' This is useful when a slider should be shown, but it is sometimes hard to configure sliders,
-#' so one can toggle to one or two numeric input fields to set slider instead.
-#' Both normal sliders (for a single number in a range) and dichotomous sliders (for a range
-#' within the slider range) are supported. In the former case, the toggle button
-#' will show one numeric input field, in the latter case two.
-#'
-#' Value is not checked to be within minmax range
-#'
-#' @md
-#' @param id `character` module id
-#' @param label `label` label for input field, e.g. slider or numeric inputs
-#' @param min `numeric or integer` minimum value
-#' @param max `numeric or integer` maximum value
-#' @param value `numeric or integer` either of length 1 for normal slider or of
-#'   length 2 for dichotomous slider.
-#' @param slider_initially `logical` whether to show slider or numeric fields
-#'   initially
-#' @param step_numeric `numeric or integer` step for numeric input fields
-#' @param width `numeric` width of slider or of each numeric field
-#'
-#' @examples
-#' value <- c(20.3, 81.5) # dichotomous slider
-#' # value <- c(50.1) # normal slider
-#'
-#' # use non-exported function from teal.goshawk
-#' toggle_slider_ui <- getFromNamespace("toggle_slider_ui", "teal.goshawk")
-#' toggle_slider_server <- getFromNamespace("toggle_slider_server", "teal.goshawk")
-#'
-#' ui <- div(
-#'   toggle_slider_ui(
-#'     "toggle_slider", "Select value",
-#'     min = 0.2, max = 100.1, value = value,
-#'     slider_initially = FALSE, step_numeric = 0.001
-#'   ),
-#'   verbatimTextOutput("value")
-#' )
-#'
-#' server <- function(input, output, session) {
-#'   is_dichotomous_slider <- (length(value) == 2)
-#'   range_value <- toggle_slider_server("toggle_slider",
-#'     is_dichotomous_slider = is_dichotomous_slider,
-#'     step_slider = 0.1
-#'   )
-#'   messages <- reactiveVal() # to keep history
-#'   observeEvent(range_value$state(), {
-#'     list_with_names_str <- function(x) paste(names(x), x, sep = ": ", collapse = ", ")
-#'     messages(c(messages(), list_with_names_str(range_value$state())))
-#'   })
-#'   output$value <- renderText({
-#'     paste(messages(), collapse = "\n")
-#'   })
-#' }
-#'
-#' if (interactive()) {
-#'   shinyApp(ui, server)
-#' }
-#' @name toggle_sidebar
-#' @rdname toggle_sidebar
-#' @keywords internal
-#' @return `NULL`.
-NULL
-
-
-#' @rdname toggle_sidebar
-toggle_slider_ui <- function(id,
-                             label,
-                             min,
-                             max,
-                             value,
-                             slider_initially = TRUE,
-                             step_slider = NULL,
-                             step_numeric = step_slider,
-                             width = NULL,
-                             ...) {
-  checkmate::assert_number(min)
-  checkmate::assert_number(max)
-  checkmate::assert_flag(slider_initially)
-  checkmate::assert_number(step_slider, null.ok = TRUE)
-  checkmate::assert_number(step_numeric, null.ok = TRUE)
-  checkmate::assert_numeric(value, min.len = 1, max.len = 2)
-  if (is.null(step_numeric)) {
-    step_numeric <- NA # numericInput does not support NULL
-  }
-
-  show_or_not <- function(show) if (show) identity else shinyjs::hidden
-  ns <- NS(id)
-  tags$div(
-    include_css_files("custom"),
-    shinyjs::useShinyjs(),
-    tags$div(
-      class = "flex justify-between mb-1",
-      tags$span(tags$strong(label)),
-      actionButton(ns("toggle"), "Toggle", class = "btn-xs")
-    ),
-    show_or_not(slider_initially)(
-      uiOutput(ns("slider_ui"))
-    ),
-    show_or_not(!slider_initially)(tags$span(
-      id = ns("numeric_view"),
-      if (length(value) == 1) {
-        numericInput(
-          ns("value"),
-          label = NULL,
-          min = min,
-          max = max,
-          value = value[[1]],
-          step = step_numeric,
-          width = width
-        )
-      } else {
-        tags$div(
-          numericInput(
-            ns("value_low"),
-            "From:",
-            min = min,
-            max = max,
-            value = value[[1]],
-            step = step_numeric,
-            width = width
-          ),
-          numericInput(
-            ns("value_high"),
-            "- to:",
-            min = min,
-            max = max,
-            value = value[[2]],
-            step = step_numeric,
-            width = width
-          )
-        )
-      }
-    ))
-  )
-}
-
-#' @param is_dichotomous_slider `logical` whether it is a dichotomous slider or normal slider
-#' @param step_slider `numeric or integer` step for slider
-#' @param ... additional parameters to pass to `sliderInput`
-#' @keywords internal
-#' @rdname toggle_slider
-toggle_slider_server <- function(id, is_dichotomous_slider = TRUE, step_slider = NULL, ...) {
-  moduleServer(id, function(input, output, session) {
-    checkmate::assert_flag(is_dichotomous_slider)
-    # model view controller: cur_state is the model, the sliderInput and numericInputs are two views/controllers
-    # additionally, the module returns the cur_state, so it can be controlled from that end as well
-    cur_state <- reactiveVal(NULL) # model, can contain min, max, value etc.
-    slider_range <- reactiveVal(NULL)
-
-
-    iv_r <- reactive({
-      iv <- shinyvalidate::InputValidator$new()
-      iv$condition(~ input$toggle %% 2 == 1)
-      iv$add_rule("value_low", shinyvalidate::sv_required("A 'from' value is required - a default is used instead"))
-      iv$add_rule("value_high", shinyvalidate::sv_required("A 'to' value is required - a default is used instead)"))
-      iv$add_rule(
-        "value_high",
-        ~ if (!is.na(input$value_low) && (.) < input$value_low) {
-          "'From' value should be lower than 'to' value - axis has been flipped"
-        }
-      )
-      iv$add_rule(
-        "value_low",
-        ~ if (!is.na(input$value_high) && (.) > input$value_high) {
-          "'To' value should be greater than 'from' value - axis has been flipped"
-        }
-      )
-      iv$enable()
-      iv
-    })
-
-    set_state <- function(new_state) {
-      stopifnot(all(names(new_state) %in% c("min", "max", "step", "value")))
-      iv_r()$is_valid()
-      # when value does not fall into min, max range, it will automatically get truncated
-
-      # only update provided components, do not discasrd others
-      old_state <- cur_state()
-      if (!is.null(old_state)) {
-        new_state <- utils::modifyList(old_state, new_state)
-      }
-
-      if (!setequal(new_state, cur_state())) {
-        cur_state(new_state)
-      }
-    }
-    observeEvent(input$slider, {
-      set_state(list(value = input$slider))
-    })
-    # two values for range (dichotomous slider)
-    observeEvent(
-      eventExpr = { # nolint
-        input$value_low
-        input$value_high
-      },
-      handlerExpr = { # nolint
-        set_state(list(value = c(input$value_low, input$value_high)))
-      }
-    )
-    # one value for value in range
-    observeEvent(
-      input$value,
-      handlerExpr = { # nolint
-        set_state(list(value = input$value))
-      }
-    )
-
-    slider_states <- reactive({
-      state_slider <- cur_state()
-      req(length(state_slider) > 0) # update will otherwise not work
-      state_low <- state_slider
-      state_high <- state_slider
-      if (length(state_slider$value) > 1) {
-        state_low$value <- state_low$value[[1]]
-        state_high$value <- state_high$value[[2]]
-      }
-      state_slider$max <- max(state_slider$max, state_slider$value[2])
-      state_slider$min <- min(state_slider$min, state_slider$value[1])
-      list(
-        low = state_low,
-        high = state_high,
-        low_value = state_low$value,
-        high_value = state_high$value,
-        slider_value = state_slider$value,
-        slider_max = state_slider$max,
-        slider_min = state_slider$min
-      )
-    })
-
-    update_widgets <- function() {
-      state <- slider_states()
-      if (input$toggle %% 2 != 0) {
-        if (length(state$slider_value) > 1) {
-          do.call(updateNumericInput, c(list(session, "value_low"), state$low))
-          do.call(updateNumericInput, c(list(session, "value_high"), state$high))
-        } else {
-          do.call(updateNumericInput, c(list(session, "value"), state$low))
-        }
-      }
-    }
-    observeEvent(input$toggle, {
-      update_widgets()
-      shinyjs::toggle("numeric_view")
-      shinyjs::toggle("slider_ui")
-    })
-
-
-    output$slider_ui <- renderUI({
-      req(input$toggle >= 0)
-      req(slider_range())
-      state <- isolate(slider_states())
-      args <- list(
-        inputId = session$ns("slider"),
-        label = NULL,
-        min = state$slider_min,
-        max = state$slider_max,
-        value = state$slider_value,
-        step = step_slider,
-        ...
-      )
-      if (length(seq(state$slider_min, state$slider_max)) < 10) {
-        args$ticks <- TRUE
-        html <- do.call("sliderInput", args)
-      } else {
-        html <- do.call("sliderInput", args)
-      }
-      tags$div(
-        class = "teal-goshawk toggle-slider-container",
-        html,
-        tags$script(HTML(sprintf(
-          '
-          $(".teal-goshawk.toggle-slider-container #%s").ready(function () {
-            var tickLabel = document.querySelector(
-              ".teal-goshawk.toggle-slider-container .irs-grid-text.js-grid-text-9"
-            );
-            var tick = document.querySelector(
-              ".teal-goshawk.toggle-slider-container .irs-grid-pol:nth-last-child(6)"
-            );
-            if (tickLabel) {
-              if (parseFloat(tickLabel.style.left) > 95) {
-                tickLabel.style.opacity = "0";
-                tick.style.opacity = "0";
-              }
-            } else {
-              console.log("Toggle slider element not found.");
-            }
-          });
-        ',
-          session$ns("slider")
-        )))
-      )
-    })
-
-    update_toggle_slider <- function(value = NULL, min = NULL, max = NULL, step = NULL) {
-      if (!is.null(value) && is_dichotomous_slider) {
-        stopifnot(length(value) == 2)
-      }
-      set_state(Filter(Negate(is.null), list(value = value, min = min, max = max, step = step)))
-      slider_range(list(value = value, min = min, max = max, step = step))
-      update_widgets()
-    }
-    return(list(
-      state = cur_state,
-      update_state = update_toggle_slider
-    ))
-  })
-}
-
-
 #' UI with a toggleable slider to change between slider and numeric input fields
 #'
 #' This is useful when a slider should be shown, but it is sometimes hard to configure sliders,
@@ -360,7 +50,7 @@ NULL
 
 
 #' @rdname toggle_sidebar
-toggle_slider_ui_new <- function(id, label) {
+toggle_slider_ui <- function(id, label) {
   ns <- NS(id)
   tags$div(
     tags$div(
@@ -391,13 +81,13 @@ toggle_slider_ui_new <- function(id, label) {
 #' @param initial_state `reactiveValues` list with min, max and value.
 #' @keywords internal
 #' @rdname toggle_slider
-toggle_slider_server_new <- function(id, initial_state, ...) {
+toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
   moduleServer(id, function(input, output, session) {
     selected_state <- reactiveVal(NULL)
     slider_update_state <- reactiveVal(NULL)
     numeric_update_state <- reactiveVal(NULL)
     slider_shown <- reactive(input$toggle %% 2 == 0)
-    observeEvent(c(initial_state$min, initial_state$max, initial_state$value), {
+    observeEvent(initial_state$change_counter, {
       selected_state(
         list(
           min = initial_state$min,
@@ -409,10 +99,17 @@ toggle_slider_server_new <- function(id, initial_state, ...) {
         list(
           min = initial_state$min,
           max = initial_state$max,
-          value = initial_state$value
+          value = initial_state$value,
+          change_counter = initial_state$change_counter
+        )
+      )
+      numeric_update_state(
+        list(
+          min = initial_state$value[1],
+          max = initial_state$value[2],
+          change_counter = initial_state$change_counter
         )
       )
-      numeric_update_state(list(min = initial_state$value[1], max = initial_state$value[2]))
     })
     output$slider_view <- renderUI({
       req(slider_update_state())
@@ -503,7 +200,7 @@ toggle_slider_server_new <- function(id, initial_state, ...) {
 
 #' @keywords internal
 #' @rdname toggle_slider
-keep_slider_state_updated <- function(intial_state, varname, paramname, ANL) { # nolint object_name_linter
+keep_slider_state_updated <- function(intial_state, varname, paramname, ANL, trt_group = NULL) { # nolint object_name_linter
   validate(need(varname, "Please select variable"))
   validate(need(paramname, "Please select variable"))
   req(length(paramname) == 1)
@@ -513,8 +210,18 @@ keep_slider_state_updated <- function(intial_state, varname, paramname, ANL) { #
 
   var <- stats::na.omit(ANL[[varname]])
   minmax <- if (length(var)) c(floor(min(var)), ceiling(max(var))) else c(0, 0)
+  if (!is.null(trt_group)) {
+    ANL_split <- ANL %>% split(f = factor(paste0(ANL[["AVISITCD"]], ANL[[trt_group]]))) # nolint
+    density_maxes <- lapply(ANL_split, function(x) {
+      max(stats::density(stats::na.omit(x[[varname]]))$y)
+    })
+    dmax <- max(unlist(density_maxes))
+    minmax <- c(0, round(dmax * 1.2, 5))
+    # step <- round(dmax / 100, 5) #TODO add step argument to the reactive list.
+  }
   intial_state$min <- minmax[[1]]
   intial_state$max <- minmax[[2]]
   intial_state$value <- minmax
+  intial_state$change_counter <- isolate(intial_state$change_counter) + 1
   intial_state
 }

From 291402b216cbe7e89ea448ec09d68236a54191d4 Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Mon, 21 Oct 2024 18:54:27 +0530
Subject: [PATCH 03/16] chore: update docs and include step to be passed

---
 DESCRIPTION                           |  1 +
 R/tm_g_gh_boxplot.R                   |  2 +-
 R/tm_g_gh_correlationplot.R           |  4 +-
 R/tm_g_gh_density_distribution_plot.R |  4 +-
 R/tm_g_gh_lineplot.R                  |  6 +-
 R/tm_g_gh_scatterplot.R               |  4 +-
 R/tm_g_gh_spaghettiplot.R             |  2 +-
 R/toggleable_slider.R                 | 62 ++++++++++--------
 R/utils-keep_range_slider_updated.r   | 46 --------------
 man/toggle_sidebar.Rd                 | 90 ---------------------------
 man/toggle_slider.Rd                  | 79 +++++++++++++++++++++++
 11 files changed, 128 insertions(+), 172 deletions(-)
 delete mode 100644 R/utils-keep_range_slider_updated.r
 delete mode 100644 man/toggle_sidebar.Rd
 create mode 100644 man/toggle_slider.Rd

diff --git a/DESCRIPTION b/DESCRIPTION
index a6dd12cd..7e106a8b 100644
--- 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
index 78fb9ccb..e6888330 100644
--- a/R/tm_g_gh_boxplot.R
+++ b/R/tm_g_gh_boxplot.R
@@ -339,7 +339,7 @@ srv_g_boxplot <- function(id,
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL)
+    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(
diff --git a/R/tm_g_gh_correlationplot.R b/R/tm_g_gh_correlationplot.R
index e15a24a4..736f1462 100644
--- a/R/tm_g_gh_correlationplot.R
+++ b/R/tm_g_gh_correlationplot.R
@@ -597,9 +597,9 @@ srv_g_correlationplot <- function(id,
     anl_constraint <- anl_constraint_output()$value
 
     # update sliders for axes taking constraints into account
-    x_slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, change_counter = 0)
+    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, change_counter = 0)
+    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({
diff --git a/R/tm_g_gh_density_distribution_plot.R b/R/tm_g_gh_density_distribution_plot.R
index 558f9481..b09ca7db 100644
--- a/R/tm_g_gh_density_distribution_plot.R
+++ b/R/tm_g_gh_density_distribution_plot.R
@@ -281,9 +281,9 @@ srv_g_density_distribution_plot <- function(id, # nolint
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    x_slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, change_counter = 0)
+    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, change_counter = 0)
+    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({
diff --git a/R/tm_g_gh_lineplot.R b/R/tm_g_gh_lineplot.R
index 34239682..c0eb1031 100644
--- a/R/tm_g_gh_lineplot.R
+++ b/R/tm_g_gh_lineplot.R
@@ -401,7 +401,7 @@ srv_lineplot <- function(id,
 
     keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
 
-    y_slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, change_counter = 0)
+    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")
@@ -434,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)) %>%
@@ -461,7 +461,7 @@ 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
       y_slider_state$min <- minmax[[1]]
diff --git a/R/tm_g_gh_scatterplot.R b/R/tm_g_gh_scatterplot.R
index d443fa7f..5655b1f8 100644
--- a/R/tm_g_gh_scatterplot.R
+++ b/R/tm_g_gh_scatterplot.R
@@ -286,9 +286,9 @@ srv_g_scatterplot <- function(id,
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    x_slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, change_counter = 0)
+    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, change_counter = 0)
+    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({
diff --git a/R/tm_g_gh_spaghettiplot.R b/R/tm_g_gh_spaghettiplot.R
index bca11af9..89d29d65 100644
--- a/R/tm_g_gh_spaghettiplot.R
+++ b/R/tm_g_gh_spaghettiplot.R
@@ -396,7 +396,7 @@ srv_g_spaghettiplot <- function(id,
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    y_slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, change_counter = 0)
+    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(
diff --git a/R/toggleable_slider.R b/R/toggleable_slider.R
index 0cb98209..4501e917 100644
--- a/R/toggleable_slider.R
+++ b/R/toggleable_slider.R
@@ -1,26 +1,31 @@
-#' UI with a toggleable slider to change between slider and numeric input fields
+#' UI with a toggleable dichotomous slider to change between slider and numeric input fields
 #'
 #' This is useful when a slider should be shown, but it is sometimes hard to configure sliders,
 #' so one can toggle to one or two numeric input fields to set slider instead.
-#' Both normal sliders (for a single number in a range) and dichotomous sliders (for a range
-#' within the slider range) are supported. In the former case, the toggle button
-#' will show one numeric input field, in the latter case two.
-#'
-#' Value is not checked to be within minmax range
+#' The toggle button will show two numeric input field for selecting the from and to range.
 #'
 #' @md
 #' @param id `character` module id
 #' @param label `label` label for input field, e.g. slider or numeric inputs
+#' @param ... additional parameters to pass to `sliderInput`
+#' @param initial_state `reactiveValues` list with min, max, step, value and change_counter.
+#' `initial_state` provides the initial state for the slider and the numeric inputs,
+#' it can also help to reset the states from outside the shiny module.
+#' Check the `keep_slider_state_updated` for a common way to reset the slider state.
+#' min - The min range of the slider.
+#' max - The max range of the slider.
+#' step - The step size of the slider and numericInput.
+#' value - The selected values of the slider.
+#' change_counter - A counter to make sure that we also reset the slider even if the previous and current state is same.
 #'
 #' @examples
-#' value <- c(20.3, 81.5) # dichotomous slider
-#' # value <- c(50.1) # normal slider
 #'
 #' # use non-exported function from teal.goshawk
 #' toggle_slider_ui <- getFromNamespace("toggle_slider_ui", "teal.goshawk")
 #' toggle_slider_server <- getFromNamespace("toggle_slider_server", "teal.goshawk")
 #'
-#' ui <- div(
+#' ui <- fluidPage(
+#'   shinyjs::useShinyjs(),
 #'   toggle_slider_ui(
 #'     "toggle_slider", "Select value"
 #'   ),
@@ -28,12 +33,12 @@
 #' )
 #'
 #' server <- function(input, output, session) {
-#'   is_dichotomous_slider <- (length(value) == 2)
-#'   range_value <- toggle_slider_server("toggle_slider")
-#'   messages <- reactiveVal() # to keep history
-#'   observeEvent(range_value$state(), {
+#'   init_state <- reactiveValues(min = 0, max = 10, value = c(3, 6), step = 0.5, change_counter = 0)
+#'   range_value <- toggle_slider_server("toggle_slider", init_state)
+#'   messages <- reactiveVal() #' to keep history
+#'   observeEvent(range_value(), {
 #'     list_with_names_str <- function(x) paste(names(x), x, sep = ": ", collapse = ", ")
-#'     messages(c(messages(), list_with_names_str(range_value$state())))
+#'     messages(c(messages(), list_with_names_str(range_value())))
 #'   })
 #'   output$value <- renderText({
 #'     paste(messages(), collapse = "\n")
@@ -43,20 +48,20 @@
 #' if (interactive()) {
 #'   shinyApp(ui, server)
 #' }
-#' @name toggle_sidebar
+#' @name toggle_slider
 #' @keywords internal
 #' @return `NULL`.
 NULL
 
 
-#' @rdname toggle_sidebar
+#' @rdname toggle_slider
 toggle_slider_ui <- function(id, label) {
   ns <- NS(id)
   tags$div(
     tags$div(
-      class = "flex justify-between mb-1",
+      style = "display: flex; justify-content: space-between;",
       tags$span(tags$strong(label)),
-      actionButton(ns("toggle"), "Toggle", class = "btn-xs")
+      tags$div(actionButton(ns("toggle"), "Toggle", class = "btn-xs"))
     ),
     uiOutput(ns("slider_view")),
     shinyjs::hidden(
@@ -77,8 +82,6 @@ toggle_slider_ui <- function(id, label) {
   )
 }
 
-#' @param ... additional parameters to pass to `sliderInput`
-#' @param initial_state `reactiveValues` list with min, max and value.
 #' @keywords internal
 #' @rdname toggle_slider
 toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
@@ -87,11 +90,13 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
     slider_update_state <- reactiveVal(NULL)
     numeric_update_state <- reactiveVal(NULL)
     slider_shown <- reactive(input$toggle %% 2 == 0)
+
     observeEvent(initial_state$change_counter, {
       selected_state(
         list(
           min = initial_state$min,
           max = initial_state$max,
+          step = initial_state$step,
           value = initial_state$value
         )
       )
@@ -99,6 +104,7 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
         list(
           min = initial_state$min,
           max = initial_state$max,
+          step = initial_state$step,
           value = initial_state$value,
           change_counter = initial_state$change_counter
         )
@@ -107,10 +113,12 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
         list(
           min = initial_state$value[1],
           max = initial_state$value[2],
+          step = initial_state$step,
           change_counter = initial_state$change_counter
         )
       )
     })
+
     output$slider_view <- renderUI({
       req(slider_update_state())
       args <- list(
@@ -119,7 +127,7 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
         min = slider_update_state()$min,
         max = slider_update_state()$max,
         value = slider_update_state()$value,
-        step = NULL,
+        step = slider_update_state()$step,
         ...
       )
       if (length(seq(slider_update_state()$min, slider_update_state()$max)) < 10) {
@@ -159,6 +167,7 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
       shinyjs::toggle("slider_view", condition = slider_shown())
       shinyjs::toggle("numeric_view", condition = !slider_shown())
     })
+
     observeEvent(input$slider, {
       if (slider_shown()) {
         selected_state(
@@ -171,6 +180,7 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
         numeric_update_state(list(min = input$slider[1], max = input$slider[2]))
       }
     })
+
     observeEvent(c(input$value_low, input$value_high), ignoreInit = TRUE, {
       if (!slider_shown()) {
         selected_state(
@@ -189,9 +199,10 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
         )
       }
     })
+
     observeEvent(numeric_update_state(), {
-      updateNumericInput(session, "value_low", value = numeric_update_state()$min)
-      updateNumericInput(session, "value_high", value = numeric_update_state()$max)
+      updateNumericInput(session, "value_low", value = numeric_update_state()$min, step = numeric_update_state()$step)
+      updateNumericInput(session, "value_high", value = numeric_update_state()$max, step = numeric_update_state()$step)
     })
 
     return(selected_state)
@@ -200,7 +211,7 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
 
 #' @keywords internal
 #' @rdname toggle_slider
-keep_slider_state_updated <- function(intial_state, varname, paramname, ANL, trt_group = NULL) { # nolint object_name_linter
+keep_slider_state_updated <- function(intial_state, varname, paramname, ANL, trt_group = NULL, step = NULL) { # nolint object_name_linter
   validate(need(varname, "Please select variable"))
   validate(need(paramname, "Please select variable"))
   req(length(paramname) == 1)
@@ -217,10 +228,11 @@ keep_slider_state_updated <- function(intial_state, varname, paramname, ANL, trt
     })
     dmax <- max(unlist(density_maxes))
     minmax <- c(0, round(dmax * 1.2, 5))
-    # step <- round(dmax / 100, 5) #TODO add step argument to the reactive list.
+    step <- round(dmax / 100, 5)
   }
   intial_state$min <- minmax[[1]]
   intial_state$max <- minmax[[2]]
+  intial_state$step <- step
   intial_state$value <- minmax
   intial_state$change_counter <- isolate(intial_state$change_counter) + 1
   intial_state
diff --git a/R/utils-keep_range_slider_updated.r b/R/utils-keep_range_slider_updated.r
deleted file mode 100644
index c179d5a0..00000000
--- a/R/utils-keep_range_slider_updated.r
+++ /dev/null
@@ -1,46 +0,0 @@
-keep_range_slider_updated <- function(session,
-                                      input,
-                                      update_slider_fcn,
-                                      id_var,
-                                      id_param_var,
-                                      reactive_ANL, # nolint
-                                      is_density = FALSE,
-                                      id_trt_group) {
-  stopifnot(is.function(update_slider_fcn))
-
-  observe({
-    varname <- input[[id_var]]
-    validate(need(varname, "Please select variable"))
-    paramname <- input[[id_param_var]]
-    validate(need(paramname, "Please select variable"))
-    req(length(paramname) == 1)
-
-    # we need id_param_var (e.g. ALT) to filter down because the y-axis may have a different
-    # param var and the range of id_var (e.g. BASE) values may be larger due to this
-    # therefore, we need to filter
-    ANL <- reactive_ANL()$ANL %>% dplyr::filter(.data$PARAMCD == paramname) # nolint
-    validate_has_variable(ANL, varname, paste("variable", varname, "does not exist"))
-
-    var <- stats::na.omit(ANL[[varname]])
-    minmax <- if (length(var)) c(floor(min(var)), ceiling(max(var))) else c(0, 0)
-    step <- NULL
-
-    if (isTRUE(is_density)) {
-      treatname <- input[[id_trt_group]]
-      ANL_split <- ANL %>% split(f = factor(paste0(ANL[["AVISITCD"]], ANL[[treatname]]))) # nolint
-      density_maxes <- lapply(ANL_split, function(x) {
-        max(stats::density(stats::na.omit(x[[varname]]))$y)
-      })
-      dmax <- max(unlist(density_maxes))
-      minmax <- c(0, round(dmax * 1.2, 5))
-      step <- round(dmax / 100, 5)
-    }
-
-    isolate(update_slider_fcn(
-      min = minmax[[1]],
-      max = minmax[[2]],
-      value = minmax,
-      step = step
-    ))
-  })
-}
diff --git a/man/toggle_sidebar.Rd b/man/toggle_sidebar.Rd
deleted file mode 100644
index 29774db7..00000000
--- a/man/toggle_sidebar.Rd
+++ /dev/null
@@ -1,90 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/toggleable_slider.R
-\name{toggle_sidebar}
-\alias{toggle_sidebar}
-\alias{toggle_slider_ui}
-\title{UI with a toggleable slider to change between slider and numeric input fields}
-\usage{
-toggle_slider_ui(
-  id,
-  label,
-  min,
-  max,
-  value,
-  slider_initially = TRUE,
-  step_slider = NULL,
-  step_numeric = step_slider,
-  width = NULL,
-  ...
-)
-}
-\arguments{
-\item{id}{\code{character} module id}
-
-\item{label}{\code{label} label for input field, e.g. slider or numeric inputs}
-
-\item{min}{\verb{numeric or integer} minimum value}
-
-\item{max}{\verb{numeric or integer} maximum value}
-
-\item{value}{\verb{numeric or integer} either of length 1 for normal slider or of
-length 2 for dichotomous slider.}
-
-\item{slider_initially}{\code{logical} whether to show slider or numeric fields
-initially}
-
-\item{step_numeric}{\verb{numeric or integer} step for numeric input fields}
-
-\item{width}{\code{numeric} width of slider or of each numeric field}
-}
-\value{
-\code{NULL}.
-}
-\description{
-This is useful when a slider should be shown, but it is sometimes hard to configure sliders,
-so one can toggle to one or two numeric input fields to set slider instead.
-Both normal sliders (for a single number in a range) and dichotomous sliders (for a range
-within the slider range) are supported. In the former case, the toggle button
-will show one numeric input field, in the latter case two.
-}
-\details{
-Value is not checked to be within minmax range
-}
-\examples{
-value <- c(20.3, 81.5) # dichotomous slider
-# value <- c(50.1) # normal slider
-
-# use non-exported function from teal.goshawk
-toggle_slider_ui <- getFromNamespace("toggle_slider_ui", "teal.goshawk")
-toggle_slider_server <- getFromNamespace("toggle_slider_server", "teal.goshawk")
-
-ui <- div(
-  toggle_slider_ui(
-    "toggle_slider", "Select value",
-    min = 0.2, max = 100.1, value = value,
-    slider_initially = FALSE, step_numeric = 0.001
-  ),
-  verbatimTextOutput("value")
-)
-
-server <- function(input, output, session) {
-  is_dichotomous_slider <- (length(value) == 2)
-  range_value <- toggle_slider_server("toggle_slider",
-    is_dichotomous_slider = is_dichotomous_slider,
-    step_slider = 0.1
-  )
-  messages <- reactiveVal() # to keep history
-  observeEvent(range_value$state(), {
-    list_with_names_str <- function(x) paste(names(x), x, sep = ": ", collapse = ", ")
-    messages(c(messages(), list_with_names_str(range_value$state())))
-  })
-  output$value <- renderText({
-    paste(messages(), collapse = "\n")
-  })
-}
-
-if (interactive()) {
-  shinyApp(ui, server)
-}
-}
-\keyword{internal}
diff --git a/man/toggle_slider.Rd b/man/toggle_slider.Rd
new file mode 100644
index 00000000..4dcbe374
--- /dev/null
+++ b/man/toggle_slider.Rd
@@ -0,0 +1,79 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/toggleable_slider.R
+\name{toggle_slider}
+\alias{toggle_slider}
+\alias{toggle_slider_ui}
+\alias{toggle_slider_server}
+\alias{keep_slider_state_updated}
+\title{UI with a toggleable dichotomous slider to change between slider and numeric input fields}
+\usage{
+toggle_slider_ui(id, label)
+
+toggle_slider_server(id, initial_state, print = FALSE, ...)
+
+keep_slider_state_updated(
+  intial_state,
+  varname,
+  paramname,
+  ANL,
+  trt_group = NULL,
+  step = NULL
+)
+}
+\arguments{
+\item{id}{\code{character} module id}
+
+\item{label}{\code{label} label for input field, e.g. slider or numeric inputs}
+
+\item{initial_state}{\code{reactiveValues} list with min, max, step, value and change_counter.
+\code{initial_state} provides the initial state for the slider and the numeric inputs,
+it can also help to reset the states from outside the shiny module.
+Check the \code{keep_slider_state_updated} for a common way to reset the slider state.
+min - The min range of the slider.
+max - The max range of the slider.
+step - The step size of the slider and numericInput.
+value - The selected values of the slider.
+change_counter - A counter to make sure that we also reset the slider even if the previous and current state is same.}
+
+\item{...}{additional parameters to pass to \code{sliderInput}}
+}
+\value{
+\code{NULL}.
+}
+\description{
+This is useful when a slider should be shown, but it is sometimes hard to configure sliders,
+so one can toggle to one or two numeric input fields to set slider instead.
+The toggle button will show two numeric input field for selecting the from and to range.
+}
+\examples{
+
+# use non-exported function from teal.goshawk
+toggle_slider_ui <- getFromNamespace("toggle_slider_ui", "teal.goshawk")
+toggle_slider_server <- getFromNamespace("toggle_slider_server", "teal.goshawk")
+
+ui <- fluidPage(
+  shinyjs::useShinyjs(),
+  toggle_slider_ui(
+    "toggle_slider", "Select value"
+  ),
+  verbatimTextOutput("value")
+)
+
+server <- function(input, output, session) {
+  init_state <- reactiveValues(min = 0, max = 10, value = c(3, 6), step = 0.5, change_counter = 0)
+  range_value <- toggle_slider_server("toggle_slider", init_state)
+  messages <- reactiveVal() #' to keep history
+  observeEvent(range_value(), {
+    list_with_names_str <- function(x) paste(names(x), x, sep = ": ", collapse = ", ")
+    messages(c(messages(), list_with_names_str(range_value())))
+  })
+  output$value <- renderText({
+    paste(messages(), collapse = "\n")
+  })
+}
+
+if (interactive()) {
+  shinyApp(ui, server)
+}
+}
+\keyword{internal}

From e9b0e6d20f1c398c52890d0aaea44031ebde66b7 Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Tue, 22 Oct 2024 20:32:36 +0530
Subject: [PATCH 04/16] chore: remove unwanted variable

---
 R/toggleable_slider.R | 16 +++-------------
 1 file changed, 3 insertions(+), 13 deletions(-)

diff --git a/R/toggleable_slider.R b/R/toggleable_slider.R
index 4501e917..ffce095c 100644
--- a/R/toggleable_slider.R
+++ b/R/toggleable_slider.R
@@ -88,7 +88,6 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
   moduleServer(id, function(input, output, session) {
     selected_state <- reactiveVal(NULL)
     slider_update_state <- reactiveVal(NULL)
-    numeric_update_state <- reactiveVal(NULL)
     slider_shown <- reactive(input$toggle %% 2 == 0)
 
     observeEvent(initial_state$change_counter, {
@@ -109,14 +108,6 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
           change_counter = initial_state$change_counter
         )
       )
-      numeric_update_state(
-        list(
-          min = initial_state$value[1],
-          max = initial_state$value[2],
-          step = initial_state$step,
-          change_counter = initial_state$change_counter
-        )
-      )
     })
 
     output$slider_view <- renderUI({
@@ -177,7 +168,6 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
             value = input$slider
           )
         )
-        numeric_update_state(list(min = input$slider[1], max = input$slider[2]))
       }
     })
 
@@ -200,9 +190,9 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
       }
     })
 
-    observeEvent(numeric_update_state(), {
-      updateNumericInput(session, "value_low", value = numeric_update_state()$min, step = numeric_update_state()$step)
-      updateNumericInput(session, "value_high", value = numeric_update_state()$max, step = numeric_update_state()$step)
+    observeEvent(selected_state(), {
+      updateNumericInput(session, "value_low", value = selected_state()$value[1], step = selected_state()$step)
+      updateNumericInput(session, "value_high", value = selected_state()$value[2], step = selected_state()$step)
     })
 
     return(selected_state)

From 5332e0b6ea3cbbe6ccce0cba8404c71bdda2f0b9 Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Thu, 24 Oct 2024 19:19:31 +0530
Subject: [PATCH 05/16] test: add shinytest2 tests for testing the slider
 interactions + fix a reactivity issue

---
 R/toggleable_slider.R                         |   7 +-
 tests/testthat.R                              |   3 +
 tests/testthat/helper-TealAppDriver.R         |  20 ++++
 tests/testthat/helper-module-utils.R          |  75 +++++++++++++
 tests/testthat/helper-toggle-slider-utils.R   |  89 +++++++++++++++
 .../test-shinytest2-tm_g_gh_boxplot.R         | 104 ++++++++++++++++++
 6 files changed, 293 insertions(+), 5 deletions(-)
 create mode 100644 tests/testthat.R
 create mode 100644 tests/testthat/helper-TealAppDriver.R
 create mode 100644 tests/testthat/helper-module-utils.R
 create mode 100644 tests/testthat/helper-toggle-slider-utils.R
 create mode 100644 tests/testthat/test-shinytest2-tm_g_gh_boxplot.R

diff --git a/R/toggleable_slider.R b/R/toggleable_slider.R
index ffce095c..c07001d6 100644
--- a/R/toggleable_slider.R
+++ b/R/toggleable_slider.R
@@ -168,6 +168,8 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
             value = input$slider
           )
         )
+        updateNumericInput(session, "value_low", value = selected_state()$value[1], step = selected_state()$step)
+        updateNumericInput(session, "value_high", value = selected_state()$value[2], step = selected_state()$step)
       }
     })
 
@@ -190,11 +192,6 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
       }
     })
 
-    observeEvent(selected_state(), {
-      updateNumericInput(session, "value_low", value = selected_state()$value[1], step = selected_state()$step)
-      updateNumericInput(session, "value_high", value = selected_state()$value[2], step = selected_state()$step)
-    })
-
     return(selected_state)
   })
 }
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 00000000..174caadb
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,3 @@
+pkg_name <- "teal.goshawk"
+library(pkg_name, character.only = TRUE)
+testthat::test_check(pkg_name)
diff --git a/tests/testthat/helper-TealAppDriver.R b/tests/testthat/helper-TealAppDriver.R
new file mode 100644
index 00000000..599e5c88
--- /dev/null
+++ b/tests/testthat/helper-TealAppDriver.R
@@ -0,0 +1,20 @@
+init_teal_app_driver <- function(...) {
+  testthat::with_mocked_bindings(
+    {
+      TealAppDriver <- getFromNamespace("TealAppDriver", "teal") # nolint: object_name.
+      TealAppDriver$new(...)
+    },
+    shinyApp = function(ui, server, ...) {
+      functionBody(server) <- bquote({
+        # Hint to shinytest2 that this package should be available (via {globals})
+        .hint_to_load_package <- tm_g_gh_boxplot # Hint to shinytest2 when looking for packages in globals
+        .(functionBody(server))
+      })
+
+      shiny::shinyApp(ui, server, ...)
+    },
+    # The relevant shinyApp call in `TealAppDriver` is being called without prefix,
+    # hence why the package bindings that is changed is in {teal} and not {shiny}
+    .package = "teal"
+  )
+}
diff --git a/tests/testthat/helper-module-utils.R b/tests/testthat/helper-module-utils.R
new file mode 100644
index 00000000..7405ead5
--- /dev/null
+++ b/tests/testthat/helper-module-utils.R
@@ -0,0 +1,75 @@
+# nolint start
+get_test_data <- function() {
+  data <- teal_data()
+  data <- within(data, {
+    library(dplyr)
+    library(nestcolor)
+    library(stringr)
+
+    # use non-exported function from goshawk
+    h_identify_loq_values <- getFromNamespace("h_identify_loq_values", "goshawk")
+
+    # original ARM value = dose value
+    arm_mapping <- list(
+      "A: Drug X" = "150mg QD",
+      "B: Placebo" = "Placebo",
+      "C: Combination" = "Combination"
+    )
+    set.seed(1)
+    ADSL <- rADSL
+    ADLB <- rADLB
+    var_labels <- lapply(ADLB, function(x) attributes(x)$label)
+    ADLB <- ADLB %>%
+      mutate(
+        AVISITCD = case_when(
+          AVISIT == "SCREENING" ~ "SCR",
+          AVISIT == "BASELINE" ~ "BL",
+          grepl("WEEK", AVISIT) ~ paste("W", str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
+          TRUE ~ as.character(NA)
+        ),
+        AVISITCDN = case_when(
+          AVISITCD == "SCR" ~ -2,
+          AVISITCD == "BL" ~ 0,
+          grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
+          TRUE ~ as.numeric(NA)
+        ),
+        AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
+        TRTORD = case_when(
+          ARMCD == "ARM C" ~ 1,
+          ARMCD == "ARM B" ~ 2,
+          ARMCD == "ARM A" ~ 3
+        ),
+        ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))]),
+        ARM = factor(ARM) %>% reorder(TRTORD),
+        ACTARM = as.character(arm_mapping[match(ACTARM, names(arm_mapping))]),
+        ACTARM = factor(ACTARM) %>% reorder(TRTORD),
+        ANRLO = 50,
+        ANRHI = 75
+      ) %>%
+      rowwise() %>%
+      group_by(PARAMCD) %>%
+      mutate(LBSTRESC = ifelse(
+        USUBJID %in% sample(USUBJID, 1, replace = TRUE),
+        paste("<", round(runif(1, min = 25, max = 30))), LBSTRESC
+      )) %>%
+      mutate(LBSTRESC = ifelse(
+        USUBJID %in% sample(USUBJID, 1, replace = TRUE),
+        paste(">", round(runif(1, min = 70, max = 75))), LBSTRESC
+      )) %>%
+      ungroup()
+
+    attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
+    attr(ADLB[["ACTARM"]], "label") <- var_labels[["ACTARM"]]
+    attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
+    attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"
+
+    # add LLOQ and ULOQ variables
+    ALB_LOQS <- h_identify_loq_values(ADLB, "LOQFL")
+    ADLB <- left_join(ADLB, ALB_LOQS, by = "PARAM")
+  })
+  datanames <- c("ADSL", "ADLB")
+  datanames(data) <- datanames
+  join_keys(data) <- default_cdisc_join_keys[datanames]
+  data
+}
+# nolint end
diff --git a/tests/testthat/helper-toggle-slider-utils.R b/tests/testthat/helper-toggle-slider-utils.R
new file mode 100644
index 00000000..ffac8db4
--- /dev/null
+++ b/tests/testthat/helper-toggle-slider-utils.R
@@ -0,0 +1,89 @@
+click_toggle_button <- function(app) {
+  app$click(NS(app$active_ns()$module, "yrange_scale-toggle"))
+}
+
+#' Extract the values and the ranges from the UI for the slider
+get_ui_slider_values <- function(app) {
+  id <- NS(app$active_ns()$module, "yrange_scale-slider_view")
+  # Note that the values can only be observed once they are visible
+  if (!is_slider_visible(app)) {
+    click_toggle_button(app)
+  }
+  list(
+    min = app$get_text(sprintf("#%s .irs-min", id)) |> as.numeric(),
+    max = app$get_text(sprintf("#%s .irs-max", id)) |> as.numeric(),
+    value = c(
+      app$get_text(sprintf("#%s .irs-from", id)),
+      app$get_text(sprintf("#%s .irs-to", id))
+    ) |> as.numeric()
+  )
+}
+
+#' Checking if the sliderInput and the numericInputs match
+check_if_widgets_match <- function(app) {
+  testthat::expect_identical(
+    app$get_active_module_input("yrange_scale-slider"),
+    c(
+      app$get_active_module_input("yrange_scale-value_low"),
+      app$get_active_module_input("yrange_scale-value_high")
+    )
+  )
+}
+
+#' Checking if the sliderInput and the numericInputs with custom values.
+#' values must be a list with min, max, value as keys.
+#' check_widgets_with_value(app, list(min = 0, max = 55, value = c(0, 55)))
+check_widgets_with_value <- function(app, values) {
+  checkmate::assert_list(values, types = "numeric", min.len = 3)
+  checkmate::assert_names(names(values), must.include = c("min", "max", "value"))
+  checkmate::assert_numeric(values$value, len = 2)
+  slider_values <- get_ui_slider_values(app)
+  testthat::expect_identical(slider_values, values)
+  testthat::expect_identical(
+    app$get_active_module_input("yrange_scale-value_low"),
+    as.integer(values$value[1])
+  )
+  testthat::expect_identical(
+    app$get_active_module_input("yrange_scale-value_high"),
+    as.integer(values$value[2])
+  )
+}
+
+is_slider_visible <- function(app) {
+  app$get_active_module_input("yrange_scale-toggle") %% 2 == 0
+}
+
+#' values should be a numeric vector of length 2
+#' Note that it will automatically toggle slider to be visible before setting it
+set_slider_values <- function(app, values) {
+  checkmate::assert_numeric(values, len = 2)
+
+  if (!is_slider_visible(app)) {
+    click_toggle_button(app)
+  }
+  app$set_input(
+    NS(app$active_ns()$module, "yrange_scale-slider"),
+    values,
+    wait_ = FALSE
+  )
+}
+
+#' values should be a numeric vector of length 2
+#' Note that it will automatically toggle slider to be visible before setting it
+set_numeric_input_values <- function(app, values) {
+  checkmate::assert_numeric(values, len = 2)
+
+  if (is_slider_visible(app)) {
+    click_toggle_button(app)
+  }
+  app$set_input(
+    NS(app$active_ns()$module, "yrange_scale-value_low"),
+    values[1],
+    wait_ = FALSE
+  )
+  app$set_input(
+    NS(app$active_ns()$module, "yrange_scale-value_high"),
+    values[2],
+    wait_ = FALSE
+  )
+}
diff --git a/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R b/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R
new file mode 100644
index 00000000..06f33160
--- /dev/null
+++ b/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R
@@ -0,0 +1,104 @@
+app_driver <- init_teal_app_driver(
+  data = get_test_data(),
+  modules = tm_g_gh_boxplot(
+    label = "Box Plot",
+    dataname = "ADLB",
+    param_var = "PARAMCD",
+    param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
+    yaxis_var = choices_selected(c("AVAL", "BASE", "CHG"), "AVAL"),
+    xaxis_var = choices_selected(c("ACTARM", "ARM", "AVISITCD", "STUDYID"), "ARM"),
+    facet_var = choices_selected(c("ACTARM", "ARM", "AVISITCD", "SEX"), "AVISITCD"),
+    trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
+    loq_legend = TRUE,
+    rotate_xlab = FALSE,
+    hline_arb = c(60, 55),
+    hline_arb_color = c("grey", "red"),
+    hline_arb_label = c("default_hori_A", "default_hori_B"),
+    hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
+    hline_vars_colors = c("pink", "brown", "purple", "black"),
+  )
+)
+
+testthat::test_that("toggle_slider_module: widgets are initialized with proper values", {
+  app_driver$click(selector = ".panel-title")
+  init_values <- list(min = 0, max = 55, value = c(0, 55))
+  check_if_widgets_match(app_driver)
+  check_widgets_with_value(app_driver, init_values)
+})
+
+
+testthat::test_that("toggle_slider_module: changing the sliderInput sets proper numericInput values", {
+  new_value <- c(12, 50)
+  set_slider_values(app_driver, new_value)
+  check_if_widgets_match(app_driver)
+})
+
+testthat::test_that(
+  "toggle_slider_module: changing the numericInputs
+  within the sliderInput range, sets proper sliderInput values",
+  {
+    initial_range <- list(min = 0, max = 55)
+    new_value <- c(10, 40)
+    set_numeric_input_values(app_driver, new_value)
+    check_widgets_with_value(
+      app_driver,
+      list(
+        min = initial_range$min,
+        max = initial_range$max,
+        value = new_value
+      )
+    )
+  }
+)
+
+testthat::test_that(
+  "toggle_slider_module: changing the numericInputs
+  outside the sliderInput range, sets proper sliderInput values and range",
+  {
+    new_range <- c(-5, 60)
+    set_numeric_input_values(app_driver, new_range)
+    check_widgets_with_value(
+      app_driver,
+      list(
+        min = new_range[1],
+        max = new_range[2],
+        value = c(new_range[1], new_range[2])
+      )
+    )
+  }
+)
+
+testthat::test_that(
+  "toggle_slider_module: changing the numericInputs
+  within the rage, sets back the sliderInput range to initial range",
+  {
+    initial_range <- list(min = 0, max = 55)
+    new_value <- c(11, 30)
+    set_numeric_input_values(app_driver, new_value)
+    check_widgets_with_value(
+      app_driver,
+      list(
+        min = initial_range$min,
+        max = initial_range$max,
+        value = c(new_value[1], new_value[2])
+      )
+    )
+  }
+)
+
+testthat::test_that(
+  "toggle_slider_module: changing dependant widgets outside
+sets proper sliderInput and numericInput values",
+  {
+    app_driver$set_active_module_input("xaxis_param", "CRP")
+    new_range <- c(5, 13)
+    check_widgets_with_value(
+      app_driver,
+      list(
+        min = new_range[1],
+        max = new_range[2],
+        value = c(new_range[1], new_range[2])
+      )
+    )
+  }
+)

From 75f1321f296ac0b29b302ae11b2346f35e7a5502 Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Fri, 25 Oct 2024 12:10:28 +0530
Subject: [PATCH 06/16] chore: simplify slider render

---
 R/toggleable_slider.R | 26 ++++++++++----------------
 1 file changed, 10 insertions(+), 16 deletions(-)

diff --git a/R/toggleable_slider.R b/R/toggleable_slider.R
index c07001d6..c0e987da 100644
--- a/R/toggleable_slider.R
+++ b/R/toggleable_slider.R
@@ -112,24 +112,18 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
 
     output$slider_view <- renderUI({
       req(slider_update_state())
-      args <- list(
-        inputId = session$ns("slider"),
-        label = NULL,
-        min = slider_update_state()$min,
-        max = slider_update_state()$max,
-        value = slider_update_state()$value,
-        step = slider_update_state()$step,
-        ...
-      )
-      if (length(seq(slider_update_state()$min, slider_update_state()$max)) < 10) {
-        args$ticks <- TRUE
-        html <- do.call("sliderInput", args)
-      } else {
-        html <- do.call("sliderInput", args)
-      }
       tags$div(
         class = "teal-goshawk toggle-slider-container",
-        html,
+        sliderInput(
+          inputId = session$ns("slider"),
+          label = NULL,
+          min = slider_update_state()$min,
+          max = slider_update_state()$max,
+          value = slider_update_state()$value,
+          step = slider_update_state()$step,
+          ticks = TRUE,
+          ...
+        ),
         tags$script(HTML(sprintf(
           '
           $(".teal-goshawk.toggle-slider-container #%s").ready(function () {

From ed896446368be68e64f0027428c9ae0e1abf2cdb Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Fri, 25 Oct 2024 14:23:32 +0530
Subject: [PATCH 07/16] feat: further simplify the state management

---
 R/tm_g_gh_boxplot.R                           |   9 +-
 R/tm_g_gh_correlationplot.R                   |  20 +--
 R/tm_g_gh_density_distribution_plot.R         |  20 +--
 R/tm_g_gh_lineplot.R                          |  15 +-
 R/tm_g_gh_scatterplot.R                       |  20 +--
 R/tm_g_gh_spaghettiplot.R                     |   9 +-
 R/toggleable_slider.R                         | 135 +++++-------------
 .../test-shinytest2-tm_g_gh_boxplot.R         |   1 +
 8 files changed, 86 insertions(+), 143 deletions(-)

diff --git a/R/tm_g_gh_boxplot.R b/R/tm_g_gh_boxplot.R
index e6888330..5fdc35e1 100644
--- a/R/tm_g_gh_boxplot.R
+++ b/R/tm_g_gh_boxplot.R
@@ -339,11 +339,10 @@ srv_g_boxplot <- function(id,
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    slider_state <- reactiveValues(min = NULL, max = NULL, value = NULL, step = NULL, change_counter = 0)
-    yrange_slider_state <- toggle_slider_server("yrange_scale", slider_state)
+    yrange_slider_state <- toggle_slider_server("yrange_scale")
     observe({
-      slider_state <- keep_slider_state_updated(
-        intial_state = slider_state,
+      yrange_slider_state <- keep_slider_state_updated(
+        state = yrange_slider_state,
         varname = input$yaxis_var,
         paramname = input$xaxis_param,
         ANL = anl_q()$ANL
@@ -393,7 +392,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
index 736f1462..b6ae551f 100644
--- a/R/tm_g_gh_correlationplot.R
+++ b/R/tm_g_gh_correlationplot.R
@@ -597,20 +597,20 @@ srv_g_correlationplot <- function(id,
     anl_constraint <- anl_constraint_output()$value
 
     # update sliders for axes taking constraints into account
-    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)
+    xrange_slider <- toggle_slider_server("xrange_scale")
+    yrange_slider <- toggle_slider_server("yrange_scale")
 
     observe({
-      x_slider_state <- keep_slider_state_updated(
-        intial_state = x_slider_state,
+      xrange_slider <- keep_slider_state_updated(
+        state = xrange_slider,
         varname = input$xaxis_var,
         paramname = input$xaxis_param,
         ANL = anl_constraint()$ANL
       )
-      y_slider_state <- keep_slider_state_updated(
-        intial_state = y_slider_state,
+    })
+    observe({
+      yrange_slider <- keep_slider_state_updated(
+        state = yrange_slider,
         varname = input$yaxis_var,
         paramname = input$yaxis_param,
         ANL = anl_constraint()$ANL
@@ -739,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()$value
-      ylim <- yrange_slider()$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
index b09ca7db..d39dd327 100644
--- a/R/tm_g_gh_density_distribution_plot.R
+++ b/R/tm_g_gh_density_distribution_plot.R
@@ -281,20 +281,20 @@ srv_g_density_distribution_plot <- function(id, # nolint
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    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)
+    xrange_slider <- toggle_slider_server("xrange_scale")
+    yrange_slider <- toggle_slider_server("yrange_scale")
 
     observe({
-      x_slider_state <- keep_slider_state_updated(
-        intial_state = x_slider_state,
+      xrange_slider <- keep_slider_state_updated(
+        state = xrange_slider,
         varname = input$xaxis_var,
         paramname = input$xaxis_param,
         ANL = anl_q()$ANL
       )
-      y_slider_state <- keep_slider_state_updated(
-        intial_state = y_slider_state,
+    })
+    observe({
+      yrange_slider <- keep_slider_state_updated(
+        state = yrange_slider,
         varname = input$xaxis_var,
         paramname = input$xaxis_param,
         ANL = anl_q()$ANL,
@@ -328,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()$value
-      ylim <- yrange_slider()$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
index c0eb1031..ea933a24 100644
--- a/R/tm_g_gh_lineplot.R
+++ b/R/tm_g_gh_lineplot.R
@@ -401,8 +401,7 @@ srv_lineplot <- function(id,
 
     keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
 
-    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)
+    yrange_slider <- toggle_slider_server("yrange_scale")
 
     horizontal_line <- srv_arbitrary_lines("hline_arb")
 
@@ -464,10 +463,12 @@ srv_lineplot <- function(id,
       # 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
-      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
+      yrange_slider$slider <- list(
+        min = minmax[[1]],
+        max = minmax[[2]],
+        value = minmax
+      )
+      yrange_slider$data_range <- list(min = minmax[[1]], max = minmax[[2]])
     })
 
     line_color_defaults <- color_manual
@@ -664,7 +665,7 @@ srv_lineplot <- function(id,
       teal::validate_inputs(iv_r())
       req(anl_q(), line_color_selected(), line_type_selected())
       # nolint start
-      ylim <- yrange_slider()$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
index 5655b1f8..38e9fbd1 100644
--- a/R/tm_g_gh_scatterplot.R
+++ b/R/tm_g_gh_scatterplot.R
@@ -286,20 +286,20 @@ srv_g_scatterplot <- function(id,
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    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)
+    xrange_slider <- toggle_slider_server("xrange_scale")
+    yrange_slider <- toggle_slider_server("yrange_scale")
 
     observe({
-      x_slider_state <- keep_slider_state_updated(
-        intial_state = x_slider_state,
+      xrange_slider <- keep_slider_state_updated(
+        state = xrange_slider,
         varname = input$xaxis_var,
         paramname = input$xaxis_param,
         ANL = anl_q()$ANL
       )
-      y_slider_state <- keep_slider_state_updated(
-        intial_state = y_slider_state,
+    })
+    observe({
+      yrange_slider <- keep_slider_state_updated(
+        state = yrange_slider,
         varname = input$yaxis_var,
         paramname = input$xaxis_param,
         ANL = anl_q()$ANL
@@ -312,8 +312,8 @@ srv_g_scatterplot <- function(id,
     plot_q <- debounce(reactive({
       req(anl_q())
       # nolint start
-      xlim <- xrange_slider()$value
-      ylim <- yrange_slider()$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
index 89d29d65..be911115 100644
--- a/R/tm_g_gh_spaghettiplot.R
+++ b/R/tm_g_gh_spaghettiplot.R
@@ -396,11 +396,10 @@ srv_g_spaghettiplot <- function(id,
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    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)
+    yrange_slider <- toggle_slider_server("yrange_scale")
     observe({
-      y_slider_state <- keep_slider_state_updated(
-        intial_state = y_slider_state,
+      yrange_slider <- keep_slider_state_updated(
+        state = yrange_slider,
         varname = input$yaxis_var,
         paramname = input$xaxis_param,
         ANL = anl_q()$ANL
@@ -430,7 +429,7 @@ srv_g_spaghettiplot <- function(id,
       teal::validate_inputs(iv_r())
       req(anl_q())
       # nolint start
-      ylim <- yrange_slider()$value
+      ylim <- yrange_slider$value
       facet_ncol <- input$facet_ncol
       facet_scales <- ifelse(input$free_x, "free_x", "fixed")
 
diff --git a/R/toggleable_slider.R b/R/toggleable_slider.R
index c0e987da..a4968683 100644
--- a/R/toggleable_slider.R
+++ b/R/toggleable_slider.R
@@ -8,46 +8,7 @@
 #' @param id `character` module id
 #' @param label `label` label for input field, e.g. slider or numeric inputs
 #' @param ... additional parameters to pass to `sliderInput`
-#' @param initial_state `reactiveValues` list with min, max, step, value and change_counter.
-#' `initial_state` provides the initial state for the slider and the numeric inputs,
-#' it can also help to reset the states from outside the shiny module.
-#' Check the `keep_slider_state_updated` for a common way to reset the slider state.
-#' min - The min range of the slider.
-#' max - The max range of the slider.
-#' step - The step size of the slider and numericInput.
-#' value - The selected values of the slider.
-#' change_counter - A counter to make sure that we also reset the slider even if the previous and current state is same.
 #'
-#' @examples
-#'
-#' # use non-exported function from teal.goshawk
-#' toggle_slider_ui <- getFromNamespace("toggle_slider_ui", "teal.goshawk")
-#' toggle_slider_server <- getFromNamespace("toggle_slider_server", "teal.goshawk")
-#'
-#' ui <- fluidPage(
-#'   shinyjs::useShinyjs(),
-#'   toggle_slider_ui(
-#'     "toggle_slider", "Select value"
-#'   ),
-#'   verbatimTextOutput("value")
-#' )
-#'
-#' server <- function(input, output, session) {
-#'   init_state <- reactiveValues(min = 0, max = 10, value = c(3, 6), step = 0.5, change_counter = 0)
-#'   range_value <- toggle_slider_server("toggle_slider", init_state)
-#'   messages <- reactiveVal() #' to keep history
-#'   observeEvent(range_value(), {
-#'     list_with_names_str <- function(x) paste(names(x), x, sep = ": ", collapse = ", ")
-#'     messages(c(messages(), list_with_names_str(range_value())))
-#'   })
-#'   output$value <- renderText({
-#'     paste(messages(), collapse = "\n")
-#'   })
-#' }
-#'
-#' if (interactive()) {
-#'   shinyApp(ui, server)
-#' }
 #' @name toggle_slider
 #' @keywords internal
 #' @return `NULL`.
@@ -84,43 +45,39 @@ toggle_slider_ui <- function(id, label) {
 
 #' @keywords internal
 #' @rdname toggle_slider
-toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
+toggle_slider_server <- function(id, ...) {
   moduleServer(id, function(input, output, session) {
-    selected_state <- reactiveVal(NULL)
-    slider_update_state <- reactiveVal(NULL)
+    state <- reactiveValues(
+      min = NULL,
+      max = NULL,
+      value = NULL,
+      step = NULL,
+      slider = NULL,
+      data_range = NULL
+    )
     slider_shown <- reactive(input$toggle %% 2 == 0)
 
-    observeEvent(initial_state$change_counter, {
-      selected_state(
-        list(
-          min = initial_state$min,
-          max = initial_state$max,
-          step = initial_state$step,
-          value = initial_state$value
-        )
-      )
-      slider_update_state(
-        list(
-          min = initial_state$min,
-          max = initial_state$max,
-          step = initial_state$step,
-          value = initial_state$value,
-          change_counter = initial_state$change_counter
-        )
-      )
+    observeEvent(state$data_range, {
+      state$min <- state$slider$min
+      state$max <- state$slider$max
+      state$step <- state$slider$step
+      state$value <- state$slider$value
+      updateNumericInput(session, "value_low", value = state$slider$value[1])
+      updateNumericInput(session, "value_high", value = state$slider$value[2])
     })
 
     output$slider_view <- renderUI({
-      req(slider_update_state())
+      req(state$slider)
+
       tags$div(
         class = "teal-goshawk toggle-slider-container",
         sliderInput(
           inputId = session$ns("slider"),
           label = NULL,
-          min = slider_update_state()$min,
-          max = slider_update_state()$max,
-          value = slider_update_state()$value,
-          step = slider_update_state()$step,
+          min = state$slider$min,
+          max = state$slider$max,
+          value = state$slider$value,
+          step = state$slider$step,
           ticks = TRUE,
           ...
         ),
@@ -155,44 +112,28 @@ toggle_slider_server <- function(id, initial_state, print = FALSE, ...) {
 
     observeEvent(input$slider, {
       if (slider_shown()) {
-        selected_state(
-          list(
-            min = selected_state()$min,
-            max = selected_state()$max,
-            value = input$slider
-          )
-        )
-        updateNumericInput(session, "value_low", value = selected_state()$value[1], step = selected_state()$step)
-        updateNumericInput(session, "value_high", value = selected_state()$value[2], step = selected_state()$step)
+        state$value <- input$slider
+        updateNumericInput(session, "value_low", value = input$slider[1])
+        updateNumericInput(session, "value_high", value = input$slider[2])
       }
     })
 
     observeEvent(c(input$value_low, input$value_high), ignoreInit = TRUE, {
       if (!slider_shown()) {
-        selected_state(
-          list(
-            min = min(initial_state$min, input$value_low),
-            max = max(initial_state$max, input$value_high),
-            value = c(input$value_low, input$value_high)
-          )
-        )
-        slider_update_state(
-          list(
-            min = selected_state()$min,
-            max = selected_state()$max,
-            value = selected_state()$value
-          )
-        )
+        state$min <- min(state$data_range$min, input$value_low)
+        state$max <- max(state$data_range$max, input$value_high)
+        state$value <- c(input$value_low, input$value_high)
+        state$slider <- list(min = state$min, max = state$max, value = state$value)
       }
     })
 
-    return(selected_state)
+    return(state)
   })
 }
 
 #' @keywords internal
 #' @rdname toggle_slider
-keep_slider_state_updated <- function(intial_state, varname, paramname, ANL, trt_group = NULL, step = NULL) { # nolint object_name_linter
+keep_slider_state_updated <- function(state, varname, paramname, ANL, trt_group = NULL, step = NULL) { # nolint object_name_linter
   validate(need(varname, "Please select variable"))
   validate(need(paramname, "Please select variable"))
   req(length(paramname) == 1)
@@ -211,10 +152,12 @@ keep_slider_state_updated <- function(intial_state, varname, paramname, ANL, trt
     minmax <- c(0, round(dmax * 1.2, 5))
     step <- round(dmax / 100, 5)
   }
-  intial_state$min <- minmax[[1]]
-  intial_state$max <- minmax[[2]]
-  intial_state$step <- step
-  intial_state$value <- minmax
-  intial_state$change_counter <- isolate(intial_state$change_counter) + 1
-  intial_state
+  state$slider <- list(
+    min = minmax[[1]],
+    max = minmax[[2]],
+    step = step,
+    value = minmax
+  )
+  state$data_range <- list(min = minmax[[1]], max = minmax[[2]])
+  state
 }
diff --git a/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R b/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R
index 06f33160..8f6542ed 100644
--- a/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R
+++ b/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R
@@ -100,5 +100,6 @@ sets proper sliderInput and numericInput values",
         value = c(new_range[1], new_range[2])
       )
     )
+    app_driver$stop()
   }
 )

From d123a2bf1791e346a1493e4322a1473abab01667 Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Fri, 25 Oct 2024 14:29:44 +0530
Subject: [PATCH 08/16] chore: fix test warning

---
 tests/testthat/test-shinytest2-tm_g_gh_boxplot.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R b/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R
index 8f6542ed..92020a1b 100644
--- a/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R
+++ b/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R
@@ -20,7 +20,7 @@ app_driver <- init_teal_app_driver(
 )
 
 testthat::test_that("toggle_slider_module: widgets are initialized with proper values", {
-  app_driver$click(selector = ".panel-title")
+  app_driver$click(selector = ".well .panel-group > div:first-of-type > .panel > .panel-heading")
   init_values <- list(min = 0, max = 55, value = c(0, 55))
   check_if_widgets_match(app_driver)
   check_widgets_with_value(app_driver, init_values)

From 8fd75adbe9fcd684c12af898e4a488d92f4f29ad Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Fri, 25 Oct 2024 19:00:28 +0530
Subject: [PATCH 09/16] chore: remove unwanted checks

---
 R/toggleable_slider.R | 24 ++++++++++--------------
 1 file changed, 10 insertions(+), 14 deletions(-)

diff --git a/R/toggleable_slider.R b/R/toggleable_slider.R
index a4968683..63eff7f2 100644
--- a/R/toggleable_slider.R
+++ b/R/toggleable_slider.R
@@ -55,7 +55,6 @@ toggle_slider_server <- function(id, ...) {
       slider = NULL,
       data_range = NULL
     )
-    slider_shown <- reactive(input$toggle %% 2 == 0)
 
     observeEvent(state$data_range, {
       state$min <- state$slider$min
@@ -106,25 +105,22 @@ toggle_slider_server <- function(id, ...) {
     })
 
     observeEvent(input$toggle, {
-      shinyjs::toggle("slider_view", condition = slider_shown())
-      shinyjs::toggle("numeric_view", condition = !slider_shown())
+      slider_shown <- input$toggle %% 2 == 0
+      shinyjs::toggle("slider_view", condition = slider_shown)
+      shinyjs::toggle("numeric_view", condition = !slider_shown)
     })
 
     observeEvent(input$slider, {
-      if (slider_shown()) {
-        state$value <- input$slider
-        updateNumericInput(session, "value_low", value = input$slider[1])
-        updateNumericInput(session, "value_high", value = input$slider[2])
-      }
+      state$value <- input$slider
+      updateNumericInput(session, "value_low", value = input$slider[1])
+      updateNumericInput(session, "value_high", value = input$slider[2])
     })
 
     observeEvent(c(input$value_low, input$value_high), ignoreInit = TRUE, {
-      if (!slider_shown()) {
-        state$min <- min(state$data_range$min, input$value_low)
-        state$max <- max(state$data_range$max, input$value_high)
-        state$value <- c(input$value_low, input$value_high)
-        state$slider <- list(min = state$min, max = state$max, value = state$value)
-      }
+      state$min <- min(state$data_range$min, input$value_low)
+      state$max <- max(state$data_range$max, input$value_high)
+      state$value <- c(input$value_low, input$value_high)
+      state$slider <- list(min = state$min, max = state$max, value = state$value)
     })
 
     return(state)

From 427418a6025d36b9c40215cf7441d6e3dae40ff6 Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Fri, 25 Oct 2024 19:00:34 +0530
Subject: [PATCH 10/16] chore: update docs

---
 man/toggle_slider.Rd | 45 ++------------------------------------------
 1 file changed, 2 insertions(+), 43 deletions(-)

diff --git a/man/toggle_slider.Rd b/man/toggle_slider.Rd
index 4dcbe374..e973eca9 100644
--- a/man/toggle_slider.Rd
+++ b/man/toggle_slider.Rd
@@ -9,10 +9,10 @@
 \usage{
 toggle_slider_ui(id, label)
 
-toggle_slider_server(id, initial_state, print = FALSE, ...)
+toggle_slider_server(id, ...)
 
 keep_slider_state_updated(
-  intial_state,
+  state,
   varname,
   paramname,
   ANL,
@@ -25,16 +25,6 @@ keep_slider_state_updated(
 
 \item{label}{\code{label} label for input field, e.g. slider or numeric inputs}
 
-\item{initial_state}{\code{reactiveValues} list with min, max, step, value and change_counter.
-\code{initial_state} provides the initial state for the slider and the numeric inputs,
-it can also help to reset the states from outside the shiny module.
-Check the \code{keep_slider_state_updated} for a common way to reset the slider state.
-min - The min range of the slider.
-max - The max range of the slider.
-step - The step size of the slider and numericInput.
-value - The selected values of the slider.
-change_counter - A counter to make sure that we also reset the slider even if the previous and current state is same.}
-
 \item{...}{additional parameters to pass to \code{sliderInput}}
 }
 \value{
@@ -45,35 +35,4 @@ This is useful when a slider should be shown, but it is sometimes hard to config
 so one can toggle to one or two numeric input fields to set slider instead.
 The toggle button will show two numeric input field for selecting the from and to range.
 }
-\examples{
-
-# use non-exported function from teal.goshawk
-toggle_slider_ui <- getFromNamespace("toggle_slider_ui", "teal.goshawk")
-toggle_slider_server <- getFromNamespace("toggle_slider_server", "teal.goshawk")
-
-ui <- fluidPage(
-  shinyjs::useShinyjs(),
-  toggle_slider_ui(
-    "toggle_slider", "Select value"
-  ),
-  verbatimTextOutput("value")
-)
-
-server <- function(input, output, session) {
-  init_state <- reactiveValues(min = 0, max = 10, value = c(3, 6), step = 0.5, change_counter = 0)
-  range_value <- toggle_slider_server("toggle_slider", init_state)
-  messages <- reactiveVal() #' to keep history
-  observeEvent(range_value(), {
-    list_with_names_str <- function(x) paste(names(x), x, sep = ": ", collapse = ", ")
-    messages(c(messages(), list_with_names_str(range_value())))
-  })
-  output$value <- renderText({
-    paste(messages(), collapse = "\n")
-  })
-}
-
-if (interactive()) {
-  shinyApp(ui, server)
-}
-}
 \keyword{internal}

From 05be09ade6af9e7c3ad1c10b0472ae0c4ffa1ca7 Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Fri, 25 Oct 2024 19:06:16 +0530
Subject: [PATCH 11/16] revert: retain condition when observing numeric inputs

---
 R/toggleable_slider.R | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/R/toggleable_slider.R b/R/toggleable_slider.R
index 63eff7f2..19c439fc 100644
--- a/R/toggleable_slider.R
+++ b/R/toggleable_slider.R
@@ -55,6 +55,7 @@ toggle_slider_server <- function(id, ...) {
       slider = NULL,
       data_range = NULL
     )
+    slider_shown <- reactive(input$toggle %% 2 == 0)
 
     observeEvent(state$data_range, {
       state$min <- state$slider$min
@@ -105,9 +106,8 @@ toggle_slider_server <- function(id, ...) {
     })
 
     observeEvent(input$toggle, {
-      slider_shown <- input$toggle %% 2 == 0
-      shinyjs::toggle("slider_view", condition = slider_shown)
-      shinyjs::toggle("numeric_view", condition = !slider_shown)
+      shinyjs::toggle("slider_view", condition = slider_shown())
+      shinyjs::toggle("numeric_view", condition = !slider_shown())
     })
 
     observeEvent(input$slider, {
@@ -117,10 +117,12 @@ toggle_slider_server <- function(id, ...) {
     })
 
     observeEvent(c(input$value_low, input$value_high), ignoreInit = TRUE, {
-      state$min <- min(state$data_range$min, input$value_low)
-      state$max <- max(state$data_range$max, input$value_high)
-      state$value <- c(input$value_low, input$value_high)
-      state$slider <- list(min = state$min, max = state$max, value = state$value)
+      if (!slider_shown()) {
+        state$min <- min(state$data_range$min, input$value_low)
+        state$max <- max(state$data_range$max, input$value_high)
+        state$value <- c(input$value_low, input$value_high)
+        state$slider <- list(min = state$min, max = state$max, value = state$value)
+      }
     })
 
     return(state)

From 07590a53f2aeb1b9dfbd0a3cb755775240be9b57 Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Mon, 28 Oct 2024 13:14:12 +0530
Subject: [PATCH 12/16] chore: remove unwanted assignment

---
 R/tm_g_gh_boxplot.R                   | 2 +-
 R/tm_g_gh_correlationplot.R           | 4 ++--
 R/tm_g_gh_density_distribution_plot.R | 4 ++--
 R/tm_g_gh_scatterplot.R               | 4 ++--
 R/tm_g_gh_spaghettiplot.R             | 2 +-
 5 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/R/tm_g_gh_boxplot.R b/R/tm_g_gh_boxplot.R
index 5fdc35e1..b8f6b60b 100644
--- a/R/tm_g_gh_boxplot.R
+++ b/R/tm_g_gh_boxplot.R
@@ -341,7 +341,7 @@ srv_g_boxplot <- function(id,
     # update sliders for axes taking constraints into account
     yrange_slider_state <- toggle_slider_server("yrange_scale")
     observe({
-      yrange_slider_state <- keep_slider_state_updated(
+      keep_slider_state_updated(
         state = yrange_slider_state,
         varname = input$yaxis_var,
         paramname = input$xaxis_param,
diff --git a/R/tm_g_gh_correlationplot.R b/R/tm_g_gh_correlationplot.R
index b6ae551f..74397a26 100644
--- a/R/tm_g_gh_correlationplot.R
+++ b/R/tm_g_gh_correlationplot.R
@@ -601,7 +601,7 @@ srv_g_correlationplot <- function(id,
     yrange_slider <- toggle_slider_server("yrange_scale")
 
     observe({
-      xrange_slider <- keep_slider_state_updated(
+      keep_slider_state_updated(
         state = xrange_slider,
         varname = input$xaxis_var,
         paramname = input$xaxis_param,
@@ -609,7 +609,7 @@ srv_g_correlationplot <- function(id,
       )
     })
     observe({
-      yrange_slider <- keep_slider_state_updated(
+      keep_slider_state_updated(
         state = yrange_slider,
         varname = input$yaxis_var,
         paramname = input$yaxis_param,
diff --git a/R/tm_g_gh_density_distribution_plot.R b/R/tm_g_gh_density_distribution_plot.R
index d39dd327..18aa935b 100644
--- a/R/tm_g_gh_density_distribution_plot.R
+++ b/R/tm_g_gh_density_distribution_plot.R
@@ -285,7 +285,7 @@ srv_g_density_distribution_plot <- function(id, # nolint
     yrange_slider <- toggle_slider_server("yrange_scale")
 
     observe({
-      xrange_slider <- keep_slider_state_updated(
+      keep_slider_state_updated(
         state = xrange_slider,
         varname = input$xaxis_var,
         paramname = input$xaxis_param,
@@ -293,7 +293,7 @@ srv_g_density_distribution_plot <- function(id, # nolint
       )
     })
     observe({
-      yrange_slider <- keep_slider_state_updated(
+      keep_slider_state_updated(
         state = yrange_slider,
         varname = input$xaxis_var,
         paramname = input$xaxis_param,
diff --git a/R/tm_g_gh_scatterplot.R b/R/tm_g_gh_scatterplot.R
index 38e9fbd1..ecfd63c3 100644
--- a/R/tm_g_gh_scatterplot.R
+++ b/R/tm_g_gh_scatterplot.R
@@ -290,7 +290,7 @@ srv_g_scatterplot <- function(id,
     yrange_slider <- toggle_slider_server("yrange_scale")
 
     observe({
-      xrange_slider <- keep_slider_state_updated(
+      keep_slider_state_updated(
         state = xrange_slider,
         varname = input$xaxis_var,
         paramname = input$xaxis_param,
@@ -298,7 +298,7 @@ srv_g_scatterplot <- function(id,
       )
     })
     observe({
-      yrange_slider <- keep_slider_state_updated(
+      keep_slider_state_updated(
         state = yrange_slider,
         varname = input$yaxis_var,
         paramname = input$xaxis_param,
diff --git a/R/tm_g_gh_spaghettiplot.R b/R/tm_g_gh_spaghettiplot.R
index be911115..64dfd95c 100644
--- a/R/tm_g_gh_spaghettiplot.R
+++ b/R/tm_g_gh_spaghettiplot.R
@@ -398,7 +398,7 @@ srv_g_spaghettiplot <- function(id,
     # update sliders for axes taking constraints into account
     yrange_slider <- toggle_slider_server("yrange_scale")
     observe({
-      yrange_slider <- keep_slider_state_updated(
+      keep_slider_state_updated(
         state = yrange_slider,
         varname = input$yaxis_var,
         paramname = input$xaxis_param,

From dcdcd82a8976bf6e299829590b5c424ba5ebe746 Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Mon, 28 Oct 2024 12:29:52 +0100
Subject: [PATCH 13/16] reorg

---
 R/toggleable_slider.R | 52 ++++++++++++++++++++-----------------------
 1 file changed, 24 insertions(+), 28 deletions(-)

diff --git a/R/toggleable_slider.R b/R/toggleable_slider.R
index 19c439fc..d9b52867 100644
--- a/R/toggleable_slider.R
+++ b/R/toggleable_slider.R
@@ -58,26 +58,26 @@ toggle_slider_server <- function(id, ...) {
     slider_shown <- reactive(input$toggle %% 2 == 0)
 
     observeEvent(state$data_range, {
-      state$min <- state$slider$min
-      state$max <- state$slider$max
-      state$step <- state$slider$step
-      state$value <- state$slider$value
-      updateNumericInput(session, "value_low", value = state$slider$value[1])
-      updateNumericInput(session, "value_high", value = state$slider$value[2])
+      cat("state$date_range changed\n")
+      # cat(yaml::as.yaml(reactiveValuesToList(state)))
+      state$min <- state$data_range[1]
+      state$max <- state$data_range[2]
+      state$value <- state$data_range
+      state$step <- NULL # TODO
     })
 
     output$slider_view <- renderUI({
-      req(state$slider)
-
+      cat("renderUI triggered\n")
+      req(state$value)
       tags$div(
         class = "teal-goshawk toggle-slider-container",
         sliderInput(
           inputId = session$ns("slider"),
           label = NULL,
-          min = state$slider$min,
-          max = state$slider$max,
-          value = state$slider$value,
-          step = state$slider$step,
+          min = min(state$data_range[1], state$min),
+          max = max(state$data_range[2], state$max),
+          value = state$value,
+          step = state$step,
           ticks = TRUE,
           ...
         ),
@@ -110,18 +110,20 @@ toggle_slider_server <- function(id, ...) {
       shinyjs::toggle("numeric_view", condition = !slider_shown())
     })
 
-    observeEvent(input$slider, {
-      state$value <- input$slider
-      updateNumericInput(session, "value_low", value = input$slider[1])
-      updateNumericInput(session, "value_high", value = input$slider[2])
+    observeEvent(state$value, { # todo: change to state$value
+      cat("state$value changed\n")
+      if (!setequal(state$value, c(input$value_low, input$value_high))) {
+        cat("state differs from input updating numeric input\n")
+        updateNumericInput(session, "value_low", value = state$value[1])
+        updateNumericInput(session, "value_high", value = state$value[2])
+      }
     })
 
     observeEvent(c(input$value_low, input$value_high), ignoreInit = TRUE, {
-      if (!slider_shown()) {
-        state$min <- min(state$data_range$min, input$value_low)
-        state$max <- max(state$data_range$max, input$value_high)
-        state$value <- c(input$value_low, input$value_high)
-        state$slider <- list(min = state$min, max = state$max, value = state$value)
+      cat("input$numeric changed - updating state value\n")
+      values <- c(input$value_low, input$value_high)
+      if (all(!is.na(values))) {
+        state$value <- values
       }
     })
 
@@ -150,12 +152,6 @@ keep_slider_state_updated <- function(state, varname, paramname, ANL, trt_group
     minmax <- c(0, round(dmax * 1.2, 5))
     step <- round(dmax / 100, 5)
   }
-  state$slider <- list(
-    min = minmax[[1]],
-    max = minmax[[2]],
-    step = step,
-    value = minmax
-  )
-  state$data_range <- list(min = minmax[[1]], max = minmax[[2]])
+  state$data_range <- c(min = minmax[[1]], max = minmax[[2]])
   state
 }

From 54528bb5bda0937504f293d46c4778b376282d95 Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Mon, 28 Oct 2024 17:04:46 +0530
Subject: [PATCH 14/16] adding slider observer

---
 R/toggleable_slider.R | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/R/toggleable_slider.R b/R/toggleable_slider.R
index d9b52867..4773423b 100644
--- a/R/toggleable_slider.R
+++ b/R/toggleable_slider.R
@@ -59,7 +59,6 @@ toggle_slider_server <- function(id, ...) {
 
     observeEvent(state$data_range, {
       cat("state$date_range changed\n")
-      # cat(yaml::as.yaml(reactiveValuesToList(state)))
       state$min <- state$data_range[1]
       state$max <- state$data_range[2]
       state$value <- state$data_range
@@ -110,6 +109,10 @@ toggle_slider_server <- function(id, ...) {
       shinyjs::toggle("numeric_view", condition = !slider_shown())
     })
 
+    observeEvent(input$slider, {
+      state$value <- input$slider
+    })
+
     observeEvent(state$value, { # todo: change to state$value
       cat("state$value changed\n")
       if (!setequal(state$value, c(input$value_low, input$value_high))) {

From 118fc937344004721cf1aedd822c5a4457cd13ba Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Mon, 28 Oct 2024 18:36:28 +0530
Subject: [PATCH 15/16] fix: simplified changes during the call and fixed tests

---
 R/toggleable_slider.R                         | 104 ++++++++----------
 tests/testthat/helper-toggle-slider-utils.R   |  43 ++++----
 .../test-shinytest2-tm_g_gh_boxplot.R         |  10 +-
 3 files changed, 75 insertions(+), 82 deletions(-)

diff --git a/R/toggleable_slider.R b/R/toggleable_slider.R
index 4773423b..814e7a2d 100644
--- a/R/toggleable_slider.R
+++ b/R/toggleable_slider.R
@@ -24,22 +24,7 @@ toggle_slider_ui <- function(id, label) {
       tags$span(tags$strong(label)),
       tags$div(actionButton(ns("toggle"), "Toggle", class = "btn-xs"))
     ),
-    uiOutput(ns("slider_view")),
-    shinyjs::hidden(
-      tags$div(
-        id = ns("numeric_view"),
-        numericInput(
-          ns("value_low"),
-          "From:",
-          value = 0
-        ),
-        numericInput(
-          ns("value_high"),
-          "- to:",
-          value = 0
-        )
-      )
-    )
+    uiOutput(ns("inputs"))
   )
 }
 
@@ -52,36 +37,33 @@ toggle_slider_server <- function(id, ...) {
       max = NULL,
       value = NULL,
       step = NULL,
-      slider = NULL,
       data_range = NULL
     )
     slider_shown <- reactive(input$toggle %% 2 == 0)
 
     observeEvent(state$data_range, {
-      cat("state$date_range changed\n")
       state$min <- state$data_range[1]
       state$max <- state$data_range[2]
       state$value <- state$data_range
-      state$step <- NULL # TODO
     })
 
-    output$slider_view <- renderUI({
-      cat("renderUI triggered\n")
+    output$inputs <- renderUI({
       req(state$value)
-      tags$div(
-        class = "teal-goshawk toggle-slider-container",
-        sliderInput(
-          inputId = session$ns("slider"),
-          label = NULL,
-          min = min(state$data_range[1], state$min),
-          max = max(state$data_range[2], state$max),
-          value = state$value,
-          step = state$step,
-          ticks = TRUE,
-          ...
-        ),
-        tags$script(HTML(sprintf(
-          '
+      if (slider_shown()) {
+        tags$div(
+          class = "teal-goshawk toggle-slider-container",
+          sliderInput(
+            inputId = session$ns("slider"),
+            label = NULL,
+            min = min(state$data_range[1], state$min),
+            max = max(state$data_range[2], state$max),
+            value = state$value,
+            step = state$step,
+            ticks = TRUE,
+            ...
+          ),
+          tags$script(HTML(sprintf(
+            '
           $(".teal-goshawk.toggle-slider-container #%s").ready(function () {
             var tickLabel = document.querySelector(
               ".teal-goshawk.toggle-slider-container .irs-grid-text.js-grid-text-9"
@@ -99,34 +81,43 @@ toggle_slider_server <- function(id, ...) {
             }
           });
         ',
-          session$ns("slider")
-        )))
-      )
-    })
-
-    observeEvent(input$toggle, {
-      shinyjs::toggle("slider_view", condition = slider_shown())
-      shinyjs::toggle("numeric_view", condition = !slider_shown())
+            session$ns("slider")
+          )))
+        )
+      } else {
+        tags$div(
+          class = "teal-goshawk toggle-slider-container",
+          numericInput(
+            inputId = session$ns("value_low"),
+            label = "From:",
+            value = state$value[1]
+          ),
+          numericInput(
+            inputId = session$ns("value_high"),
+            label = "to:",
+            value = state$value[2]
+          )
+        )
+      }
     })
 
-    observeEvent(input$slider, {
-      state$value <- input$slider
-    })
+    d_slider <- debounce(reactive(input$slider), 500)
 
-    observeEvent(state$value, { # todo: change to state$value
-      cat("state$value changed\n")
-      if (!setequal(state$value, c(input$value_low, input$value_high))) {
-        cat("state differs from input updating numeric input\n")
-        updateNumericInput(session, "value_low", value = state$value[1])
-        updateNumericInput(session, "value_high", value = state$value[2])
+    observeEvent(d_slider(), {
+      if (!setequal(state$value, d_slider())) {
+        state$value <- d_slider()
       }
     })
 
-    observeEvent(c(input$value_low, input$value_high), ignoreInit = TRUE, {
-      cat("input$numeric changed - updating state value\n")
+    d_value_low <- debounce(reactive(input$value_low), 500)
+    d_value_high <- debounce(reactive(input$value_high), 500)
+
+    observeEvent(c(d_value_low(), d_value_high()), ignoreInit = TRUE, {
       values <- c(input$value_low, input$value_high)
-      if (all(!is.na(values))) {
+      if (!setequal(state$value, values)) {
         state$value <- values
+        state$min <- values[1]
+        state$max <- values[2]
       }
     })
 
@@ -156,5 +147,6 @@ keep_slider_state_updated <- function(state, varname, paramname, ANL, trt_group
     step <- round(dmax / 100, 5)
   }
   state$data_range <- c(min = minmax[[1]], max = minmax[[2]])
-  state
+  state$step <- step
+  invisible(NULL)
 }
diff --git a/tests/testthat/helper-toggle-slider-utils.R b/tests/testthat/helper-toggle-slider-utils.R
index ffac8db4..b893a02f 100644
--- a/tests/testthat/helper-toggle-slider-utils.R
+++ b/tests/testthat/helper-toggle-slider-utils.R
@@ -4,7 +4,7 @@ click_toggle_button <- function(app) {
 
 #' Extract the values and the ranges from the UI for the slider
 get_ui_slider_values <- function(app) {
-  id <- NS(app$active_ns()$module, "yrange_scale-slider_view")
+  id <- NS(app$active_ns()$module, "yrange_scale-inputs")
   # Note that the values can only be observed once they are visible
   if (!is_slider_visible(app)) {
     click_toggle_button(app)
@@ -19,14 +19,16 @@ get_ui_slider_values <- function(app) {
   )
 }
 
-#' Checking if the sliderInput and the numericInputs match
-check_if_widgets_match <- function(app) {
-  testthat::expect_identical(
-    app$get_active_module_input("yrange_scale-slider"),
-    c(
-      app$get_active_module_input("yrange_scale-value_low"),
-      app$get_active_module_input("yrange_scale-value_high")
-    )
+#' Extract the values and the ranges from the numeric widgets
+get_numeric_values <- function(app) {
+  id <- NS(app$active_ns()$module, "yrange_scale-inputs")
+  # Note that the values can only be observed once they are visible
+  if (is_slider_visible(app)) {
+    click_toggle_button(app)
+  }
+  c(
+    app$get_active_module_input("yrange_scale-value_low"),
+    app$get_active_module_input("yrange_scale-value_high")
   )
 }
 
@@ -38,14 +40,11 @@ check_widgets_with_value <- function(app, values) {
   checkmate::assert_names(names(values), must.include = c("min", "max", "value"))
   checkmate::assert_numeric(values$value, len = 2)
   slider_values <- get_ui_slider_values(app)
+  numeric_values <- get_numeric_values(app)
   testthat::expect_identical(slider_values, values)
-  testthat::expect_identical(
-    app$get_active_module_input("yrange_scale-value_low"),
-    as.integer(values$value[1])
-  )
-  testthat::expect_identical(
-    app$get_active_module_input("yrange_scale-value_high"),
-    as.integer(values$value[2])
+  testthat::expect_setequal(
+    numeric_values,
+    values$value
   )
 }
 
@@ -61,8 +60,8 @@ set_slider_values <- function(app, values) {
   if (!is_slider_visible(app)) {
     click_toggle_button(app)
   }
-  app$set_input(
-    NS(app$active_ns()$module, "yrange_scale-slider"),
+  app$set_active_module_input(
+    "yrange_scale-slider",
     values,
     wait_ = FALSE
   )
@@ -76,13 +75,13 @@ set_numeric_input_values <- function(app, values) {
   if (is_slider_visible(app)) {
     click_toggle_button(app)
   }
-  app$set_input(
-    NS(app$active_ns()$module, "yrange_scale-value_low"),
+  app$set_active_module_input(
+    "yrange_scale-value_low",
     values[1],
     wait_ = FALSE
   )
-  app$set_input(
-    NS(app$active_ns()$module, "yrange_scale-value_high"),
+  app$set_active_module_input(
+    "yrange_scale-value_high",
     values[2],
     wait_ = FALSE
   )
diff --git a/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R b/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R
index 92020a1b..93d11b17 100644
--- a/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R
+++ b/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R
@@ -19,18 +19,20 @@ app_driver <- init_teal_app_driver(
   )
 )
 
+app_driver$view()
 testthat::test_that("toggle_slider_module: widgets are initialized with proper values", {
   app_driver$click(selector = ".well .panel-group > div:first-of-type > .panel > .panel-heading")
   init_values <- list(min = 0, max = 55, value = c(0, 55))
-  check_if_widgets_match(app_driver)
   check_widgets_with_value(app_driver, init_values)
 })
 
 
 testthat::test_that("toggle_slider_module: changing the sliderInput sets proper numericInput values", {
-  new_value <- c(12, 50)
-  set_slider_values(app_driver, new_value)
-  check_if_widgets_match(app_driver)
+  set_slider_values(app_driver, c(1, 50))
+  check_widgets_with_value(
+    app_driver,
+    list(min = 0, max = 55, value = c(1, 50))
+  )
 })
 
 testthat::test_that(

From 8182ce70f6a775ea3a78c610033f8d23065f4962 Mon Sep 17 00:00:00 2001
From: vedhav <vedhaviyash4@gmail.com>
Date: Mon, 28 Oct 2024 19:20:50 +0530
Subject: [PATCH 16/16] feat: pass the data states as a reactive

---
 R/tm_g_gh_boxplot.R                           |  7 +-
 R/tm_g_gh_correlationplot.R                   | 15 ++---
 R/tm_g_gh_density_distribution_plot.R         | 15 ++---
 R/tm_g_gh_lineplot.R                          | 16 ++---
 R/tm_g_gh_scatterplot.R                       | 15 ++---
 R/tm_g_gh_spaghettiplot.R                     |  7 +-
 R/toggleable_slider.R                         | 64 +++++++++----------
 .../test-shinytest2-tm_g_gh_boxplot.R         |  2 -
 8 files changed, 62 insertions(+), 79 deletions(-)

diff --git a/R/tm_g_gh_boxplot.R b/R/tm_g_gh_boxplot.R
index b8f6b60b..7f95d04b 100644
--- a/R/tm_g_gh_boxplot.R
+++ b/R/tm_g_gh_boxplot.R
@@ -339,15 +339,14 @@ srv_g_boxplot <- function(id,
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    yrange_slider_state <- toggle_slider_server("yrange_scale")
-    observe({
-      keep_slider_state_updated(
-        state = yrange_slider_state,
+    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")
diff --git a/R/tm_g_gh_correlationplot.R b/R/tm_g_gh_correlationplot.R
index 74397a26..36f15f0b 100644
--- a/R/tm_g_gh_correlationplot.R
+++ b/R/tm_g_gh_correlationplot.R
@@ -597,25 +597,22 @@ 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")
-
-    observe({
-      keep_slider_state_updated(
-        state = xrange_slider,
+    data_state_x <- reactive({
+      get_data_range_states(
         varname = input$xaxis_var,
         paramname = input$xaxis_param,
         ANL = anl_constraint()$ANL
       )
     })
-    observe({
-      keep_slider_state_updated(
-        state = yrange_slider,
+    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")
 
diff --git a/R/tm_g_gh_density_distribution_plot.R b/R/tm_g_gh_density_distribution_plot.R
index 18aa935b..1227bca6 100644
--- a/R/tm_g_gh_density_distribution_plot.R
+++ b/R/tm_g_gh_density_distribution_plot.R
@@ -281,26 +281,23 @@ 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")
-
-    observe({
-      keep_slider_state_updated(
-        state = xrange_slider,
+    data_state_x <- reactive({
+      get_data_range_states(
         varname = input$xaxis_var,
         paramname = input$xaxis_param,
         ANL = anl_q()$ANL
       )
     })
-    observe({
-      keep_slider_state_updated(
-        state = yrange_slider,
+    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")
 
diff --git a/R/tm_g_gh_lineplot.R b/R/tm_g_gh_lineplot.R
index ea933a24..044419ed 100644
--- a/R/tm_g_gh_lineplot.R
+++ b/R/tm_g_gh_lineplot.R
@@ -401,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({
@@ -420,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"))
 
@@ -433,7 +431,7 @@ srv_lineplot <- function(id,
         NULL
       }
 
-      # we don't need to additionally filter for paramvar here as in keep_slider_state_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)) %>%
@@ -460,16 +458,14 @@ srv_lineplot <- function(id,
         f = 0.05
       )
 
-      # we don't use keep_slider_state_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
-      yrange_slider$slider <- list(
-        min = minmax[[1]],
-        max = minmax[[2]],
-        value = minmax
+      list(
+        range = c(min = minmax[[1]], max = minmax[[2]])
       )
-      yrange_slider$data_range <- list(min = minmax[[1]], max = minmax[[2]])
     })
+    yrange_slider <- toggle_slider_server("yrange_scale", data_state)
 
     line_color_defaults <- color_manual
     line_type_defaults <- c(
diff --git a/R/tm_g_gh_scatterplot.R b/R/tm_g_gh_scatterplot.R
index ecfd63c3..da82442f 100644
--- a/R/tm_g_gh_scatterplot.R
+++ b/R/tm_g_gh_scatterplot.R
@@ -286,25 +286,22 @@ 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")
-
-    observe({
-      keep_slider_state_updated(
-        state = xrange_slider,
+    data_state_x <- reactive({
+      get_data_range_states(
         varname = input$xaxis_var,
         paramname = input$xaxis_param,
         ANL = anl_q()$ANL
       )
     })
-    observe({
-      keep_slider_state_updated(
-        state = yrange_slider,
+    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")
 
diff --git a/R/tm_g_gh_spaghettiplot.R b/R/tm_g_gh_spaghettiplot.R
index 64dfd95c..48379ef8 100644
--- a/R/tm_g_gh_spaghettiplot.R
+++ b/R/tm_g_gh_spaghettiplot.R
@@ -396,15 +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")
-    observe({
-      keep_slider_state_updated(
-        state = yrange_slider,
+    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")
diff --git a/R/toggleable_slider.R b/R/toggleable_slider.R
index 814e7a2d..c946dc3b 100644
--- a/R/toggleable_slider.R
+++ b/R/toggleable_slider.R
@@ -30,21 +30,19 @@ toggle_slider_ui <- function(id, label) {
 
 #' @keywords internal
 #' @rdname toggle_slider
-toggle_slider_server <- function(id, ...) {
+toggle_slider_server <- function(id, data_state, ...) {
   moduleServer(id, function(input, output, session) {
     state <- reactiveValues(
       min = NULL,
       max = NULL,
-      value = NULL,
-      step = NULL,
-      data_range = NULL
+      value = NULL
     )
     slider_shown <- reactive(input$toggle %% 2 == 0)
 
-    observeEvent(state$data_range, {
-      state$min <- state$data_range[1]
-      state$max <- state$data_range[2]
-      state$value <- state$data_range
+    observeEvent(data_state()$range, {
+      state$min <- data_state()$range[1]
+      state$max <- data_state()$range[2]
+      state$value <- data_state()$range
     })
 
     output$inputs <- renderUI({
@@ -55,32 +53,32 @@ toggle_slider_server <- function(id, ...) {
           sliderInput(
             inputId = session$ns("slider"),
             label = NULL,
-            min = min(state$data_range[1], state$min),
-            max = max(state$data_range[2], state$max),
+            min = min(data_state()$range[1], state$min),
+            max = max(data_state()$range[2], state$max),
             value = state$value,
-            step = state$step,
+            step = data_state()$step,
             ticks = TRUE,
             ...
           ),
           tags$script(HTML(sprintf(
             '
-          $(".teal-goshawk.toggle-slider-container #%s").ready(function () {
-            var tickLabel = document.querySelector(
-              ".teal-goshawk.toggle-slider-container .irs-grid-text.js-grid-text-9"
-            );
-            var tick = document.querySelector(
-              ".teal-goshawk.toggle-slider-container .irs-grid-pol:nth-last-child(6)"
-            );
-            if (tickLabel) {
-              if (parseFloat(tickLabel.style.left) > 95) {
-                tickLabel.style.opacity = "0";
-                tick.style.opacity = "0";
-              }
-            } else {
-              console.log("Toggle slider element not found.");
-            }
-          });
-        ',
+              $(".teal-goshawk.toggle-slider-container #%s").ready(function () {
+                var tickLabel = document.querySelector(
+                  ".teal-goshawk.toggle-slider-container .irs-grid-text.js-grid-text-9"
+                );
+                var tick = document.querySelector(
+                  ".teal-goshawk.toggle-slider-container .irs-grid-pol:nth-last-child(6)"
+                );
+                if (tickLabel) {
+                  if (parseFloat(tickLabel.style.left) > 95) {
+                    tickLabel.style.opacity = "0";
+                    tick.style.opacity = "0";
+                  }
+                } else {
+                  console.log("Toggle slider element not found.");
+                }
+              });
+            ',
             session$ns("slider")
           )))
         )
@@ -127,10 +125,11 @@ toggle_slider_server <- function(id, ...) {
 
 #' @keywords internal
 #' @rdname toggle_slider
-keep_slider_state_updated <- function(state, varname, paramname, ANL, trt_group = NULL, step = NULL) { # nolint object_name_linter
+get_data_range_states <- function(varname, paramname, ANL, trt_group = NULL, step = NULL) { # nolint object_name_linter
   validate(need(varname, "Please select variable"))
   validate(need(paramname, "Please select variable"))
   req(length(paramname) == 1)
+  step <- NULL
 
   ANL <- ANL %>% dplyr::filter(.data$PARAMCD == paramname) # nolint object_name_linter
   validate_has_variable(ANL, varname, paste("variable", varname, "does not exist"))
@@ -146,7 +145,8 @@ keep_slider_state_updated <- function(state, varname, paramname, ANL, trt_group
     minmax <- c(0, round(dmax * 1.2, 5))
     step <- round(dmax / 100, 5)
   }
-  state$data_range <- c(min = minmax[[1]], max = minmax[[2]])
-  state$step <- step
-  invisible(NULL)
+  list(
+    range = c(min = minmax[[1]], max = minmax[[2]]),
+    step = step
+  )
 }
diff --git a/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R b/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R
index 93d11b17..4fdcdb3f 100644
--- a/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R
+++ b/tests/testthat/test-shinytest2-tm_g_gh_boxplot.R
@@ -19,14 +19,12 @@ app_driver <- init_teal_app_driver(
   )
 )
 
-app_driver$view()
 testthat::test_that("toggle_slider_module: widgets are initialized with proper values", {
   app_driver$click(selector = ".well .panel-group > div:first-of-type > .panel > .panel-heading")
   init_values <- list(min = 0, max = 55, value = c(0, 55))
   check_widgets_with_value(app_driver, init_values)
 })
 
-
 testthat::test_that("toggle_slider_module: changing the sliderInput sets proper numericInput values", {
   set_slider_values(app_driver, c(1, 50))
   check_widgets_with_value(