commit 9aa42913b9d189ab39a987ee5936be23256ac138
parent 4858784e2426eaf719cc3b206c07c3aa27510ace
Author: Eamon Caddigan <eamon.caddigan@gmail.com>
Date: Sat, 4 Sep 2021 19:14:30 -0400
Doing the whole dissimilarity matrix
Diffstat:
5 files changed, 131 insertions(+), 23 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -37,3 +37,7 @@ vignettes/*.pdf
# R Environment Variables
.Renviron
+
+# Generated files (for this)
+*.html
+
diff --git a/README.md b/README.md
@@ -1,7 +1,7 @@
# color_dissimilarity
Measure the similarity of colors in a palette, and choose dissimilar colors from them
-I'm not developing an entire package here, just sketching out ways to do some things that I often want to do.
+I'm not developing an entire package here (I'm using the MIT Lincense intentionally to make it easy for you to use it in _your_ package), just sketching out ways to do some things that I often want to do.
Some goals:
* Measure the (dis)similarity of colors is a perceptually scaled space (CIELAB) with a couple different options for dealing with colorblindness.
diff --git a/color_utils.R b/color_utils.R
@@ -0,0 +1,15 @@
+#' Convert a colorspace RGB object into a vector of hex codes.
+#'
+#' I thought the function `colorspace::hex()` would do this but it doesn't seem
+#' to work. Maybe I'm doing something wrong?
+#'
+#' @param colors_rgb A colorspace RGB object
+#'
+#' @return A vector of hex codes.
+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))
+}
+
+
diff --git a/demo.Rmd b/demo.Rmd
@@ -0,0 +1,48 @@
+---
+title: "Demonstrations"
+author: "Eamon Caddigan"
+date: "9/4/2021"
+output: html_document
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(echo = TRUE)
+```
+
+First, make sure we have the libraries we need and import the R scripts.
+
+```{r}
+library(colorspace)
+library(grDevices)
+```
+```{r}
+source('dissimilarity.R')
+source('color_utils.R')
+```
+```{r}
+compare_colors <- function(cols, cvd_function = identity) {
+ colorspace::swatchplot(cols,
+ RGB2hex(apply_cvd(col2RGB(cols), cvd_function)))
+}
+```
+
+Next let's grab some random colors and show them.
+
+```{r}
+some_colors <- c('red', 'black', 'white', 'khaki', 'gray50',
+ '#a6cee3', '#1f78b4', '#b2df8a', '#33a02c')
+compare_colors(some_colors)
+```
+
+Here's the mild deuteranomaly we're using for the default color comparison (it's more extreme than my own).
+
+```{r}
+compare_colors(some_colors, function(x) colorspace::deutan(x, 0.5))
+```
+
+And here's the dissimilarity matrix of the colors.
+
+```{r}
+image(cvd_dissimilarity(some_colors))
+```
+
diff --git a/dissimilarity.R b/dissimilarity.R
@@ -2,23 +2,28 @@
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
+#' Find the dissimilarity of colors in a colorspace RGB object.
+#'
+#' This estimates the "dissimilarity" of pairs of colors by measuring their
+#' Euclidean distance in CIELAB space.
+#'
+#' @param colors_rgb A set of colors represented by a colorspace RGB object or
+#' other color object
+#'
+#' @return A triangular numeric matrix of dissimilarity values
lab_dist <- function(colors_rgb) {
colors_lab <- as(colors_rgb, 'LAB')
- as.matrix(stats::dist(some_colors_lab@coords, method = 'euclidean'))
+ as.matrix(stats::dist(colors_lab@coords, method = 'euclidean'))
}
-# Apply the given colorspace CVD transformation to the colorspace RGB object
-# and return a colorspace object
+
+#' Apply a CVD transformation to a colorspace RGB object.
+#'
+#' @param colors_rgb A set of colors represented by a colorspace RGB object or
+#' other color object
+#' @param cvd_function A colorspace CVD transformation
+#'
+#' @return A transformed set of colors represented by a colorspace RGB object
apply_cvd <- function(colors_rgb, cvd_function = identity) {
colors_cvd_mat <- cvd_function(t(colors_rgb@coords))
colorspace::RGB(colors_cvd_mat['R', ],
@@ -26,17 +31,53 @@ apply_cvd <- function(colors_rgb, cvd_function = identity) {
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))
+
+#' `R` color to colorspace RGB object conversion.
+#'
+#' @param cols A character vector of colors, can be names returned by `colors()`
+#' or hex codes
+#'
+#' @return A colorspace RGB color object
+col2RGB <- function(cols) {
+ cols_mat <- grDevices::col2rgb(cols)
+ colorspace::RGB(cols_mat['red', ], cols_mat['green', ], cols_mat['blue', ])
}
+#' Find the dissimilarity of a vector of `R` colors.
+#'
+#' @param cols A character vector of colors, can be names returned by `colors()`
+#' or hex codes
+#' @param cvd A color vision deficiency to apply to the colors before measuring
+#' dissimilarity. Must be one of 'deuteranomaly', 'monochromacy', or 'none'.
+#'
+#' @return A triangular numeric matrix of dissimilarity values
+#' @export
+#'
+#' @examples
+#' # A good set of colors from ColorBrewer
+#' cvd_dissimilarity(c('#a6cee3', '#1f78b4', '#b2df8a', '#33a02c'), 'monochromacy')
+#'
+#' # Red and green are easy to differentiate for people with normal color
+#' # vision, but much harder for those of us with deuteranomaly.
+#' cvd_dissimilarity(c('red1', 'green'), cvd = 'none')
+#' cvd_dissimilarity(c('red1', 'green'), cvd = 'deuteranomaly')
+cvd_dissimilarity <- function(cols, cvd = "deuteranomaly") {
+ # Find the CVD transform
+ if (cvd == "deuteranomaly") {
+ cvd_fn <- function(x) colorspace::deutan(x, 0.5)
+ } else if (cvd == "monochromacy") {
+ cvd_fn <- colorspace::desaturate
+ } else if (cvd == "none") {
+ cvd_fn <- identity
+ } else {
+ stop("cvd must be one of 'deuteranomaly', 'monochromacy', or 'none'")
+ }
+
+ # Apply the transformation and get the dissimilarity matrix
+ dist_mat <- lab_dist(apply_cvd(col2RGB(cols), cvd_fn))
+ colnames(dist_mat) <- cols
+ rownames(dist_mat) <- cols
-compare_colors <- function(colors_rgb, cvd_function = identity) {
- colorspace::swatchplot(RGB2hex(colors_rgb),
- RGB2hex(apply_cvd(colors_rgb, cvd_function)))
+ dist_mat
}
