Merge pull request #1930 from xx02al/autocoloroptions

Autocoloroptions

Author: rich-iannone

DESCRIPTION

@@ -53,6 +53,7 @@ Imports:
     vctrs,
     xml2 (>= 1.3.6)
 Suggests:
+    farver,
     fontawesome (>= 0.5.2),
     ggplot2,
     grid,

NEWS.md

@@ -2,6 +2,8 @@
 
 ## Minor improvements and bug fixes
 
+* `data_color()` now allows to specify which light/dark color to use when `autocolor_text = TRUE` (@xx02al, #1930).
+
 * Fixed an issue with a warning in Quarto (@olivroy, #1985)
 
 * `as_word()` now handles "<br>" line breaks for `md()` and `html()`, and no longer automatically adds "Table N" ahead of the caption. 

R/data_color.R

@@ -57,7 +57,8 @@
 #' text
 #' - text autocoloring: if colorizing the cell background, `data_color()` will
 #' automatically recolor the foreground text to provide the best contrast (can
-#' be deactivated with `autocolor_text = FALSE`)
+#' be deactivated with `autocolor_text = FALSE`; a light and dark color to be
+#' used can be specified with `autocolor_light` and `autocolor_dark`)
 #'
 #' `data_color()` won't fail with the default options used, but
 #' that won't typically provide you the type of colorization you really need.
@@ -233,6 +234,22 @@
 #'   default this is `"apca"` (Accessible Perceptual Contrast Algorithm) and the
 #'   alternative to this is `"wcag"` (Web Content Accessibility Guidelines).
 #'
+#' @param autocolor_light *Automatically recolor text, light color*
+#'
+#'   `scalar<character>` // *default:* `"white"`
+#'
+#'   The light color to use when `autocolor_text = TRUE`. By default the color
+#'   `"white"` will be used (`#FFFFFF"`). Alpha channel values will be set to
+#'   1.0 (fully opaque).
+#'
+#' @param autocolor_dark *Automatically recolor text, dark color*
+#'
+#'   `scalar<character>` // *default:* `"black"`
+#'
+#'   The dark color to use when `autocolor_text = TRUE`. By default the color
+#'   `"black"` will be used (`#000000"`). Alpha channel values will be set to
+#'   1.0 (fully opaque).
+#'
 #' @param colors *[Deprecated] Color mapping function*
 #'
 #'   `function` // *default:* `NULL` (`optional`)
@@ -363,7 +380,9 @@
 #' setting `autocolor_text` to `FALSE`. The `contrast_algo` argument lets us
 #' choose between two color contrast algorithms: `"apca"` (*Accessible
 #' Perceptual Contrast Algorithm*, the default algo) and `"wcag"` (*Web Content
-#' Accessibility Guidelines*).
+#' Accessibility Guidelines*). `autocolor_light` and `autocolor_dark` allow for
+#' further customization, however, should only be used if you are sure that
+#' accessibility criteria are guaranteed.
 #'
 #' @section Examples:
 #'
@@ -673,6 +692,8 @@ data_color <- function(
     apply_to = c("fill", "text"),
     autocolor_text = TRUE,
     contrast_algo = c("apca", "wcag"),
+    autocolor_light = "#FFFFFF",
+    autocolor_dark = "#000000",
     colors = NULL
 ) {
 
@@ -695,6 +716,21 @@ data_color <- function(
   # Get the correct `contrast_algo` value
   contrast_algo <- rlang::arg_match0(contrast_algo, values = c("apca", "wcag"))
 
+  # When using non-default `autocolor_light` or `autocolor_dark`, check if
+  # {farver} is installed and stop if not (we would error in `ideal_fgnd_color()`,
+  # check here to get out early)
+  if (rlang::is_true(autocolor_text) && !autocolor_light %in% c("white", "#FFFFFF", "#FFF")) {
+    rlang::check_installed(
+      "farver", reason = "to use non-default `autocolor_light`."
+      )
+  }
+
+  if (rlang::is_true(autocolor_text) && !autocolor_dark %in% c("black", "#000000", "#000")) {
+    rlang::check_installed(
+      "farver", reason = "to use non-default `autocolor_dark`."
+      )
+  }
+
   # If no color is provided to `na_color`, use gray as a default
   na_color <- na_color %||% "#808080"
 
@@ -1126,6 +1162,8 @@ data_color <- function(
       color_vals <-
         ideal_fgnd_color(
           bgnd_color = color_vals,
+          light = autocolor_light,
+          dark = autocolor_dark,
           algo = contrast_algo
         )
 
@@ -1272,8 +1310,10 @@ expand_short_hex <- function(colors) {
 
 #' For a background color, which foreground color provides better contrast?
 #'
-#' The input for this function is a single color value in 'rgba()' format. The
-#' output is a single color value in #RRGGBB hexadecimal format
+#' The `bgnd_color` input for this function is a single color value in 'rgba()'
+#' format. The output is a single color value in #RRGGBB hexadecimal format.
+#' `light` and `dark` accepts every color(specification) that can be handled by
+#' {farver}.
 #'
 #' @noRd
 ideal_fgnd_color <- function(
@@ -1286,6 +1326,9 @@ ideal_fgnd_color <- function(
   # Get the correct `algo` value
   algo <- rlang::arg_match0(algo, values = c("apca", "wcag"))
 
+  light_color <- farver::encode_colour(farver::decode_colour(light))
+  dark_color <- farver::encode_colour(farver::decode_colour(dark))
+
   # Normalize color to hexadecimal color if it is in the 'rgba()' string format
   bgnd_color <- rgba_to_hex(colors = bgnd_color)
 
@@ -1295,17 +1338,17 @@ ideal_fgnd_color <- function(
   if (algo == "apca") {
 
     # Determine the ideal color for the chosen background color with APCA
-    contrast_dark <- get_contrast_ratio(color_1 = dark, color_2 = bgnd_color, algo = "apca")[, 1]
-    contrast_light <- get_contrast_ratio(color_1 = light, color_2 = bgnd_color, algo = "apca")[, 1]
+    contrast_dark <- get_contrast_ratio(color_1 = dark_color, color_2 = bgnd_color, algo = "apca")[, 1]
+    contrast_light <- get_contrast_ratio(color_1 = light_color, color_2 = bgnd_color, algo = "apca")[, 1]
 
   } else {
 
     # Determine the ideal color for the chosen background color with WCAG
-    contrast_dark <- get_contrast_ratio(color_1 = dark, color_2 = bgnd_color, algo = "wcag")
-    contrast_light <- get_contrast_ratio(color_1 = light, color_2 = bgnd_color, algo = "wcag")
+    contrast_dark <- get_contrast_ratio(color_1 = dark_color, color_2 = bgnd_color, algo = "wcag")
+    contrast_light <- get_contrast_ratio(color_1 = light_color, color_2 = bgnd_color, algo = "wcag")
   }
 
-  ifelse(abs(contrast_dark) >= abs(contrast_light), dark, light)
+  ifelse(abs(contrast_dark) >= abs(contrast_light), dark_color, light_color)
 }
 
 #' Convert colors in mixed formats (incl. rgba() strings) format to hexadecimal

R/utils_color_contrast.R

@@ -135,7 +135,7 @@ get_relative_luminance_wcag <- function(col) {
 
   coef <- round(c(apca_coeffs$sRco, apca_coeffs$sGco, apca_coeffs$sBco), 4)
 
-  rgb[] <- ifelse(rgb <= 0.03928, rgb / 12.92, ((rgb + 0.055) / 1.055)^2.4)
+  rgb[] <- ifelse(rgb <= 0.04045, rgb / 12.92, ((rgb + 0.055) / 1.055)^2.4)
 
   as.numeric(rgb %*% coef)
 }