[R] getting 21 very different colours
Ivan Krylov
kry|ov@r00t @end|ng |rom gm@||@com
Tue Sep 11 12:31:28 CEST 2018
On Tue, 11 Sep 2018 07:34:51 +0000
Federico Calboli <federico.calboli using kuleuven.be> wrote:
> Is there a way of getting a set of 21 colours that maximises the
> differences between them?
In my limited experience, getting even 10 colours to look different
enough is a serious undertaking. Take a look at RColorBrewer:
display.brewer.all(n, "qual") stops offering palettes for n>12.
When I needed a 10-colour categorical/qualitative palette, I opted for
brute force approach of maximising the minimal distance between points
in HCL colourspace, although later my colleague told me that I just
needed an existing algorithm to place the points uniformly. It has to
be HCL and not RGB because HCL signifies the way people perceive
different colours while RGB is only a good representation hardware-wise.
Here is my code; the usual disclaimers about stuff written between 1 and
3 AM apply:
# -------------------------8<---------------------------
require(nloptr)
h <- c(0,360)
c <- c(0,137) # see the warning about fixup in `?hcl`: not all HCL points are representable in RGB
# NOTE: depending on your plot background, you may have to change at least luminance range
l <- c(30,90)
npoints <- 24 # I had only 10 here
pts <- matrix(ncol=3, nrow=npoints, dimnames=list(NULL, c("h","c","l")))
pts[,"h"] <- runif(npoints, min=h[1], max=h[2])
pts[,"c"] <- runif(npoints, min=c[1], max=c[2])
pts[,"l"] <- runif(npoints, min=l[1], max=l[2])
lb <- cbind(h=rep(h[1],npoints), c=rep(c[1],npoints), l=rep(l[1],npoints))
ub <- cbind(h=rep(h[2],npoints), c=rep(c[2],npoints), l=rep(l[2],npoints))
obj <- function(x) {
pts[,c("h","c","l")] <- x
# somehow the best results were achieved by calculating Euclidean distance from cylindrical coordinates
pts <- cbind(pts[,"c"]*sin(pts[,'h']/360*2*pi), pts[,'c']*cos(pts[,'h']/360*2*pi), pts[,'l'])
d <- as.matrix(dist(pts))
diag(d) <- NA
# maximise minimal distance <=> minimize negative of minimal distance
-min(d, na.rm=T)
}
# the stopping criterion is a bit lame, but the objective function here is very hard to minimize
# 1e6 iterations take a few minutes on a relatively modern desktop
sol <- nloptr(as.vector(pts), obj, lb=as.vector(lb), ub=as.vector(ub), opts=list(algorithm="NLOPT_GN_CRS2_LM", maxeval=1e6))
pts[,c("h","c",'l')] <- sol$solution
plot(pts[,"c"] * sin(pts[,"h"]/360*2*pi), pts[,"c"] * cos(pts[,"h"]/360*2*pi), col=hcl(pts[,"h"], pts[,"c"], l), pch=19, cex=2)
# -------------------------8<---------------------------
I couldn't get my code to produce 24 acceptably different colours, but
maybe you will succeed with a similar approach.
--
Best regards,
Ivan
More information about the R-help
mailing list