From d0ecd174270121643e270c4c1dbdfde127cea54a Mon Sep 17 00:00:00 2001 From: Ante Bing Date: Mon, 10 Aug 2026 17:45:32 +0000 Subject: [PATCH] Refuse an all-NA additional covariate up front An additional covariate whose column is entirely NA made glm()'s internal na.omit drop every row, so the fit died with the opaque error "Error occurred during model fitting step: ... Argument mu must be a nonempty numeric vector", which never named the covariate. Unlike a collinear covariate, which glm() can drop and still fit (and which already warns), an all-NA covariate is always a mistake and can never enter the model. validate_inputs() now refuses it up front, after the column-existence check, naming the offending covariate(s) in one error. all(is.na(col)) catches an all-NA column of any type (numeric, factor, character). No previously successful run changes; the check is narrow (a partially-observed covariate is untouched). Adds end-to-end and unit tests: the refusal fires and names the covariate, catches all-NA factor/character columns, and stays silent on some-NA and fully-observed covariates. The end-to-end test asserts the clear message replaces the cryptic model-fitting error and fails on the prior source. --- R/validate_inputs.R | 21 ++++++ tests/testthat/test-validate-inputs.R | 102 ++++++++++++++++++++++++++ 2 files changed, 123 insertions(+) diff --git a/R/validate_inputs.R b/R/validate_inputs.R index 1d50e07..856d2aa 100644 --- a/R/validate_inputs.R +++ b/R/validate_inputs.R @@ -541,6 +541,27 @@ validate_inputs <- function( "must be columns in the data frame." )) } + # refuse any additional covariate whose column is entirely NA. glm()'s + # internal na.omit drops every row in that case, and the fit dies with an + # opaque error that never names the column. This runs after the + # column-existence check above so data[[covariate]] is always a real + # column. all(is.na(col)) treats numeric, factor and character columns + # alike, so an all-NA covariate of any type is caught here rather than + # left to fail cryptically inside model fitting. + all_na_covariates <- additional_covariates[vapply( + additional_covariates, + function(covariate) all(is.na(data[[covariate]])), + logical(1) + )] + if (length(all_na_covariates) > 0) { + stop(paste0( + "The additional covariate(s) ", + paste(all_na_covariates, collapse = ", "), + " are entirely NA, so glm() would drop every row and they ", + "cannot enter the model. Remove them from additional_covariates ", + "or supply observed values." + )) + } } # check if intervention_lower_bounds and intervention_upper_bounds are both diff --git a/tests/testthat/test-validate-inputs.R b/tests/testthat/test-validate-inputs.R index 3fdc49a..377acb3 100644 --- a/tests/testthat/test-validate-inputs.R +++ b/tests/testthat/test-validate-inputs.R @@ -585,6 +585,108 @@ test_that("additional_covariates must all be columns in the data", { "All elements in additional_covariates") }) +# An additional covariate whose column is entirely NA cannot enter the model: +# glm()'s internal na.omit drops every row and the fit dies with an opaque +# error that never names the column. This is always a mistake -- unlike a +# collinear covariate, which glm() can drop and still fit -- so it is refused +# up front here, naming the offender(s). The tests below pin that the refusal +# fires and names the covariate, catches an all-NA column of any type, and +# stays silent on a partially-observed or fully-observed covariate. + +test_that("an all-NA additional covariate is refused, naming it", { + di <- mtcars + di$allna <- NA_real_ + # precondition: the column really is entirely NA, so the test is not vacuous + expect_true(all(is.na(di$allna))) + expect_error(call_vi(data = di, additional_covariates = "allna"), + "allna") + expect_error(call_vi(data = di, additional_covariates = "allna"), + "entirely NA") +}) + +test_that("two all-NA additional covariates are both named in one error", { + di <- mtcars + di$allna1 <- NA_real_ + di$allna2 <- NA_real_ + # precondition: both columns are entirely NA + expect_true(all(is.na(di$allna1)) && all(is.na(di$allna2))) + # one stop() listing both offenders together, alongside a valid covariate + err <- tryCatch( + call_vi(data = di, additional_covariates = c("allna1", "cyl", "allna2")), + error = conditionMessage) + expect_match(err, "allna1") + expect_match(err, "allna2") +}) + +test_that("an all-NA factor or character additional covariate is refused", { + # is.na() works on factor and character columns too, so the check catches an + # all-NA column of any type and does not itself error on the non-numeric one + di <- mtcars + di$allna_fac <- factor(rep(NA_character_, nrow(di)), levels = c("a", "b")) + expect_true(all(is.na(di$allna_fac))) + expect_error(call_vi(data = di, additional_covariates = "allna_fac"), + "allna_fac") + + di2 <- mtcars + di2$allna_chr <- NA_character_ + expect_true(all(is.na(di2$allna_chr))) + expect_error(call_vi(data = di2, additional_covariates = "allna_chr"), + "allna_chr") +}) + +test_that("a covariate with some but not all NA does not trip the refusal", { + # negative control: the refusal is narrow. A covariate with SOME NAs is a + # legitimate input glm() can still fit, so this must pass the validator. + di <- mtcars + di$some_na <- di$cyl + di$some_na[1] <- NA + # precondition: some NA, but not all + expect_true(anyNA(di$some_na) && !all(is.na(di$some_na))) + expect_no_error(call_vi(data = di, additional_covariates = "some_na")) +}) + +test_that("a fully-observed additional covariate does not trip the refusal", { + # negative control: a covariate with no NA at all passes untouched + expect_false(anyNA(mtcars$cyl)) + expect_no_error(call_vi(data = mtcars, additional_covariates = "cyl")) +}) + +test_that("lago_optimization refuses an all-NA covariate with a clear message", { + # END-TO-END: the same all-NA covariate that dies with an opaque + # "nonempty numeric vector" error deep in model fitting on the unfixed + # source is now refused up front by the input validator, so the caller sees + # a message that names the covariate and says why. Fails on the unfixed + # source, where the run reaches glm() and returns the cryptic error instead. + bbp <- as.data.frame(BB_proportions) + bbp$allna <- NA_real_ + # precondition: the covariate really is entirely NA + expect_true(all(is.na(bbp$allna))) + run <- function() { + suppressWarnings(suppressMessages(lago_optimization( + data = bbp, + outcome_name = "EBP_proportions", + outcome_type = "continuous", + glm_family = "quasibinomial", + link = "logit", + intervention_components = c("coaching_updt", "launch_duration"), + intervention_lower_bounds = c(1, 1), + intervention_upper_bounds = c(40, 5), + cost_list_of_vectors = list(c(0, 1.7), c(0, 8)), + outcome_goal = 0.85, + additional_covariates = "allna", + include_confidence_set = FALSE, + quiet = TRUE + ))) + } + # the new message: names the covariate and says why it cannot enter the model + expect_error(run(), "allna") + expect_error(run(), "entirely NA") + # and NOT the opaque model-fitting errors the missing guard produced. Both + # assertions fail on the unfixed source, where run() returns exactly these. + expect_error(run(), "^(?!.*nonempty numeric).*$", perl = TRUE) + expect_error(run(), "^(?!.*model fitting step).*$", perl = TRUE) +}) + # --- Group 4: bounds, costs, optimization method, grid step -----------------