Allow to pass a function to color palettes

NEWS.md

@@ -1,4 +1,6 @@
 # khroma 1.13.0.9000
+## Enhancements
+* Allow to pass a color function to `palette_color_continuous()` and  `palette_color_discrete()`.
 
 # khroma 1.13.0
 ## New functions

R/palettes.R

@@ -59,8 +59,9 @@ palette_colour_picker <- palette_color_picker
 #' Color Mapping (continuous)
 #'
 #' Maps continuous values to an interpolated colors gradient.
-#' @param colors A vector of colors that values will be mapped to. If `NULL`
-#'  (the default), uses *YlOrRd* (see [grDevices::hcl.colors()]).
+#' @param colors A vector of colors or a [`function`] that when called with a
+#'  single argument (an integer specifying the number of colors) returns a
+#'  vector of colors. If `NULL` (the default), uses *YlOrRd*.
 #' @param domain A [`numeric`] range specifying the possible values that can be
 #'  mapped.
 #' @param midpoint A length-one [`numeric`] vector specifying the mid-point of
@@ -70,6 +71,7 @@ palette_colour_picker <- palette_color_picker
 #'  A palette [`function`] that when called with a single argument
 #'  (a [`numeric`] vector of continuous values) returns a [`character`] vector
 #'  of colors.
+#' @seealso [grDevices::colorRamp()]
 #' @example inst/examples/ex-palette-continuous.R
 #' @family palettes
 #' @export
@@ -101,6 +103,9 @@ palette_color_continuous <- function(colors = NULL, domain = NULL,
     if (is.null(colors)) {
       colors <- color(palette = "YlOrBr")(9)
     }
+    if (is.function(colors)) {
+      colors <- colors(9)
+    }
     colors <- grDevices::colorRamp(colors)(x[OK], ...)
 
     col <- rep(missing, length(x))
@@ -116,8 +121,9 @@ palette_colour_continuous <- palette_color_continuous
 #' Color Mapping (discrete)
 #'
 #' Maps categorical values to colors.
-#' @param colors A vector of colors that values will be mapped to. If `NULL`
-#'  (the default), uses *viridis* (see [grDevices::hcl.colors()]).
+#' @param colors A vector of colors or a [`function`] that when called with a
+#'  single argument (an integer specifying the number of colors) returns a
+#'  vector of colors. If `NULL` (the default), uses *discrete rainbow*.
 #' @param domain A vector of categorical data specifying the possible values
 #'  that can be mapped.
 #' @param ordered A [`logical`] scalar: should the levels be treated as already
@@ -154,6 +160,9 @@ palette_color_discrete <- function(colors = NULL, domain = NULL,
     if (is.null(colors)) {
       colors <- color(palette = "discreterainbow")(n)
     }
+    if (is.function(colors)) {
+      colors <- colors(n)
+    }
 
     if (length(colors) < n) {
       msg <- "Only %d colors were specified (%d are required)."

inst/tinytest/test_palettes.R

@@ -35,6 +35,10 @@ expect_warning(palette_color_picker(scheme = "bright")(LETTERS))
 expect_warning(palette_color_picker(scheme = "bright")(c(1, 2, 3, 4, 5, 6, 7)))
 
 ## Continuous ------------------------------------------------------------------
+expect_identical(
+  palette_color_continuous(color("iridescent")(3))(c(1, 2, 3)),
+  palette_color_continuous(color("iridescent"))(c(1, 2, 3))
+)
 expect_identical(
   palette_color_continuous()(c(1, 2, 3)),
   c("#FFFFE5", "#FB9A29", "#662506")
@@ -70,7 +74,11 @@ expect_identical(
 
 ## Discrete --------------------------------------------------------------------
 expect_identical(
-  palette_color_discrete(NULL, domain = LETTERS[1:23])(lvl),
+  palette_color_discrete(color("vibrant")(6))(lvl),
+  palette_color_discrete(color("vibrant"))(lvl)
+)
+expect_identical(
+  palette_color_discrete(domain = LETTERS[1:23])(lvl),
   c("#E8ECFB", "#E8ECFB", "#CAACCB", "#D9CCE3", "#E8ECFB", "#D9CCE3")
 )
 expect_identical(