Last active
October 24, 2024 19:45
-
-
Save johnbaums/45b49da5e260a9fc1cd7 to your computer and use it in GitHub Desktop.
Palettes of distinct colours, generated through kmeans clustering of LAB colour space
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
swatch <- function(x) { | |
# x: a vector of colours (hex, numeric, or string) | |
par(mai=c(0.2, max(strwidth(x, "inch") + 0.4, na.rm = TRUE), 0.2, 0.4)) | |
barplot(rep(1, length(x)), col=rev(x), space = 0.1, axes=FALSE, | |
names.arg=rev(x), cex.names=0.8, horiz=T, las=1) | |
} | |
# Example: | |
# swatch(colours()[1:10]) | |
# swatch(iwanthue(5)) | |
# swatch(1:4) | |
iwanthue <- function(n, hmin=0, hmax=360, cmin=0, cmax=180, lmin=0, lmax=100, | |
plot=FALSE, random=FALSE) { | |
# Presently doesn't allow hmax > hmin (H is circular) | |
# n: number of colours | |
# hmin: lower bound of hue (0-360) | |
# hmax: upper bound of hue (0-360) | |
# cmin: lower bound of chroma (0-180) | |
# cmax: upper bound of chroma (0-180) | |
# lmin: lower bound of luminance (0-100) | |
# lmax: upper bound of luminance (0-100) | |
# plot: plot a colour swatch? | |
# random: should clustering be random? (if FALSE, seed will be set to 1, | |
# and the RNG state will be restored on exit.) | |
require(colorspace) | |
stopifnot(hmin >= 0, cmin >= 0, lmin >= 0, | |
hmax <= 360, cmax <= 180, lmax <= 100, | |
hmin <= hmax, cmin <= cmax, lmin <= lmax, | |
n > 0) | |
if(!random) { | |
if (exists(".Random.seed", .GlobalEnv)) { | |
old_seed <- .GlobalEnv$.Random.seed | |
on.exit(.GlobalEnv$.Random.seed <- old_seed) | |
} else { | |
on.exit(rm(".Random.seed", envir = .GlobalEnv)) | |
} | |
set.seed(1) | |
} | |
lab <- LAB(as.matrix(expand.grid(seq(0, 100, 1), | |
seq(-100, 100, 5), | |
seq(-110, 100, 5)))) | |
if (any((hmin != 0 || cmin != 0 || lmin != 0 || | |
hmax != 360 || cmax != 180 || lmax != 100))) { | |
hcl <- as(lab, 'polarLUV') | |
hcl_coords <- coords(hcl) | |
hcl <- hcl[which(hcl_coords[, 'H'] <= hmax & hcl_coords[, 'H'] >= hmin & | |
hcl_coords[, 'C'] <= cmax & hcl_coords[, 'C'] >= cmin & | |
hcl_coords[, 'L'] <= lmax & hcl_coords[, 'L'] >= lmin), ] | |
#hcl <- hcl[-which(is.na(coords(hcl)[, 2]))] | |
lab <- as(hcl, 'LAB') | |
} | |
lab <- lab[which(!is.na(hex(lab))), ] | |
clus <- kmeans(coords(lab), n, iter.max=50) | |
if (isTRUE(plot)) { | |
swatch(hex(LAB(clus$centers))) | |
} | |
hex(LAB(clus$centers)) | |
} |
John, thank you very much for writing this - under which license is this available? I have written a software for interactive visual analysis of differential gene expression results in R and could really use your iWantHue. I want to publish my stuff under a FOSS license - probably MIT. Is it okay to copy, modify your function?
@antonkratz - Sorry for the very delayed response... when will GitHub notify us of comments on Gists?? I also believe in FOSS, so feel free to use/modify the code in your own FOSS products. I'm happy for it to fall under an MIT license . I only ask that you list me as a contributor. In case you didn't see, I've packaged the functions up into hues
(devtools::install_packages('johnbaums/hues')
).
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
@isezen & @mavam - now packaged in
hues
, here.