From 5991bd59f5d35ee9570cb4af9727287908de9529 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 16 Jun 2024 20:56:31 -0400 Subject: [PATCH] New standalone-check_crucial_names (#796) --- R/standalone-check_crucial_names.R | 50 ++++++++++++++++++++++++++++++ R/utils.R | 38 ----------------------- 2 files changed, 50 insertions(+), 38 deletions(-) create mode 100644 R/standalone-check_crucial_names.R diff --git a/R/standalone-check_crucial_names.R b/R/standalone-check_crucial_names.R new file mode 100644 index 00000000..53186ca8 --- /dev/null +++ b/R/standalone-check_crucial_names.R @@ -0,0 +1,50 @@ +# --- +# repo: 2DegreesInvesting/tiltIndicator +# file: standalone-check_crucial_names.R +# last-updated: 2024-06-15 +# license: https://unlicense.org +# imports: [rlang, glue] +# --- + +#' @importFrom rlang is_named +#' @importFrom rlang abort +#' @importFrom glue glue +NULL + +#' Check if a named object contains expected names +#' +#' Based on fgeo.tool::check_crucial_names() +#' +#' @param x A named object. +#' @param expected_names String; expected names of `x`. +#' +#' @return Invisible `x`, or an error with informative message. +#' +#' Adapted from: https://github.com/RMI-PACTA/r2dii.match/blob/main/R/check_crucial_names.R +#' +#' @examples +#' x <- c(a = 1) +#' check_crucial_names(x, "a") +#' try(check_crucial_names(x, "bad")) +#' @noRd +check_crucial_names <- function(x, expected_names) { + stopifnot(is_named(x)) + stopifnot(is.character(expected_names)) + + ok <- all(unique(expected_names) %in% names(x)) + if (!ok) { + abort_missing_names(sort(setdiff(expected_names, names(x)))) + } + + invisible(x) +} + +abort_missing_names <- function(missing_names) { + abort( + "missing_names", + message = glue( + "Must have missing names: + {paste0('`', missing_names, '`', collapse = ', ')}" + ) + ) +} diff --git a/R/utils.R b/R/utils.R index 1f5a8fe1..d8b64c59 100644 --- a/R/utils.R +++ b/R/utils.R @@ -45,44 +45,6 @@ lowercase_characters <- function(data) { mutate(data, across(where(is.character), tolower)) } -#' Check if a named object contains expected names -#' -#' Based on fgeo.tool::check_crucial_names() -#' -#' @param x A named object. -#' @param expected_names String; expected names of `x`. -#' -#' @return Invisible `x`, or an error with informative message. -#' -#' Adapted from: https://github.com/RMI-PACTA/r2dii.match/blob/main/R/check_crucial_names.R -#' -#' @examples -#' x <- c(a = 1) -#' check_crucial_names(x, "a") -#' try(check_crucial_names(x, "bad")) -#' @noRd -check_crucial_names <- function(x, expected_names) { - stopifnot(is_named(x)) - stopifnot(is.character(expected_names)) - - ok <- all(unique(expected_names) %in% names(x)) - if (!ok) { - abort_missing_names(sort(setdiff(expected_names, names(x)))) - } - - invisible(x) -} - -abort_missing_names <- function(missing_names) { - abort( - "missing_names", - message = glue( - "Must have missing names: - {paste0('`', missing_names, '`', collapse = ', ')}" - ) - ) -} - add_risk_category <- function(data, low_threshold, high_threshold, ...) { mutate(data, risk_category = categorize_risk( .data$profile_ranking, .data$low_threshold, .data$high_threshold, ...