Skip to content

Commit 3fc0cc5

Browse files
khusmannkhusmann
committed
add check_numeric() and check_numeric_whole() (Fixes #1714)
1 parent 51309dd commit 3fc0cc5

File tree

3 files changed

+202
-0
lines changed

3 files changed

+202
-0
lines changed

‎R/standalone-types-check.R‎

Lines changed: 74 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,8 @@
1212
# 2025-09-19:
1313
# - `check_logical()` gains an `allow_na` argument (@jonthegeek, #1724)
1414
# - Rename `check_number_decimal()` to `check_number()` (@khusmann, #1714)
15+
# - Add `check_numeric()` and `check_numeric_whole()`, vectorized versions
16+
# of `check_number()` and `check_number_whole()` (@khusmann, #1714)
1517
#
1618
# 2024-08-15:
1719
# - `check_character()` gains an `allow_na` argument (@martaalcalde, #1724)
@@ -503,6 +505,78 @@ check_formula <- function(
503505

504506
# TODO: Figure out what to do with logical `NA` and `allow_na = TRUE`
505507

508+
check_numeric <- function(
509+
x,
510+
...,
511+
allow_na = TRUE,
512+
allow_null = FALSE,
513+
arg = caller_arg(x),
514+
call = caller_env()
515+
) {
516+
if (!missing(x)) {
517+
if (is.numeric(x)) {
518+
if (!allow_na && any(is.na(x))) {
519+
abort(
520+
sprintf("`%s` can't contain NA values.", arg),
521+
arg = arg,
522+
call = call
523+
)
524+
}
525+
526+
return(invisible(NULL))
527+
}
528+
529+
if (allow_null && is_null(x)) {
530+
return(invisible(NULL))
531+
}
532+
}
533+
534+
stop_input_type(
535+
x,
536+
"a numeric vector",
537+
...,
538+
allow_null = allow_null,
539+
arg = arg,
540+
call = call
541+
)
542+
}
543+
544+
check_numeric_whole <- function(
545+
x,
546+
...,
547+
allow_na = TRUE,
548+
allow_null = FALSE,
549+
arg = caller_arg(x),
550+
call = caller_env()
551+
) {
552+
if (!missing(x)) {
553+
if (is_integerish(x)) {
554+
if (!allow_na && any(is.na(x))) {
555+
abort(
556+
sprintf("`%s` can't contain NA values.", arg),
557+
arg = arg,
558+
call = call
559+
)
560+
}
561+
562+
return(invisible(NULL))
563+
}
564+
565+
if (allow_null && is_null(x)) {
566+
return(invisible(NULL))
567+
}
568+
}
569+
570+
stop_input_type(
571+
x,
572+
"a numeric vector with whole numbers",
573+
...,
574+
allow_null = allow_null,
575+
arg = arg,
576+
call = call
577+
)
578+
}
579+
506580
check_character <- function(
507581
x,
508582
...,

‎tests/testthat/_snaps/standalone-types-check.md‎

Lines changed: 84 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -418,6 +418,90 @@
418418
Error in `checker()`:
419419
! `foo` must be an environment or `NULL`, not a list.
420420

421+
# `check_numeric()` checks
422+
423+
Code
424+
err(checker(, check_numeric))
425+
Output
426+
<error/rlang_error>
427+
Error in `checker()`:
428+
! `foo` must be a numeric vector, not absent.
429+
Code
430+
err(checker(NULL, check_numeric))
431+
Output
432+
<error/rlang_error>
433+
Error in `checker()`:
434+
! `foo` must be a numeric vector, not `NULL`.
435+
Code
436+
err(checker(NA, check_numeric))
437+
Output
438+
<error/rlang_error>
439+
Error in `checker()`:
440+
! `foo` must be a numeric vector, not `NA`.
441+
Code
442+
err(checker("foo", check_numeric))
443+
Output
444+
<error/rlang_error>
445+
Error in `checker()`:
446+
! `foo` must be a numeric vector, not the string "foo".
447+
Code
448+
err(checker(list(1, 2), check_numeric, allow_null = TRUE))
449+
Output
450+
<error/rlang_error>
451+
Error in `checker()`:
452+
! `foo` must be a numeric vector or `NULL`, not a list.
453+
Code
454+
err(checker(c(1, NA), check_numeric, allow_na = FALSE))
455+
Output
456+
<error/rlang_error>
457+
Error in `checker()`:
458+
! `foo` can't contain NA values.
459+
460+
# `check_numeric_whole()` checks
461+
462+
Code
463+
err(checker(, check_numeric_whole))
464+
Output
465+
<error/rlang_error>
466+
Error in `checker()`:
467+
! `foo` must be a numeric vector with whole numbers, not absent.
468+
Code
469+
err(checker(1.1, check_numeric_whole))
470+
Output
471+
<error/rlang_error>
472+
Error in `checker()`:
473+
! `foo` must be a numeric vector with whole numbers, not the number 1.1.
474+
Code
475+
err(checker(NULL, check_numeric_whole))
476+
Output
477+
<error/rlang_error>
478+
Error in `checker()`:
479+
! `foo` must be a numeric vector with whole numbers, not `NULL`.
480+
Code
481+
err(checker(NA, check_numeric_whole))
482+
Output
483+
<error/rlang_error>
484+
Error in `checker()`:
485+
! `foo` must be a numeric vector with whole numbers, not `NA`.
486+
Code
487+
err(checker("foo", check_numeric_whole))
488+
Output
489+
<error/rlang_error>
490+
Error in `checker()`:
491+
! `foo` must be a numeric vector with whole numbers, not the string "foo".
492+
Code
493+
err(checker(list(1, 2), check_numeric_whole, allow_null = TRUE))
494+
Output
495+
<error/rlang_error>
496+
Error in `checker()`:
497+
! `foo` must be a numeric vector with whole numbers or `NULL`, not a list.
498+
Code
499+
err(checker(c(1, NA), check_numeric_whole, allow_na = FALSE))
500+
Output
501+
<error/rlang_error>
502+
Error in `checker()`:
503+
! `foo` can't contain NA values.
504+
421505
# `check_character()` checks
422506

423507
Code

‎tests/testthat/test-standalone-types-check.R‎

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -155,6 +155,50 @@ test_that("`check_environment()` checks", {
155155
})
156156
})
157157

158+
test_that("`check_numeric()` checks", {
159+
expect_null(check_numeric(0))
160+
expect_null(check_numeric(0L))
161+
expect_null(check_numeric(na_dbl))
162+
expect_null(check_numeric(na_int))
163+
expect_null(check_numeric(c(1, NA)))
164+
expect_null(check_numeric(double()))
165+
expect_null(check_numeric(10.1))
166+
expect_null(check_numeric(1:10))
167+
expect_null(check_numeric(1:10 + 0.1))
168+
expect_null(check_numeric(NULL, allow_null = TRUE))
169+
170+
expect_snapshot({
171+
err(checker(, check_numeric))
172+
err(checker(NULL, check_numeric))
173+
err(checker(NA, check_numeric))
174+
err(checker("foo", check_numeric))
175+
err(checker(list(1, 2), check_numeric, allow_null = TRUE))
176+
err(checker(c(1, NA), check_numeric, allow_na = FALSE))
177+
})
178+
})
179+
180+
test_that("`check_numeric_whole()` checks", {
181+
expect_null(check_numeric_whole(0))
182+
expect_null(check_numeric_whole(0L))
183+
expect_null(check_numeric_whole(na_dbl))
184+
expect_null(check_numeric_whole(na_int))
185+
expect_null(check_numeric_whole(c(1, NA)))
186+
expect_null(check_numeric_whole(double()))
187+
expect_null(check_numeric_whole(integer()))
188+
expect_null(check_numeric_whole(1:10))
189+
expect_null(check_numeric_whole(NULL, allow_null = TRUE))
190+
191+
expect_snapshot({
192+
err(checker(, check_numeric_whole))
193+
err(checker(1.1, check_numeric_whole))
194+
err(checker(NULL, check_numeric_whole))
195+
err(checker(NA, check_numeric_whole))
196+
err(checker("foo", check_numeric_whole))
197+
err(checker(list(1, 2), check_numeric_whole, allow_null = TRUE))
198+
err(checker(c(1, NA), check_numeric_whole, allow_na = FALSE))
199+
})
200+
})
201+
158202
test_that("`check_character()` checks", {
159203
expect_null(check_character(""))
160204
expect_null(check_character(na_chr))

0 commit comments

Comments
 (0)