diff --git a/NEWS.md b/NEWS.md index 52514d0a4..3c248b997 100644 --- a/NEWS.md +++ b/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 diff --git a/R/FilterStateRange.R b/R/FilterStateRange.R index 69eeaec07..006c461e6 100644 --- a/R/FilterStateRange.R +++ b/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) }, diff --git a/tests/testthat/test-RangeFilterState.R b/tests/testthat/test-RangeFilterState.R index 9177663a2..e94227eea 100644 --- a/tests/testthat/test-RangeFilterState.R +++ b/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(