Colour contrast checker in R for more than 2 colours

Viewed 69

I am trying to make a reproducible way to calculate the colour contrast of various colours for graphics on a webpage. I found the following function: https://rdrr.io/github/m-clark/visibly/src/R/color_contrast_checker.R, which does exactly what I want for a comparison between two colours.

I want to be able to give this function a foreground and background colour which are effectively lists of hex codes that can be looped through so the function calculates the colour contrast for all combinations of all colours within the two lists. I have tried to give the function a list of colours in a dataframe and use a for loop to repeat the function several times but have had no luck. I think the function isn't designed to take more than 1 element i.e. 1x foreground and 1x background colour but I am a bit of a novice with functions and for loops in R. Does anyone know how I could achieve this thanks?

Below is example code that has not had any success:

library(gplots)  
library(jsonlite)
library(dplyr)

background_col_list<-as.character(c("#6A86B8","#DFE3EB","#E57D3A","#BBB332"))
foreground_col_list<-as.character(c("#6A86B8","#DFE3EB","#E57D3A","#BBB332")) 

result.df <- expand.grid(as.character(foreground_col_list),as.character(background_col_list))

result.df<-result.df %>%
  mutate_all(as.character)

color_contrast_checker <- function(foreground, background) {
  
  #initial checks

  if ((is.null(foreground) | rlang::is_empty(foreground)) |
      (is.null(background) | rlang::is_empty(background)))
    stop('Need both foreground and background colors')
  
  if (!is.character(foreground) | !is.character(background))
    stop(strwrap('Elements must be character string as a named R color or
         hex (e.g. "#ffffff")'))
  
  #note: alpha returned by col2hex will be ignored         
     
  if (foreground %in% colors()){
    foreground <- col2hex(foreground)
  } else {
    if (!nchar(foreground) %in% c(7, 9) | !grepl('^#', foreground))
      stop(strwrap('foreground must be an R color, e.g. see colors(),
                   or a hex of the form #ff5500'))
  }
  
  if (background %in% colors()) {
    background <- col2hex(background)
  } else {
    if (!nchar(background) %in% c(7, 9) | !grepl('^#', background))
      stop(strwrap('background must be an R color, e.g. see colors(),
                   or a hex of the form #ff5500'))
  }
  
  #remove pound sign

  foreground <- substr(foreground, start = 2, stop = nchar(foreground))
  background <- substr(background, start = 2, stop = nchar(background))
  
  url <- paste0('https://webaim.org/resources/contrastchecker/?fcolor=',
                foreground,
                '&bcolor=',
                background,
                '&api')
  
  result <- suppressWarnings({readLines(url)})
  
  if (!requireNamespace('jsonlite', quietly = TRUE)) {
    result <- strsplit(
      gsub(result, pattern = '\\{|\\}|\"', replacement = ''),
      ',')
    return(result[[1]])
  }
  
data.frame(jsonlite::fromJSON(result))
  
}


for (value in result.df) {
  
  color_contrast_checker(foreground=result.df$Var1, background=result.df$Var2) #Var1 & Var2 column names of result.df df that contains list of hex codes 

}


#Have also tried:

for (i in 1:length(unique(background_col_list))) {
  
  color_contrast_checker(background_col_list, foreground_col_list) 
  
}
1 Answers

The simplest option in base R would be results = apply(result.df, 1, function(x) color_contrast_checker(x[1], x[2])) which you can then transform in more a readable output (e.g. do.call(rbind, results)).

However, this function is a bit slow - you can implement the check yourself pretty easily in R.

First, we check what W3C uses as contrast ratio:

contrast ratio (L1 + 0.05) / (L2 + 0.05), where

  • L1 is the relative luminance of the lighter of the colors, and
  • L2 is the relative luminance of the darker of the colors.

Then we check what W3C defines as relative luminance:

For the sRGB colorspace, the relative luminance of a color is defined as L = 0.2126 * R + 0.7152 * G + 0.0722 * B

So at this point all you need to do is calculate the relative luminance of each color, then their ratio, and check whether they pass any of the thresholds required:

WCAG 2.0 level AA requires a contrast ratio of at least 4.5:1 for normal text and 3:1 for large text. WCAG 2.1 requires a contrast ratio of at least 3:1 for graphics and user interface components (such as form input borders). WCAG Level AAA requires a contrast ratio of at least 7:1 for normal text and 4.5:1 for large text.

In code:

# Transform colors to RGB values, and RGB values to relative luminance

result.df$L_background = apply(col2rgb(result.df[,1]), 2, function(x) 
0.2126 * x[1] + 0.7152 * x[2] + 0.0722 * x[3])

result.df$L_foreground = apply(col2rgb(result.df[,2]), 2, function(x) 
0.2126 * x[1] + 0.7152 * x[2] + 0.0722 * x[3])

# Apply the contrast ratio formula (max luminance is brighter, min is darker)

result.df$L_ratio =  apply(result.df[,3:4], 1, function(x) 
(max(x) + 0.05)/(min(x) + 0.05))

# Check against standard thresholds
result.df$WCAG2_0_AA_pass = result.df$L_ratio > 4.5
result.df$WCAG2_1_pass = result.df$L_ratio > 3
result.df$WCAG_AAA_pass = result.df$L_ratio > 7

This is relatively fast for checks that are not huge. There may be a vectorized solution somewhere.

Related