# color_dissimilarity

Measure the similarity of colors in a palette, and choose dissimilar colors from them.

dissimilarity.R (2919B)

```      1 # Make sure we have the packages we need, but don't attach the name space to the search path
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 }
```