-
-
Save johnbaums/45b49da5e260a9fc1cd7 to your computer and use it in GitHub Desktop.
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)) | |
} |
@isezen You can set a seed before calling iwanthue
, with, for example, set.seed(1)
. I've added this behaviour as default, which can be over-ridden with random=TRUE
.
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')
).
Thank you very much. Nice indeed. But is it possible to have the same distinct colours each time we called the function for the same n value?