color_dissimilarity

commit 4858784e2426eaf719cc3b206c07c3aa27510ace
parent 7a166dd967ed2525e199a8ad8dd44329efe3b351
Author: Eamon Caddigan <eamon.caddigan@gmail.com>
Date:   Sat,  4 Sep 2021 17:10:50 -0400

Mostly an unorganized collection of helper functions ATM

Diffstat:
A
dissimilarity.R
 | 
42
++++++++++++++++++++++++++++++++++++++++++

1 file changed, 42 insertions(+), 0 deletions(-)
diff --git a/dissimilarity.R b/dissimilarity.R
@@ -0,0 +1,42 @@
+# Make sure we have the packages we need, but don't attach the name space to the search path
+loadNamespace('colorspace')
+loadNamespace('grDevices')
+
+# Some colors as a matrix
+some_colors_mat <- grDevices::col2rgb(c('red', 'black', 'white', 'khaki', 'gray50',
+                                        '#a6cee3', '#1f78b4', '#b2df8a', '#33a02c'))
+
+# Turn them into colorspace RGB objects
+some_colors_rgb <- colorspace::RGB(some_colors_mat['red', ],
+                                   some_colors_mat['green', ],
+                                   some_colors_mat['blue', ])
+
+# Convert a colorspace RGB object to LAB and calculate a dissimilarity matrix
+lab_dist <- function(colors_rgb) {
+  colors_lab <- as(colors_rgb, 'LAB')
+  as.matrix(stats::dist(some_colors_lab@coords, method = 'euclidean'))
+}
+
+# Apply the given colorspace CVD transformation to the colorspace  RGB object
+# and return a colorspace object
+apply_cvd <- function(colors_rgb, cvd_function = identity) {
+  colors_cvd_mat <- cvd_function(t(colors_rgb@coords))
+  colorspace::RGB(colors_cvd_mat['R', ],
+                  colors_cvd_mat['G', ],
+                  colors_cvd_mat['B', ])
+}
+
+# Turn a colorspace RGB object into a vector of hex codes (`colorspace::hex()`
+# should do this but it doesn't work)
+RGB2hex <- function(colors_rgb) {
+  grDevices::rgb(pmin(colors_rgb@coords[, 'R'] / 255, 1),
+                 pmin(colors_rgb@coords[, 'G'] / 255, 1),
+                 pmin(colors_rgb@coords[, 'B'] / 255, 1))
+}
+
+
+
+compare_colors <- function(colors_rgb, cvd_function = identity) {
+  colorspace::swatchplot(RGB2hex(colors_rgb),
+                         RGB2hex(apply_cvd(colors_rgb, cvd_function)))
+}