diff --git a/R/clean_names.R b/R/clean_names.R index d618da42e..323ca5b8c 100644 --- a/R/clean_names.R +++ b/R/clean_names.R @@ -150,9 +150,15 @@ clean_names.character <- function(x, include_names = FALSE, ...) { if (pattern[j] == "offset") { # nolint x[i] <- trim_ws(unique(sub("^offset\\(([^-+ )]*).*", "\\1", x[i]))) } else if (pattern[j] == "I") { - if (!ignore_asis) x[i] <- trim_ws(unique(sub("I\\(((\\w|\\.)*).*", "\\1", x[i]))) + if (!ignore_asis && grepl("I\\((.*)\\)", x[i])) { + # x[i] <- trim_ws(unique(sub("I\\(((\\w|\\.)*).*", "\\1", x[i]))) + x[i] <- all.vars(stats::as.formula(paste("~", x[i]))) + } } else if (pattern[j] == "asis") { - if (!ignore_asis) x[i] <- trim_ws(unique(sub("asis\\(((\\w|\\.)*).*", "\\1", x[i]))) + if (!ignore_asis && grepl("asis\\((.*)\\)", x[i])) { + # x[i] <- trim_ws(unique(sub("asis\\(((\\w|\\.)*).*", "\\1", x[i]))) + x[i] <- all.vars(stats::as.formula(paste("~", x[i]))) + } } else if (pattern[j] == "log(log") { x[i] <- trim_ws(unique(sub("^log\\(log\\(((\\w|\\.)*).*", "\\1", x[i]))) } else if (pattern[j] == "relevel(as.factor") { @@ -184,7 +190,9 @@ clean_names.character <- function(x, include_names = FALSE, ...) { # g <- c(g, .safe(all.vars(as.formula(paste0("~", trim_ws(gsub("weights\\s?=(.*)", "\\1", "weights = cbind(w, w)"))))))) # nolint # } # multimembership <- as.vector(trim_ws(g)) - multimembership <- all.vars(stats::as.formula(paste("~", x[i]))) + if (grepl(paste0("^", pattern[j], "\\((.*)\\).*"), x[i])) { + multimembership <- all.vars(stats::as.formula(paste("~", x[i]))) + } } else if (pattern[j] == "s" && startsWith(x[i], "s(")) { x[i] <- gsub("^s\\(", "", x[i]) x[i] <- gsub("\\)$", "", x[i]) diff --git a/tests/testthat/test-clean_names.R b/tests/testthat/test-clean_names.R index 0b3ed1815..027f77f7a 100644 --- a/tests/testthat/test-clean_names.R +++ b/tests/testthat/test-clean_names.R @@ -105,3 +105,26 @@ test_that("clean_names, multimembership", { ) ) }) + +skip_if_not_installed("gamlss") + +test_that("clean_names, multimembership", { + set.seed(123) + dat <- data.frame( + Y = sample(20:50, 100, replace = TRUE), + date = sample(seq(as.Date("1999/01/01"), as.Date("2000/01/01"), by = "day"), 10), + cont1 = rchisq(100, df = 2), + cont2 = runif(100), + cat1 = sample(LETTERS[1:3], 100, replace = TRUE) + ) + junk <- capture.output({ + mod1 <- suppressWarnings(gamlss::gamlss( + Y ~ date + scale(cont1) + scale(cont2) + I(scale(cont2)^2) * cat1, + data = dat + )) + }) + expect_identical( + clean_names(find_terms(mod1)$conditional), + c("date", "cont1", "cont2", "cont2", "cat1") + ) +})