fix printing issue

R/utils_format.R

@@ -440,6 +440,19 @@
       }
       # create a pretty level for the reference category
       pretty_level <- paste0(fn_clean, " [", sub(fn, "", reference_level, fixed = TRUE), "]")
+      pretty_level <- gsub("_", " ", pretty_level, fixed = TRUE)
+      # special handling for "cut()"
+      pattern_cut_right <- "(.*)\\((.*),(.*)\\]\\]$"
+      pattern_cut_left <- "(.*)\\[(.*),(.*)\\)\\]$"
+      if (all(grepl(pattern_cut_right, pretty_level))) {
+        lower_bounds <- gsub(pattern_cut_right, "\\2", pretty_level)
+        upper_bounds <- gsub(pattern_cut_right, "\\3", pretty_level)
+        pretty_level <- gsub(pattern_cut_right, paste0("\\1>", as.numeric(lower_bounds), "-", upper_bounds, "]"), pretty_level)
+      } else if (all(grepl(pattern_cut_left, pretty_level))) {
+        lower_bounds <- gsub(pattern_cut_left, "\\2", pretty_level)
+        upper_bounds <- gsub(pattern_cut_left, "\\3", pretty_level)
+        pretty_level <- gsub(pattern_cut_left, paste0("\\1", as.numeric(lower_bounds), "-<", upper_bounds, "]"), pretty_level)
+      }
       # insert new pretty level at the correct position in "pretty_names"
       pretty_names <- .insert_element_at(
         pretty_names,

tests/testthat/test-include_reference.R

@@ -42,3 +42,17 @@ test_that("include_reference, on-the-fly factors", {
 
   expect_equal(attributes(out1)$pretty_names, attributes(out3)$pretty_names, ignore_attr = TRUE)
 })
+
+test_that("include_reference, with pretty formatted cut", {
+  data(mtcars)
+  mtcars$mpg_cut <- cut(mtcars$mpg, breaks = c(0, 20, 30, 100))
+  m <- lm(wt ~ mpg_cut, data = mtcars)
+  out <- parameters(m, include_reference = TRUE)
+  expect_identical(
+    attributes(out)$pretty_names,
+    c(
+      `(Intercept)` = "(Intercept)", `mpg_cut(0,20]` = "mpg cut [>0-20]",
+      `mpg_cut(20,30]` = "mpg cut [>20-30]", `mpg_cut(30,100]` = "mpg cut [>30-100]"
+    )
+  )
+})