From 83be94277e485f0098a07cfa23567666ca511467 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Thu, 24 Oct 2024 15:15:40 +0200
Subject: [PATCH] `clean_names()` on string with nested `I()` and `scale()`
 (#948)

* `clean_names()` on string with nested `I()` and `scale()`
Fixes #947

* lintr

* fix

* fix
---
 R/clean_names.R                   | 14 +++++++++++---
 tests/testthat/test-clean_names.R | 23 +++++++++++++++++++++++
 2 files changed, 34 insertions(+), 3 deletions(-)

diff --git a/R/clean_names.R b/R/clean_names.R
index d618da42ed..323ca5b8cb 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 0b3ed18158..027f77f7aa 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")
+  )
+})