Merge pull request #123 from selkamand/121-assert_scalar

121 assert scalar

NAMESPACE

@@ -52,6 +52,7 @@ export(assert_number)
 export(assert_numeric)
 export(assert_numeric_vector)
 export(assert_reactive)
+export(assert_scalar)
 export(assert_string)
 export(assert_subset)
 export(assert_vector)

R/assert_type.R

@@ -530,3 +530,38 @@ assert_list <- assert_create(is_list, msg_helper_assert_type(expected_type = "li
 #' @concept assert_type
 #' @export
 assert_reactive <- assert_create(func = is_reactive, default_error_msg = msg_helper_assert_type(expected_type = "reactive"))
+
+
+## Scalar -----------------------------------------------------------
+#' Assert input is a scalar
+#'
+#' Assert that an object is a scalar, meaning it is a length 1 atomic vector (such as \code{numeric(1)}, \code{character(1)} or \code{logical(1)}).
+#' Note lists, data.frames and matrices are never considered scalar objects, even if they have only one element.
+#'
+#' @param x An object
+#' @param msg A character string containing the error message to display if `x` is not a scalar
+#' @inheritParams common_roxygen_params
+#'
+#' @return invisible(TRUE) if `x` is a scalar, otherwise aborts with the error message specified by `msg`
+#'
+#' @examples
+#'
+#' # Pass when value is scalar
+#' assert_scalar(5) # Passes
+#' assert_scalar("single string") # Passes
+#' assert_scalar(TRUE) # Passes
+#'
+#' # Fail when value is not
+#' try({
+#' assert_scalar(c(1, 2, 3)) # Throws default error
+#' assert_scalar(matrix(1:4, 2, 2)) # Throws default error
+#' })
+#'
+#'
+#' @concept assert_type
+#' @export
+assert_scalar <- assert_create(
+  func = is_scalar,
+  default_error_msg = msg_helper_assert_type("scalar")
+)
+

R/is_functions.R

@@ -70,7 +70,7 @@ is_character_vector_or_glue <- function(x){
 }
 
 is_scalar <- function(x){
- length(x) == 1
+ length(x) == 1 & typeof(x) != "list" & !any(class(x) %in% c("matrix"))
 }
 
 #' Check if an object is a logical vector

tests/testthat/test-assert_type.R

@@ -497,3 +497,29 @@ cli::test_that_cli("assert_function() works", config = "plain", {
   expect_error(assert_function(1, msg = "Custom error message"), "Custom error message")
 })
 
+
+# Assert Scalar -----------------------------------------------------------
+cli::test_that_cli("assert_scalar() works", configs = "plain", {
+
+  # Works for scalar values (single numeric, character, logical, etc.)
+  expect_true(assert_scalar(1))
+  expect_true(assert_scalar("a"))
+  expect_true(assert_scalar(TRUE))
+
+  # Aborts for non-scalar objects
+  expect_error(assert_scalar(NULL), "'NULL' must be a scalar, not a NULL", fixed = TRUE)
+  expect_error(assert_scalar(c(1, 2)), "'c(1, 2)' must be a scalar, not a numeric", fixed = TRUE)
+  expect_error(assert_scalar(c("a", "b")), "'c(\"a\", \"b\")' must be a scalar, not a character", fixed = TRUE)
+  expect_error(assert_scalar(matrix(1:4, 2, 2)), "'matrix(1:4, 2, 2)' must be a scalar, not a matrix", fixed = TRUE)
+  expect_error(assert_scalar(matrix(1)), "'matrix(1)' must be a scalar, not a matrix", fixed = TRUE)
+  expect_error(assert_scalar(list(1)), "'list(1)' must be a scalar, not a list", fixed = TRUE)
+  expect_error(assert_scalar(data.frame(a = 1)), "'data.frame(a = 1)' must be a scalar, not a data.frame", fixed = TRUE)
+  expect_error(assert_scalar(list(a = 1)), "'list(a = 1)' must be a scalar, not a list", fixed = TRUE)
+
+  # Error messages use variable name of passed arguments
+  y <- c("a", "b")
+  expect_error(assert_scalar(y), "'y' must be a scalar, not a character", fixed = TRUE)
+
+  # Custom error messages work
+  expect_error(assert_scalar(c(1, 2), msg = "Custom error message"), "Custom error message")
+})