color_dissimilarity

commit 10958bd837bf8c90ef49074745deebde585e67c4
parent 9aa42913b9d189ab39a987ee5936be23256ac138
Author: Eamon Caddigan <eamon.caddigan@gmail.com>
Date:   Sun,  5 Sep 2021 13:22:07 -0400

A working algorithm?

Diffstat:
A
max_dissim.R
 | 
51
+++++++++++++++++++++++++++++++++++++++++++++++++++

1 file changed, 51 insertions(+), 0 deletions(-)
diff --git a/max_dissim.R b/max_dissim.R
@@ -0,0 +1,51 @@
+# For all possible numbers of colors return the set with the maximum minimum dissimilarity
+
+
+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])))
+  }
+}
+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')]))
+
+  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
+    }
+  }
+
+  # Any sets that differed only by substituting n for m are now duplicated, so
+  # get rid of them
+  col_sets <- unique(col_sets)
+}