feat: allows to check for different number type

insightsengineering · Feb 26, 2024 · 04c4ae6 · 04c4ae6
1 parent 830b24c
commit 04c4ae6
Show file tree

Hide file tree

Showing 2 changed files with 56 additions and 7 deletions.
diff --git a/R/utils.R b/R/utils.R
@@ -356,17 +356,32 @@ check_range_slider <- function(value,
                                lower = -Inf,
                                upper = Inf,
                                finite = TRUE,
-                               null.ok = FALSE) { # nolint: object_name.
-  is_numeric <- checkmate::test_numeric(
+                               null.ok = FALSE, # nolint: object_name.
+                               test_fun = checkmate::test_numeric) {
+  checkmate::assert_flag(finite)
+  checkmate::assert_flag(null.ok)
+  checkmate::assert_function(test_fun)
+  checkmate::assert_number(lower)
+  checkmate::assert_number(upper)
+
+  is_numeric <- test_fun(
     value,
-    len = 3, any.missing = FALSE, finite = finite, null.ok = null.ok
+    len = 3,
+    any.missing = FALSE,
+    null.ok = null.ok
   )
-  is_bounded <- is_numeric && checkmate::test_number(
+
+  # Finite is not available in integer tests
+  if (finite && "finite" %in% names(formals(test_fun))) {
+    test_fun(value, finite = finite)
+  }
+
+  is_bounded <- is_numeric && test_fun(
     value[[1]],
+    len = 1,
     lower = max(lower, value[[2]]),
     upper = min(upper, value[[3]]),
-    null.ok = null.ok,
-    finite = finite
+    null.ok = null.ok
   )
   if (isFALSE(is_numeric) || isFALSE(is_bounded)) {
     return(

diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
@@ -1,9 +1,43 @@
-test_that("check_range_slider returns logical valid arguments", {
+test_that("check_range_slider returns logical with valid default arguments", {
   expect_true(check_range_slider(c(0, 0, 2)))
   expect_true(check_range_slider(c(1, 0, 2)))
   expect_true(check_range_slider(c(2, 0, 2)))
 })
 
+test_that("check_range_slider returns logical with valid arguments looking for integers", {
+  expect_true(check_range_slider(c(0L, 0L, 2L), test_fun = checkmate::test_integer))
+  expect_true(check_range_slider(c(1L, 0L, 2L), test_fun = checkmate::test_integer))
+  expect_true(check_range_slider(c(2L, 0L, 2L), test_fun = checkmate::test_integer))
+})
+
+test_that("check_range_slider returns logical with valid arguments looking for integerish", {
+  expect_true(check_range_slider(c(0, 0, 2), test_fun = checkmate::test_integerish))
+  expect_true(check_range_slider(c(1L, 0L, 2L), test_fun = checkmate::test_integerish))
+  expect_true(check_range_slider(c(2, 0L, 2L), test_fun = checkmate::test_integerish))
+  expect_true(check_range_slider(c(2, 0, 2L), test_fun = checkmate::test_integerish))
+  expect_true(check_range_slider(c(2L, 0L, 2), test_fun = checkmate::test_integerish))
+})
+
+test_that("check_range_slider fails when there is a double", {
+  regex <- "Must be a numeric vector of length 3 with `c\\(value, min, max\\)`"
+
+  expect_match(check_range_slider(c(0, 0, 2.2), test_fun = checkmate::test_integerish), regex)
+})
+
+test_that("check_range_slider fails when looking for strict integers", {
+  regex <- "Must be a numeric vector of length 3 with `c\\(value, min, max\\)`"
+
+  expect_match(check_range_slider(c(0, 0, 2), test_fun = checkmate::test_integer), regex)
+  expect_match(check_range_slider(c(0L, 0L, 2), test_fun = checkmate::test_integer), regex)
+  expect_match(check_range_slider(c(0L, 0, 2L), test_fun = checkmate::test_integer), regex)
+  expect_match(check_range_slider(c(0, 0L, 2L), test_fun = checkmate::test_integer), regex)
+  expect_match(check_range_slider(c(0L, 0, 2), test_fun = checkmate::test_integer), regex)
+  expect_match(check_range_slider(c(0, 0L, 2), test_fun = checkmate::test_integer), regex)
+  expect_match(check_range_slider(c(0, 0L, 2L), test_fun = checkmate::test_integer), regex)
+
+  expect_match(check_range_slider(c(0.1, 0L, 2L), test_fun = checkmate::test_integer), regex)
+})
+
 test_that("check_range_slider returns character on vector with wrong size", {
   regex <- "Must be a numeric vector of length 3 with `c\\(value, min, max\\)`"
   expect_match(check_range_slider(1), regex)