From 8fa8f9a0a5411523bb90c8e8efa1fd865293fe34 Mon Sep 17 00:00:00 2001 From: Virtuoos Automatisch Date: Wed, 28 Oct 2026 11:59:28 +0100 Subject: [PATCH] columnFormula: point errors at the culprit and warn about missing columns Errors now name the offending argument, describe what was received and suggest a fix (NULL from a mistyped data$ column, factors needing as.character(), numeric positions, lists, already-a-formula, NA and empty elements). The new checkColumns argument warns, when a dataset is available as data/filteredData, about names that are no columns and suggests close matches through .suggestColumnNames() from ColumnEncoder. The formula itself is unchanged. --- R/columnFormula.R | 150 ++++++++++++++++++++++++++-- man/columnFormula.Rd | 11 +- tests/testthat/test-columnFormula.R | 148 +++++++++++++++++++++++++++ 3 files changed, 298 insertions(+), 11 deletions(-) diff --git a/R/columnFormula.R b/R/columnFormula.R index e6cb490..0fc08f3 100644 --- a/R/columnFormula.R +++ b/R/columnFormula.R @@ -10,6 +10,11 @@ #' The default, `NULL`, creates a one-sided formula. #' @param intercept A single logical value indicating whether to include an #' intercept. Defaults to `TRUE`. +#' @param checkColumns A single logical value. When `TRUE` (the default) and a +#' dataset is available as `data` or `filteredData` (as in the R Commander), +#' a warning points out every column that does not exist and suggests close +#' matches. The check is skipped when no dataset is available; use `FALSE` +#' to disable it entirely. #' #' @details Arguments are evaluated normally, so variables holding column names #' and expressions such as `measurements[[i]]` can be used directly. Names are @@ -31,24 +36,84 @@ #' lapply(measurements, columnFormula) #' #' @export -columnFormula <- function(..., dependent = NULL, intercept = TRUE) { +columnFormula <- function(..., dependent = NULL, intercept = TRUE, checkColumns = TRUE) { columns <- list(...) - validColumns <- vapply(columns, function(x) { - is.character(x) && is.null(dim(x)) && !anyNA(x) && all(nzchar(x)) - }, logical(1)) - if (!all(validColumns)) - stop("`...` must contain character vectors of non-empty column names without NA values.", call. = FALSE) + + for (i in seq_along(columns)) { + column <- columns[[i]] + + if (is.null(column)) + stop(sprintf(paste0("Argument %d in `...` is NULL, but column names must be text.\n", + "Did you mistype a column name? `data$Name` is NULL when the column does not exist."), + i), + call. = FALSE) + + if (is.character(column) && is.null(dim(column))) { + naIndexes <- which(is.na(column)) + if (length(naIndexes)) + stop(sprintf("Element%s %s of argument %d in `...` %s NA, but column names must be text.", + if (length(naIndexes) == 1L) "" else "s", + paste(naIndexes, collapse = ", "), i, + if (length(naIndexes) == 1L) "is" else "are"), + call. = FALSE) + + emptyIndexes <- which(!nzchar(column)) + if (length(emptyIndexes)) + stop(sprintf('Element%s %s of argument %d in `...` %s an empty string (""), but column names must not be empty.', + if (length(emptyIndexes) == 1L) "" else "s", + paste(emptyIndexes, collapse = ", "), i, + if (length(emptyIndexes) == 1L) "is" else "are"), + call. = FALSE) + } else { + hint <- if (is.factor(column)) + "Wrap it in as.character(), e.g. as.character(data[[\"LL.nominal\"]])." + else if (is.numeric(column)) + "If these are column positions, use names(data)[...] to get their names." + else if (inherits(column, "formula")) + "This is already a formula: pass it directly instead." + else if (is.list(column)) + "Use do.call(columnFormula, names) for one formula from a list of names, or lapply(names, columnFormula) for one formula per name." + else + "Column names must be text, e.g. columnFormula(\"part length\")." + + stop(sprintf("Argument %d in `...` must be a character vector of column names, but it is %s.\n%s", + i, .columnFormulaDescribed(column), hint), + call. = FALSE) + } + } if (!is.null(dependent) && (!is.character(dependent) || !is.null(dim(dependent)) || - length(dependent) != 1L || anyNA(dependent) || !nzchar(dependent))) - stop("`dependent` must be NULL or a single non-empty column name without an NA value.", call. = FALSE) + length(dependent) != 1L || is.na(dependent) || !nzchar(dependent))) { + hint <- if (is.factor(dependent)) + "Wrap it in as.character()." + else if (is.numeric(dependent)) + "If this is a column position, use names(data)[...] to get its name." + else + "It must be one column name, e.g. dependent = \"strength\"." + + stop(sprintf("`dependent` must be a single column name, but it is %s.\n%s", + .columnFormulaDescribed(dependent), hint), + call. = FALSE) + } if (!is.logical(intercept) || !is.null(dim(intercept)) || length(intercept) != 1L || is.na(intercept)) - stop("`intercept` must be TRUE or FALSE.", call. = FALSE) + stop(sprintf("`intercept` must be TRUE or FALSE, but it is %s. To leave out the intercept use `intercept = FALSE`.", + .columnFormulaDescribed(intercept)), + call. = FALSE) + + if (!is.logical(checkColumns) || !is.null(dim(checkColumns)) || + length(checkColumns) != 1L || is.na(checkColumns)) + stop(sprintf("`checkColumns` must be TRUE or FALSE, but it is %s.", + .columnFormulaDescribed(checkColumns)), + call. = FALSE) + + allNames <- unlist(columns, use.names = FALSE) + if (checkColumns) + .columnFormulaCheckColumns(c(dependent, allNames), parent.frame()) - symbols <- lapply(unlist(columns, use.names = FALSE), as.name) + symbols <- lapply(allNames, as.name) rhs <- if (length(symbols)) Reduce(function(left, right) call("+", left, right), symbols) else @@ -63,3 +128,68 @@ columnFormula <- function(..., dependent = NULL, intercept = TRUE) { stats::as.formula(result, env = parent.frame()) } + +# Describe an object for use in the error messages above, e.g. `the string "x"` or `a factor`. +.columnFormulaDescribed <- function(x) { + if (is.null(x)) + return("NULL") + if (inherits(x, "formula")) + return(paste0("a formula (", paste(deparse(x), collapse = " "), ")")) + if (!is.null(dim(x))) + return(paste0("a ", class(x)[1L], " with dimensions ", paste(dim(x), collapse = "x"))) + if (is.factor(x)) + return("a factor") + if (is.list(x)) + return("a list") + if (is.character(x)) { + preview <- paste0('"', head(x, 3L), '"', collapse = ", ") + if (length(x) == 1L) + return(paste0("the string ", preview)) + return(paste0("a character vector of length ", length(x), " (", preview, ")")) + } + if (is.numeric(x) || is.logical(x)) { + preview <- paste(head(x, 3L), collapse = ", ") + kind <- if (is.numeric(x)) "number" else "logical value" + if (length(x) == 1L) + return(paste0("the ", kind, " ", preview)) + return(paste0(length(x), " ", kind, "s (", preview, ")")) + } + paste0("a ", class(x)[1L]) +} + +# Warn about names that do not exist in the dataset visible to the caller. Pure feedback: it +# never errors, and it stays silent when there is no dataset (no `data`/`filteredData` in +# scope) or when the encoder helpers from the engine are unavailable. +.columnFormulaCheckColumns <- function(names, callerEnv) { + dataset <- get0("data", envir = callerEnv, inherits = TRUE) + if (!is.data.frame(dataset) || ncol(dataset) == 0L) { + dataset <- get0("filteredData", envir = callerEnv, inherits = TRUE) + if (!is.data.frame(dataset) || ncol(dataset) == 0L) + return(invisible(NULL)) + } + + encodeStrict <- get0(".encodeColNamesStrict", envir = callerEnv, inherits = TRUE) + if (!is.function(encodeStrict)) + return(invisible(NULL)) + + suggest <- get0(".suggestColumnNames", envir = callerEnv, inherits = TRUE) + + for (name in unique(names)) { + encoded <- tryCatch(encodeStrict(name), error = function(e) NULL) + if (!is.null(encoded) && nzchar(encoded)) + next + + warningMessage <- sprintf('No column named "%s" in the dataset.', name) + + suggestions <- if (is.function(suggest)) suggest(name) else character(0) + if (length(suggestions)) { + quoted <- paste0('"', suggestions, '"') + joined <- if (length(quoted) == 2L) paste(quoted, collapse = " or ") else paste(quoted, collapse = ", ") + warningMessage <- paste0(warningMessage, " Did you mean ", joined, "?") + } + + warning(warningMessage, call. = FALSE) + } + + invisible(NULL) +} diff --git a/man/columnFormula.Rd b/man/columnFormula.Rd index 78f3c90..7394e77 100644 --- a/man/columnFormula.Rd +++ b/man/columnFormula.Rd @@ -4,7 +4,7 @@ \alias{columnFormula} \title{Build a Formula from Column Names} \usage{ -columnFormula(..., dependent = NULL, intercept = TRUE) +columnFormula(..., dependent = NULL, intercept = TRUE, checkColumns = TRUE) } \arguments{ \item{...}{Character strings or vectors of column names to include on the @@ -15,6 +15,12 @@ The default, \code{NULL}, creates a one-sided formula.} \item{intercept}{A single logical value indicating whether to include an intercept. Defaults to \code{TRUE}.} + +\item{checkColumns}{A single logical value. When \code{TRUE} (the default) and a +dataset is available as \code{data} or \code{filteredData} (as in the R Commander), +a warning points out every column that does not exist and suggests close +matches. The check is skipped when no dataset is available; use \code{FALSE} +to disable it entirely.} } \value{ An object of class \code{formula}, with the calling environment as its @@ -32,6 +38,9 @@ treated literally: \code{"a+b"} refers to one column named \code{a+b}. With no right-hand-side columns, the formula is \code{~ 1} (or \code{~ 0} when \code{intercept = FALSE}), optionally with a dependent variable. + +Errors name the argument that caused them and suggest how to fix it. The +column check only warns and never changes the resulting formula. } \examples{ columnFormula("x1", "x2", dependent = "y") diff --git a/tests/testthat/test-columnFormula.R b/tests/testthat/test-columnFormula.R index 0a77b3f..82b7a61 100644 --- a/tests/testthat/test-columnFormula.R +++ b/tests/testthat/test-columnFormula.R @@ -62,4 +62,152 @@ testthat::test_that("invalid inputs produce clear errors", { for (intercept in list(NULL, NA, c(TRUE, FALSE), 1, "TRUE", matrix(TRUE))) testthat::expect_error(columnFormula("x", intercept = intercept), "`intercept`", fixed = TRUE) + + for (checkColumns in list(NULL, NA, c(TRUE, FALSE), 1, "TRUE", matrix(TRUE))) + testthat::expect_error(columnFormula("x", checkColumns = checkColumns), "`checkColumns`", fixed = TRUE) +}) + +testthat::test_that("errors name the offending argument and suggest a fix", { + testthat::expect_error(columnFormula(NULL), + "Argument 1 in `...` is NULL, but column names must be text.", fixed = TRUE) + testthat::expect_error(columnFormula(NULL), + "`data$Name` is NULL when the column does not exist.", fixed = TRUE) + testthat::expect_error(columnFormula("x", NULL), + "Argument 2 in `...` is NULL", fixed = TRUE) + + testthat::expect_error(columnFormula(factor("x")), + "Argument 1 in `...` must be a character vector of column names, but it is a factor.", + fixed = TRUE) + testthat::expect_error(columnFormula(factor("x")), + 'as.character(data[["LL.nominal"]])', fixed = TRUE) + + testthat::expect_error(columnFormula(1), + "Argument 1 in `...` must be a character vector of column names, but it is the number 1.", + fixed = TRUE) + testthat::expect_error(columnFormula(1:3), + "If these are column positions, use names(data)[...]", fixed = TRUE) + + testthat::expect_error(columnFormula(~ x), + "but it is a formula (~", fixed = TRUE) + testthat::expect_error(columnFormula(~ x), + "This is already a formula: pass it directly instead.", fixed = TRUE) + + testthat::expect_error(columnFormula(list("x")), "but it is a list.", fixed = TRUE) + testthat::expect_error(columnFormula(list("x")), + "do.call(columnFormula, names)", fixed = TRUE) + testthat::expect_error(columnFormula(list("x")), + "lapply(names, columnFormula)", fixed = TRUE) + + testthat::expect_error(columnFormula(c("x", NA_character_)), + "Element 2 of argument 1 in `...` is NA", fixed = TRUE) + testthat::expect_error(columnFormula(c("x", NA_character_, NA_character_)), + "Elements 2, 3 of argument 1 in `...` are NA", fixed = TRUE) + testthat::expect_error(columnFormula(c("x", "")), + 'Element 2 of argument 1 in `...` is an empty string ("")', fixed = TRUE) + + testthat::expect_error(columnFormula("x", dependent = c("y1", "y2")), + '`dependent` must be a single column name, but it is a character vector of length 2 ("y1", "y2").', + fixed = TRUE) + testthat::expect_error(columnFormula("x", dependent = factor("y")), + "`dependent` must be a single column name, but it is a factor.", fixed = TRUE) + testthat::expect_error(columnFormula("x", dependent = 3), + "If this is a column position, use names(data)[...]", fixed = TRUE) + + testthat::expect_error(columnFormula("x", intercept = "TRUE"), + '`intercept` must be TRUE or FALSE, but it is the string "TRUE".', fixed = TRUE) + testthat::expect_error(columnFormula("x", intercept = "TRUE"), + "To leave out the intercept use `intercept = FALSE`.", fixed = TRUE) + + testthat::expect_error(columnFormula("x", checkColumns = NA), + "`checkColumns` must be TRUE or FALSE, but it is the logical value NA.", fixed = TRUE) +}) + +# Stubs that stand in for the engine's encoder helpers so the typo check can be tested +# outside JASP. The real `.encodeColNamesStrict()` errors for anything that is not a +# column and `.suggestColumnNames()` returns close matches from ColumnEncoder. +.stubEncodeStrict <- function(columns) { + function(name) if (name %in% columns) paste0("encoded:", name) else stop("not a column: ", name) +} + +.stubSuggest <- function(columns) { + function(name) { + distance <- as.vector(utils::adist(tolower(name), tolower(columns))) + keep <- distance <= 2 + columns[keep][order(distance[keep])] + } +} + +# Install a fake dataset plus the stubs into the calling environment: columnFormula()'s +# typo check looks up `data`, `.encodeColNamesStrict()` and `.suggestColumnNames()` +# starting from its caller. test_that blocks get a fresh environment, so nothing leaks. +.stubDataset <- function(columns) { + env <- parent.frame() + data <- data.frame(matrix(rep(1:2, length(columns)), nrow = 2), check.names = FALSE) + names(data) <- columns + assign("data", data, envir = env) + assign(".encodeColNamesStrict", .stubEncodeStrict(columns), envir = env) + assign(".suggestColumnNames", .stubSuggest(columns), envir = env) + invisible(NULL) +} + +testthat::test_that("unknown columns get a did-you-mean warning when a dataset is visible", { + .stubDataset(c("part length", "temperature")) + + testthat::expect_warning(columnFormula("Part length"), + 'No column named "Part length" in the dataset. Did you mean "part length"?', + fixed = TRUE) + testthat::expect_warning(columnFormula("temprature"), + 'No column named "temprature" in the dataset. Did you mean "temperature"?', + fixed = TRUE) + + testthat::expect_no_warning(columnFormula("part length")) + testthat::expect_no_warning(columnFormula("part length", dependent = "temperature")) + + testthat::expect_warning(columnFormula("part length", dependent = "Temprature"), + 'No column named "Temprature" in the dataset. Did you mean "temperature"?', + fixed = TRUE) +}) + +testthat::test_that("each unknown column gets its own warning", { + .stubDataset(c("part length", "temperature")) + + warningsCaught <- testthat::capture_warnings(columnFormula("Part length", "temprature")) + testthat::expect_length(warningsCaught, 2L) + testthat::expect_true(any(grepl('No column named "Part length"', warningsCaught, fixed = TRUE))) + testthat::expect_true(any(grepl('No column named "temprature"', warningsCaught, fixed = TRUE))) +}) + +testthat::test_that("the typo check stays silent without a dataset, and checkColumns = FALSE disables it", { + data <- NULL + filteredData <- NULL + testthat::expect_no_warning(columnFormula("Part length")) + + data <- data.frame() + .encodeColNamesStrict <- .stubEncodeStrict(character(0)) + .suggestColumnNames <- .stubSuggest(character(0)) + testthat::expect_no_warning(columnFormula("Part length")) + + testthat::expect_no_warning(columnFormula("Part length", checkColumns = FALSE)) +}) + +testthat::test_that("without the suggest helper the warning names the column but suggests nothing", { + data <- data.frame(1:2, check.names = FALSE) + names(data) <- "part length" + .encodeColNamesStrict <- .stubEncodeStrict("part length") + .suggestColumnNames <- NULL + + testthat::expect_warning(columnFormula("Part length"), + 'No column named "Part length" in the dataset.', fixed = TRUE) +}) + +testthat::test_that("filteredData is checked when data is not bound", { + data <- NULL + filteredData <- data.frame(1:2, check.names = FALSE) + names(filteredData) <- "part length" + .encodeColNamesStrict <- .stubEncodeStrict("part length") + .suggestColumnNames <- .stubSuggest("part length") + + testthat::expect_warning(columnFormula("Part length"), + 'No column named "Part length" in the dataset. Did you mean "part length"?', + fixed = TRUE) })