Custom rendering to provide manual ticks when there is <10 ticks

DESCRIPTION

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

R/tm_g_gh_boxplot.R

@@ -263,10 +263,7 @@ ui_g_boxplot <- function(id, ...) {
           title = "Plot Aesthetic Settings",
           toggle_slider_ui(
             ns("yrange_scale"),
-            label = "Y-Axis Range Zoom",
-            min = -1000000,
-            max = 1000000,
-            value = c(-1000000, 1000000)
+            label = "Y-Axis Range Zoom"
           ),
           numericInput(ns("facet_ncol"), "Number of Plots Per Row:", a$facet_ncol, min = 1),
           checkboxInput(ns("loq_legend"), "Display LoQ Legend", a$loq_legend),
@@ -342,15 +339,14 @@ srv_g_boxplot <- function(id,
     anl_q <- anl_q_output()$value
 
     # update sliders for axes taking constraints into account
-    yrange_slider <- toggle_slider_server("yrange_scale")
-    keep_range_slider_updated(
-      session,
-      input,
-      update_slider_fcn = yrange_slider$update_state,
-      id_var = "yaxis_var",
-      id_param_var = "xaxis_param",
-      reactive_ANL = anl_q
-    )
+    data_state <- reactive({
+      get_data_range_states(
+        varname = input$yaxis_var,
+        paramname = input$xaxis_param,
+        ANL = anl_q()$ANL
+      )
+    })
+    yrange_slider_state <- toggle_slider_server("yrange_scale", data_state)
     keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
 
     horizontal_line <- srv_arbitrary_lines("hline_arb")
@@ -395,7 +391,7 @@ srv_g_boxplot <- function(id,
       yaxis <- input$yaxis_var
       xaxis <- input$xaxis_var
       facet_var <- `if`(is.null(input$facet_var), "None", input$facet_var)
-      ylim <- yrange_slider$state()$value
+      ylim <- yrange_slider_state$value
       facet_ncol <- input$facet_ncol
 
       alpha <- input$alpha

R/tm_g_gh_correlationplot.R

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

R/tm_g_gh_density_distribution_plot.R

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

R/tm_g_gh_lineplot.R

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

R/tm_g_gh_scatterplot.R

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

R/tm_g_gh_spaghettiplot.R

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