commit 708361796bcd0dc533d51bba10dffc232ebcc0dd
parent 10958bd837bf8c90ef49074745deebde585e67c4
Author: Eamon Caddigan <eamon.caddigan@gmail.com>
Date: Sun, 5 Sep 2021 14:03:24 -0400
No, not a working algorithm
Diffstat:
| M | demo.Rmd | | | 12 | +++++++++++- |
| M | max_dissim.R | | | 83 | +++++++++++++++++++++++++++++++++++++++++-------------------------------------- |
2 files changed, 54 insertions(+), 41 deletions(-)
diff --git a/demo.Rmd b/demo.Rmd
@@ -17,6 +17,7 @@ library(grDevices)
```
```{r}
source('dissimilarity.R')
+source('max_dissim.R')
source('color_utils.R')
```
```{r}
@@ -31,6 +32,7 @@ Next let's grab some random colors and show them.
```{r}
some_colors <- c('red', 'black', 'white', 'khaki', 'gray50',
'#a6cee3', '#1f78b4', '#b2df8a', '#33a02c')
+some_colors <- paste0("gray", round(seq(10, 90, length.out = 13)))
compare_colors(some_colors)
```
@@ -43,6 +45,14 @@ 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))
+dissim_mat <- cvd_dissimilarity(some_colors)
+image(dissim_mat)
```
+Let's look at sets of dissimilar colors from the palette.
+
+```{r}
+lapply(max_dissim_colors(dissim_mat), unlist)
+```
+
+No, this isn't doing the right thing! :(
diff --git a/max_dissim.R b/max_dissim.R
@@ -1,51 +1,54 @@
# For all possible numbers of colors return the set with the maximum minimum dissimilarity
+max_dissim_colors <- function(dissim_mat) {
+ col_names <- colnames(dissim_mat)
+ N <- ncol(dissim_mat)
+ if (is.null(col_names))
+ col_names <- as.character(seq(N))
-col_names <- colnames(dissim_mat)
-N <- ncol(dissim_mat)
-if (is.null(col_names))
- col_names <- as.character(seq(N))
-
-# Build a data frame of color pairs ordered from most to least dissimilar
-col_pairs <- list()
-for (n in seq_len(N-1)) {
- for (m in seq(n+1, N)) {
- col_pairs <- append(col_pairs,
- list(c(n, m, dissim_mat[n, m])))
+ # Build a data frame of color pairs ordered from most to least dissimilar
+ col_pairs <- list()
+ for (n in seq_len(N-1)) {
+ for (m in seq(n+1, N)) {
+ col_pairs <- append(col_pairs,
+ list(c(n, m, dissim_mat[n, m])))
+ }
}
-}
-col_pairs <- as.data.frame(matrix(unlist(col_pairs), ncol = 3, byrow = TRUE))
-colnames(col_pairs) <- c("n", "m", "dissim")
-col_pairs <- col_pairs[order(col_pairs$dissim, decreasing = TRUE), ]
+ col_pairs <- as.data.frame(matrix(unlist(col_pairs), ncol = 3, byrow = TRUE))
+ colnames(col_pairs) <- c("n", "m", "dissim")
+ col_pairs <- col_pairs[order(col_pairs$dissim, decreasing = TRUE), ]
-# Here's the algorithm:
-# We're going to build up a list of sets of colors by considering pairs from the
-# most to least dissimilar. The first set we encounter of a given length will be
-# the set that maximizes its minimum dissimilarity. But we'll remember all of
-# the sets we've seen because any given set could have the max-min dissimularity
-# for a greater length.
-col_sets <- list()
-best_sets <- list()
-set_length_target <- 2
-for (pair_idx in seq_len(nrow(col_pairs))) {
- col_sets <- append(col_sets, list(col_pairs[pair_idx, c('n', 'm')]))
+ # Here's the algorithm:
+ # We're going to build up a list of sets of colors by considering pairs from the
+ # most to least dissimilar. The first set we encounter of a given length will be
+ # the set that maximizes its minimum dissimilarity. But we'll remember all of
+ # the sets we've seen because any given set could have the max-min dissimularity
+ # for a greater length.
+ col_sets <- list()
+ best_sets <- list()
+ set_length_target <- 2
+ for (pair_idx in seq_len(nrow(col_pairs))) {
+ col_sets <- append(col_sets, list(col_pairs[pair_idx, c('n', 'm')]))
- for (set_idx in seq_along(col_sets)) {
- # If either n or m is in the current set, add the other to it
- if (any(col_pairs[pair_idx, c('n', 'm')] %in% col_sets[[set_idx]])) {
- col_sets[[set_idx]] <- union(col_pairs[pair_idx, c('n', 'm')],
- col_sets[[set_idx]])
- }
+ for (set_idx in seq_along(col_sets)) {
+ # If either n or m is in the current set, add the other to it
+ if (any(col_pairs[pair_idx, c('n', 'm')] %in% col_sets[[set_idx]])) {
+ col_sets[[set_idx]] <- union(col_pairs[pair_idx, c('n', 'm')],
+ col_sets[[set_idx]])
+ }
- # Check if this set is the length we're looking for
- if (length(col_sets[[set_idx]]) == set_length_target) {
- best_sets <- append(best_sets,
- list(col_sets[[set_idx]]))
- set_length_target <- set_length_target + 1
+ # Check if this set is the length we're looking for
+ if (length(col_sets[[set_idx]]) == set_length_target) {
+ best_sets <- append(best_sets,
+ list(col_sets[[set_idx]]))
+ set_length_target <- set_length_target + 1
+ }
}
+
+ # Any sets that differed only by substituting n for m are now duplicated, so
+ # get rid of them
+ col_sets <- unique(col_sets)
}
- # Any sets that differed only by substituting n for m are now duplicated, so
- # get rid of them
- col_sets <- unique(col_sets)
+ best_sets
}
