Improve pal_qualitative()

NEWS.md

@@ -1,5 +1,6 @@
 # ggplot2 (development version)
 
+* (internal) improvements to `pal_qualitative()` (@teunbrand, #5013)
 * `coord_radial(clip = "on")` clips to the panel area when the graphics device
   supports clipping paths (@teunbrand, #5952).
 * (internal) Panel clipping responsibility moved from Facet class to Coord 

R/scale-hue.R

@@ -205,22 +205,22 @@ scale_fill_qualitative <- function(name = waiver(), ..., type = NULL,
 #' @param type a character vector or a list of character vectors
 #' @noRd
 pal_qualitative <- function(type, h, c, l, h.start, direction) {
+  type_list <- type
+  if (!is.list(type_list)) {
+    type_list <- list(type_list)
+  }
+  if (!all(vapply(type_list, is.character, logical(1)))) {
+    stop_input_type(type, "a character vector or list of character vectors")
+  }
+  type_lengths <- lengths(type_list)
   function(n) {
-    type_list <- if (!is.list(type)) list(type) else type
-    if (!all(vapply(type_list, is.character, logical(1)))) {
-      cli::cli_abort("{.arg type} must be a character vector or a list of character vectors.")
-    }
-    type_lengths <- lengths(type_list)
     # If there are more levels than color codes default to pal_hue()
     if (max(type_lengths) < n) {
       return(scales::pal_hue(h, c, l, h.start, direction)(n))
     }
     # Use the minimum length vector that exceeds the number of levels (n)
-    type_list <- type_list[order(type_lengths)]
-    i <- 1
-    while (length(type_list[[i]]) < n) {
-      i <- i + 1
-    }
-    type_list[[i]][seq_len(n)]
+    i <- which(type_lengths >= n)
+    i <- i[which.min(type_lengths[i])]
+    type_list[[i]]
   }
 }

tests/testthat/_snaps/scale-hue.md

@@ -1,4 +1,4 @@
 # scale_hue() checks the type input
 
-    `type` must be a character vector or a list of character vectors.
+    `type` must be a character vector or list of character vectors, not an integer vector.
 

tests/testthat/test-scale-hue.R

@@ -1,6 +1,5 @@
 test_that("scale_hue() checks the type input", {
-  pal <- pal_qualitative(type = 1:4)
-  expect_snapshot_error(pal(4))
+  expect_snapshot_error(pal_qualitative(type = 1:4))
   pal <- pal_qualitative(type = colors())
   expect_silent(pal(4))
   pal <- pal_qualitative(type = list(colors()[1:10], colors()[11:30]))