Add col_contrasting()

NAMESPACE

@@ -76,6 +76,7 @@ export(cbreaks)
 export(censor)
 export(col2hcl)
 export(col_bin)
+export(col_contrasting)
 export(col_darker)
 export(col_factor)
 export(col_lighter)

R/colour-manip.R

@@ -177,6 +177,28 @@ col_mix.scales_pal <- function(a, b, amount = 0.5, space = "rgb") {
   wrap_col_adjustment(a, col_mix, list(b = b, amount = amount, space = space))
 }
 
+#' Choose a contrasting colour
+#'
+#' Chooses either `light` or `dark` based on the lightness of `colour`.
+#' This is useful for choosing a text colour that is legible on a solid background
+#' cooured with `colour`.
+#'
+#' @param colour character vector of colours to be modified
+#' @param light colour to return when `colour` is dark
+#' @param dark colour to return when `colour` is light
+#'
+#' @return A character vector of colours with the same length as `colour`
+#' @family colour manipulation
+#' @export
+#'
+#' @examples
+#' col_contrasting(c("navy", "white", "black", "yellow"))
+#'
+col_contrasting <- function(colour, light = "white", dark = "black") {
+  lab <- farver::decode_colour(colour, to = "lab")
+  ifelse(lab[, 1] < 50, light, dark)
+}
+
 #' Colour manipulation
 #'
 #' These are a set of convenience functions for standard colour manipulation

tests/testthat/test-colour-manip.R

@@ -84,3 +84,10 @@ test_that("colour manipulation functions work on palettes", {
   expect_equal(col_saturate(pal, -50)(3), c("#BF4040", "#40BF40", "#4040BF"))
   expect_equal(col_mix(pal, "white")(3), c("#FF8080", "#80FF80", "#8080FF"))
 })
+
+# col_contrasting ------------------------------------------------
+
+test_that("col_contrasting chooses suitable colours", {
+  colours <- c("navy", "white", "black", "yellow")
+  expect_equal(col_contrasting(colours), c("white", "black", "white", "black"))
+})