Fixes warning on choices to be thrown only after prettyfying them

NEWS.md

@@ -9,6 +9,7 @@
 ### Miscellaneous
 
 * Improve unit test coverage (#666).
+* Re-setting choices for slice only shows warning of modified choices if the post-processed range is different (#676).
 
 # teal.slice 0.7.0
 

R/FilterStateRange.R

@@ -129,7 +129,6 @@ RangeFilterState <- R6::R6Class( # nolint
 
   # public methods ----
   public = list(
-
     #' @description
     #' Initialize a `FilterState` object for range selection.
     #' @param x (`numeric`)
@@ -282,43 +281,43 @@ RangeFilterState <- R6::R6Class( # nolint
 
     set_choices = function(choices) {
       x <- private$x[is.finite(private$x)]
-      if (is.null(choices)) {
-        choices <- range(x)
+      new_choices <- if (is.null(choices)) {
+        range(x)
       } else {
         choices_adjusted <- c(max(choices[1L], min(x)), min(choices[2L], max(x)))
-        if (any(choices != choices_adjusted)) {
-          warning(sprintf(
-            "Choices adjusted (some values outside of variable range). Varname: %s, dataname: %s.",
-            private$get_varname(), private$get_dataname()
-          ))
-          choices <- choices_adjusted
-        }
-        if (choices[1L] > choices[2L]) {
+        if (choices_adjusted[1L] > choices_adjusted[2L]) {
           warning(sprintf(
             "Invalid choices: lower is higher / equal to upper, or not in range of variable values.
             Setting defaults. Varname: %s, dataname: %s.",
             private$get_varname(), private$get_dataname()
           ))
-          choices <- range(x)
+          choices_adjusted <- range(x)
         }
+        choices_adjusted
       }
 
-      private$set_is_choice_limited(private$x, choices)
-      private$x <- private$x[
-        (private$x >= choices[1L] & private$x <= choices[2L]) | is.na(private$x) | !is.finite(private$x)
-      ]
-
+      private$set_is_choice_limited(private$x, new_choices)
+      valid_range_index <- (private$x >= new_choices[1L] & private$x <= new_choices[2L])
+      private$x <- private$x[valid_range_index | !is.finite(private$x)]
       x_range <- range(private$x, finite = TRUE)
 
       # Required for displaying ticks on the slider, can modify choices!
       if (identical(diff(x_range), 0)) {
-        choices <- x_range
+        new_choices <- x_range
       } else {
         x_pretty <- pretty(x_range, 100L)
-        choices <- range(x_pretty)
+        new_choices <- range(x_pretty)
         private$numeric_step <- signif(private$get_pretty_range_step(x_pretty), digits = 10)
       }
-      private$teal_slice$choices <- choices
+      private$teal_slice$choices <- new_choices
+      # Only throw warning if pretty choices are different
+      if (!is.null(choices) && any(choices != new_choices)) {
+        warning(sprintf(
+          "Choices adjusted (some values outside of variable range). Varname: %s, dataname: %s.",
+          private$get_varname(), private$get_dataname()
+        ))
+      }
+
       invisible(NULL)
     },
 

tests/testthat/test-RangeFilterState.R

@@ -9,18 +9,79 @@ testthat::test_that("constructor accepts numerical values", {
   )
 })
 
-testthat::test_that("constructor accepts infinite values but not infinite only", {
-  testthat::expect_no_error(
-    RangeFilterState$new(c(nums, Inf, -Inf), slice = teal_slice(dataname = "data", varname = "var"))
-  )
-  testthat::expect_error(
-    RangeFilterState$new(Inf, slice = teal_slice(dataname = "data", varname = "var")),
-    "\"x\" contains no finite values"
-  )
-  testthat::expect_error(
-    RangeFilterState$new(c(Inf, NA), slice = teal_slice(dataname = "data", varname = "var")),
-    "\"x\" contains no finite values"
-  )
+testthat::describe("constructor", {
+  nums <- 1:10
+  it("accepts infinite values as part of numeric", {
+    testthat::expect_no_error(
+      RangeFilterState$new(c(nums, Inf, -Inf), slice = teal_slice(dataname = "data", varname = "var"))
+    )
+  })
+
+  it("accepts dates", {
+    range <- RangeFilterState$new(Sys.Date() + seq(0, 5, 1), slice = teal_slice(dataname = "data", varname = "var"))
+    checkmate::expect_date(shiny::isolate(range$get_state()$choices))
+  })
+
+  it("accepts POSIXt", {
+    range <- RangeFilterState$new(Sys.time() + seq(0, 5, 1), slice = teal_slice(dataname = "data", varname = "var"))
+    checkmate::expect_posixct(shiny::isolate(range$get_state()$choices))
+  })
+
+  it("accepts NA / NaN values as part of numeric", {
+    lapply(
+      list(NA, NA_integer_, NA_real_, NaN),
+      function(x) {
+        testthat::expect_no_error(
+          RangeFilterState$new(c(nums, x), slice = teal_slice(dataname = "data", varname = "var"))
+        )
+      }
+    )
+  })
+
+  it("throws error with non-numeric NA", {
+    lapply(
+      list(NA_character_, NA_complex_),
+      function(x) {
+        testthat::expect_error(
+          RangeFilterState$new(c(nums, x), slice = teal_slice(dataname = "data", varname = "var")),
+          "not '(character|complex)'"
+        )
+      }
+    )
+  })
+
+  it("throws error on any complex values", {
+    testthat::expect_error(
+      RangeFilterState$new(c(nums, 1 + 0i), slice = teal_slice(dataname = "data", varname = "var")),
+      "not 'complex'"
+    )
+  })
+
+  it("throws error on only infinite values", {
+    testthat::expect_error(
+      RangeFilterState$new(Inf, slice = teal_slice(dataname = "data", varname = "var")),
+      "\"x\" contains no finite values"
+    )
+  })
+
+  it("throws error on only NA values", {
+    lapply(
+      list(NaN, NA, NA_character_, NA_complex_, NA_integer_, NA_real_),
+      function(x) {
+        testthat::expect_error(
+          RangeFilterState$new(x, slice = teal_slice(dataname = "data", varname = "var")),
+          "Contains only missing values"
+        )
+      }
+    )
+  })
+
+  it("throws error when no finite values are present", {
+    testthat::expect_error(
+      RangeFilterState$new(c(Inf, NA), slice = teal_slice(dataname = "data", varname = "var")),
+      "\"x\" contains no finite values"
+    )
+  })
 })
 
 testthat::test_that("constructor initializes keep_inf = TRUE by default if x contains Infs", {
@@ -49,6 +110,33 @@ testthat::test_that("constructor raises error when selection is not numeric or c
   )
 })
 
+testthat::describe("constructor modifies choices", {
+  local_nums <- c(seq(1.2, 1.9, .1), 1.905)
+  it("that are automatically calculated to better fit the tick on the slider", {
+    range <- RangeFilterState$new(local_nums, slice = teal_slice(dataname = "data", varname = "var"))
+    testthat::expect_failure(
+      testthat::expect_identical(shiny::isolate(range$get_state()[["choices"]]), range(local_nums))
+    )
+  })
+
+  it("and throws warning when manually calculated with range(x)", {
+    testthat::expect_warning(
+      RangeFilterState$new(
+        local_nums,
+        slice = teal_slice(dataname = "data", varname = "var", choices = range(local_nums))
+      ),
+      "Choices adjusted"
+    )
+  })
+
+  it("and does not throw error when re-used", { # use case in teal when slice is used across modules
+    range <- RangeFilterState$new(local_nums, slice = teal_slice(dataname = "data", varname = "var"))
+    testthat::expect_no_condition(
+      RangeFilterState$new(local_nums, slice = range$get_state())
+    )
+  })
+})
+
 testthat::test_that("constructor raises error when choices is out of range", {
   testthat::expect_warning(
     RangeFilterState$new(