Skip to content

Update imported {standalone} scripts to current source (#280) #281

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
Melkiades merged 6 commits into from
Aug 11, 2026
Merged

Update imported {standalone} scripts to current source (#280) #281

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
84613e1
Update imported {standalone} scripts to current source (#280)
Melkiades Jul 1, 2026
9ae6cfd
Merge branch 'main' into 280_update_standalone@main
shajoezhu Aug 3, 2026
4d2a1c3
Merge branch 'main' into 280_update_standalone@main
shajoezhu Aug 8, 2026
c47d2b2
Merge branch 'main' into 280_update_standalone@main
Melkiades Aug 10, 2026
8e5984b
Refresh standalone checks to 2026-07-01
Melkiades Aug 11, 2026
aa1c988
Refresh standalone checks: check_scalar() errors on length-1 lists
Melkiades Aug 11, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
188 changes: 151 additions & 37 deletions R/import-standalone-checks.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@
# ---
# repo: insightsengineering/standalone
# file: standalone-checks.R
# last-updated: 2024-05-04
# last-updated: 2026-07-01
# license: https://unlicense.org
# dependencies: standalone-cli_call_env.R
# imports: [rlang, cli]
Expand All @@ -16,6 +16,22 @@
# passed by users to functions in packages.
#
# ## Changelog
#
# 2026-08-10
# - Updated `check_scalar()` to return an error for lists of length 1.
#
# 2026-07-01
# - `check_*()` functions now error on empty input when `allow_empty = FALSE`
# (previously empty input silently passed class/type checks) (#30)
# - `check_scalar_integerish()` failures now use the `check_scalar_integerish`
# condition class (previously `check_integerish`) (#30)
#
# 2025-05-08
# - Added `check_identical()` and `check_identical_length()`
#
# 2025-04-27
# - Added `check_named()`

# nocov start
# styler: off

Expand Down Expand Up @@ -56,9 +72,12 @@ check_class <- function(x,
class = "check_class",
call = get_cli_abort_call(),
envir = rlang::current_env()) {
# if empty, skip test
if (isTRUE(allow_empty) && rlang::is_empty(x)) {
return(invisible(x))
# if empty: return invisibly when allowed, otherwise error
if (rlang::is_empty(x)) {
if (isTRUE(allow_empty)) {
return(invisible(x))
}
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}

if (!inherits(x, cls)) {
Expand Down Expand Up @@ -220,9 +239,12 @@ check_length <- function(x,
class = "check_length",
call = get_cli_abort_call(),
envir = rlang::current_env()) {
# if empty, skip test
if (isTRUE(allow_empty) && rlang::is_empty(x)) {
return(invisible(x))
# if empty: return invisibly when allowed, otherwise error
if (rlang::is_empty(x)) {
if (isTRUE(allow_empty)) {
return(invisible(x))
}
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}

# check length
Expand All @@ -243,18 +265,27 @@ check_scalar <- function(x,
message =
ifelse(
allow_empty,
"The {.arg {arg_name}} argument must be length {.val {1}} or empty.",
"The {.arg {arg_name}} argument must be length {.val {1}}."
"The {.arg {arg_name}} argument must be a vector of length {.val {1}} or empty.",
"The {.arg {arg_name}} argument must be a vector of length {.val {1}}."
),
arg_name = rlang::caller_arg(x),
class = "check_scalar",
call = get_cli_abort_call(),
envir = rlang::current_env()) {
check_length(
x = x, length = 1L, message = message,
allow_empty = allow_empty, arg_name = arg_name,
class = class, call = call, envir = envir
)
# if empty: return invisibly when allowed, otherwise error
if (rlang::is_empty(x)) {
if (isTRUE(allow_empty)) {
return(invisible(x))
}
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}

# input must be a vector of length 1 (not a list)
if (length(x) != 1L || is.list(x)) {
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}

invisible(x)
}

#' Check Number of Levels
Expand Down Expand Up @@ -302,9 +333,12 @@ check_range <- function(x,
class = "check_range",
call = get_cli_abort_call(),
envir = rlang::current_env()) {
# if empty, skip test
if (isTRUE(allow_empty) && rlang::is_empty(x)) {
return(invisible(x))
# if empty: return invisibly when allowed, otherwise error
if (rlang::is_empty(x)) {
if (isTRUE(allow_empty)) {
return(invisible(x))
}
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}

print_error <- FALSE
Expand Down Expand Up @@ -395,9 +429,12 @@ check_binary <- function(x,
class = "check_binary",
call = get_cli_abort_call(),
envir = rlang::current_env()) {
# if empty, skip test
if (isTRUE(allow_empty) && rlang::is_empty(x)) {
return(invisible(x))
# if empty: return invisibly when allowed, otherwise error
if (rlang::is_empty(x)) {
if (isTRUE(allow_empty)) {
return(invisible(x))
}
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}

# first check x is either logical or numeric
Expand Down Expand Up @@ -440,9 +477,12 @@ check_formula_list_selector <- function(x,
class = "check_formula_list_selector",
call = get_cli_abort_call(),
envir = rlang::current_env()) {
# if empty, skip test
if (isTRUE(allow_empty) && rlang::is_empty(x)) {
return(invisible(x))
# if empty: return invisibly when allowed, otherwise error
if (rlang::is_empty(x)) {
if (isTRUE(allow_empty)) {
return(invisible(x))
}
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}

# first check the general structure; must be a list or formula
Expand Down Expand Up @@ -473,16 +513,19 @@ check_integerish <- function(x,
message =
ifelse(
allow_empty,
"The {.arg {arg_name}} argument must an integer vector or empty.",
"The {.arg {arg_name}} argument must an integer vector."
"The {.arg {arg_name}} argument must be an integer vector or empty.",
"The {.arg {arg_name}} argument must be an integer vector."
),
arg_name = rlang::caller_arg(x),
class = "check_integerish",
call = get_cli_abort_call(),
envir = rlang::current_env()) {
# if empty, skip test
if (isTRUE(allow_empty) && rlang::is_empty(x)) {
return(invisible(x))
# if empty: return invisibly when allowed, otherwise error
if (rlang::is_empty(x)) {
if (isTRUE(allow_empty)) {
return(invisible(x))
}
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}

if (!rlang::is_integerish(x)) {
Expand All @@ -502,16 +545,19 @@ check_scalar_integerish <- function(x,
message =
ifelse(
allow_empty,
"The {.arg {arg_name}} argument must an scalar integer or empty.",
"The {.arg {arg_name}} argument must an scalar integer."
"The {.arg {arg_name}} argument must be a scalar integer or empty.",
"The {.arg {arg_name}} argument must be a scalar integer."
),
arg_name = rlang::caller_arg(x),
class = "check_integerish",
class = "check_scalar_integerish",
call = get_cli_abort_call(),
envir = rlang::current_env()) {
# if empty, skip test
if (isTRUE(allow_empty) && rlang::is_empty(x)) {
return(invisible(x))
# if empty: return invisibly when allowed, otherwise error
if (rlang::is_empty(x)) {
if (isTRUE(allow_empty)) {
return(invisible(x))
}
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}

if (!rlang::is_scalar_integerish(x)) {
Expand Down Expand Up @@ -592,9 +638,12 @@ check_numeric <- function(x,
class = "check_numeric",
call = get_cli_abort_call(),
envir = rlang::current_env()) {
# if empty, skip test
if (isTRUE(allow_empty) && rlang::is_empty(x)) {
return(invisible(x))
# if empty: return invisibly when allowed, otherwise error
if (rlang::is_empty(x)) {
if (isTRUE(allow_empty)) {
return(invisible(x))
}
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}

if (!is.numeric(x)) {
Expand All @@ -604,5 +653,70 @@ check_numeric <- function(x,
invisible(x)
}

#' Check is Named
#'
#' @inheritParams check_numeric
#' @keywords internal
#' @noRd
check_named <- function(x,
allow_empty = FALSE,
message = "The {.arg {arg_name}} argument must be named.",
arg_name = rlang::caller_arg(x),
call = get_cli_abort_call(),
envir = rlang::current_env()) {
# if empty and allowed, return input invisibly
if (allow_empty && rlang::is_empty(x)) {
return(invisible(x))
}

# check input is named
if (!rlang::is_named(x)) {
cli::cli_abort(message = message, call = call, .envir = envir)
}

invisible(x)
}

#' Check is Identical
#'
#' @inheritParams check_numeric
#' @keywords internal
#' @noRd
check_identical <- function(x, y,
message = "Arguments {.arg {arg_name_x}} and {.arg {arg_name_y}} must be identical.",
arg_name_x = rlang::caller_arg(x),
arg_name_y = rlang::caller_arg(y),
call = get_cli_abort_call(),
envir = rlang::current_env()) {
if (!identical(x, y)) {
cli::cli_abort(message = message, call = call, .envir = envir)
}

invisible()
}


#' Check Identical Length
#'
#' @inheritParams check_numeric
#' @keywords internal
#' @noRd
check_identical_length <- function(x, y,
message = "Arguments {.arg {arg_name_x}} and {.arg {arg_name_y}} must be the same length.",
arg_name_x = rlang::caller_arg(x),
arg_name_y = rlang::caller_arg(y),
call = get_cli_abort_call(),
envir = rlang::current_env()) {
check_identical(
x = length(x),
y = length(y),
message = message,
arg_name_x = arg_name_x,
arg_name_y = arg_name_y,
call = call,
envir = envir
)
}

# nocov end
# styler: on
17 changes: 14 additions & 3 deletions R/import-standalone-forcats.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@
# ---
# repo: insightsengineering/standalone
# file: standalone-forcats.R
# last-updated: 2025-07-25
# last-updated: 2026-06-30
# license: https://unlicense.org
# imports:
# ---
Expand All @@ -16,6 +16,12 @@
# of programming.
#
# ## Changelog
# 2026-06-30
# - `fct_collapse()` no longer relies on the base R `%||%` operator, which is
# only available in R >= 4.4.
# - `fct_reorder()` partitions values with a single `split()` call instead of
# scanning the full vector once per level (large speed/memory improvement
# for factors with many levels).
# 2025-07-25
# - add `fct_reorder()` function.
# 2025-06-24
Expand Down Expand Up @@ -147,7 +153,8 @@ fct_collapse <- function(f, ..., other_level = NULL) {
if (!inherits(f, "factor")) f <- factor(f)

dots <- rlang::list2(...)
old <- unlist(dots, use.names = FALSE) %||% character()
old <- unlist(dots, use.names = FALSE)
if (is.null(old)) old <- character()
new <- rep(names(dots), lengths(dots))

# collapse/re-value factor levels using new names
Expand All @@ -165,9 +172,13 @@ fct_reorder <- function(.f, .x, .fun = stats::median, ..., .na_rm = NULL, .defau

lvls <- levels(.f)

# Partition `.x` by level in a single pass (O(n)) instead of re-scanning the
# whole vector once per level (O(n * nlevels)).
groups <- split(.x, .f)

# Compute summary statistic per level
summary_vals <- vapply(lvls, function(lvl) {
vals <- .x[.f == lvl]
vals <- groups[[lvl]]
if (isTRUE(.na_rm)) {
vals <- vals[!is.na(vals)]
}
Expand Down
Loading
Loading