color_dissimilarity

Measure the similarity of colors in a palette, and choose dissimilar colors from them.
git clone https://git.eamoncaddigan.net/color_dissimilarity.git
Log | Files | Refs | README | LICENSE

dissimilarity.R (2919B)

      1 # Make sure we have the packages we need, but don't attach the name space to the search path
      2 loadNamespace('colorspace')
      3 loadNamespace('grDevices')
      4 
      5 #' Find the dissimilarity of colors in a colorspace RGB object.
      6 #'
      7 #' This estimates the "dissimilarity" of pairs of colors by measuring their
      8 #' Euclidean distance in CIELAB space.
      9 #'
     10 #' @param colors_rgb A set of colors represented by a colorspace RGB object or
     11 #'   other color object
     12 #'
     13 #' @return A triangular numeric matrix of dissimilarity values
     14 lab_dist <- function(colors_rgb) {
     15   colors_lab <- as(colors_rgb, 'LAB')
     16   as.matrix(stats::dist(colors_lab@coords, method = 'euclidean'))
     17 }
     18 
     19 
     20 #' Apply a CVD transformation to a colorspace RGB object.
     21 #'
     22 #' @param colors_rgb A set of colors represented by a colorspace RGB object or
     23 #'   other color object
     24 #' @param cvd_function A colorspace CVD transformation
     25 #'
     26 #' @return A transformed set of colors represented by a colorspace RGB object
     27 apply_cvd <- function(colors_rgb, cvd_function = identity) {
     28   colors_cvd_mat <- cvd_function(t(colors_rgb@coords))
     29   colorspace::RGB(colors_cvd_mat['R', ],
     30                   colors_cvd_mat['G', ],
     31                   colors_cvd_mat['B', ])
     32 }
     33 
     34 
     35 #' `R` color to colorspace RGB object conversion.
     36 #'
     37 #' @param cols A character vector of colors, can be names returned by `colors()`
     38 #'   or hex codes
     39 #'
     40 #' @return A colorspace RGB color object
     41 col2RGB <- function(cols) {
     42   cols_mat <- grDevices::col2rgb(cols)
     43   colorspace::RGB(cols_mat['red', ], cols_mat['green', ], cols_mat['blue', ])
     44 }
     45 
     46 
     47 #' Find the dissimilarity of a vector of `R` colors.
     48 #'
     49 #' @param cols A character vector of colors, can be names returned by `colors()`
     50 #'   or hex codes
     51 #' @param cvd A color vision deficiency to apply to the colors before measuring
     52 #'   dissimilarity. Must be one of 'deuteranomaly', 'monochromacy', or 'none'.
     53 #'
     54 #' @return A triangular numeric matrix of dissimilarity values
     55 #' @export
     56 #'
     57 #' @examples
     58 #' # A good set of colors from ColorBrewer
     59 #' cvd_dissimilarity(c('#a6cee3', '#1f78b4', '#b2df8a', '#33a02c'), 'monochromacy')
     60 #'
     61 #' # Red and green are easy to differentiate for people with normal color
     62 #' # vision, but much harder for those of us with deuteranomaly.
     63 #' cvd_dissimilarity(c('red1', 'green'), cvd = 'none')
     64 #' cvd_dissimilarity(c('red1', 'green'), cvd = 'deuteranomaly')
     65 cvd_dissimilarity <- function(cols, cvd = "deuteranomaly") {
     66   # Find the CVD transform
     67   if (cvd == "deuteranomaly") {
     68     cvd_fn <- function(x) colorspace::deutan(x, 0.5)
     69   } else if (cvd == "monochromacy") {
     70     cvd_fn <- colorspace::desaturate
     71   } else if (cvd == "none") {
     72     cvd_fn <- identity
     73   } else {
     74     stop("cvd must be one of 'deuteranomaly', 'monochromacy', or 'none'")
     75   }
     76 
     77   # Apply the transformation and get the dissimilarity matrix
     78   dissim_mat <- lab_dist(apply_cvd(col2RGB(cols), cvd_fn))
     79   colnames(dissim_mat) <- cols
     80   rownames(dissim_mat) <- cols
     81 
     82   dissim_mat
     83 }