diff --git a/NEWS.md b/NEWS.md index 3408f12b44..4e38488231 100644 --- a/NEWS.md +++ b/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 diff --git a/R/scale-hue.R b/R/scale-hue.R index db743612ed..414f10864e 100644 --- a/R/scale-hue.R +++ b/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]] } } diff --git a/tests/testthat/_snaps/scale-hue.md b/tests/testthat/_snaps/scale-hue.md index bccf63c43a..8221bba045 100644 --- a/tests/testthat/_snaps/scale-hue.md +++ b/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. diff --git a/tests/testthat/test-scale-hue.R b/tests/testthat/test-scale-hue.R index 12568590a8..6f0b0c5234 100644 --- a/tests/testthat/test-scale-hue.R +++ b/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]))