Re: [R] hcl()

From: Prof Brian Ripley <ripley_at_stats.ox.ac.uk>
Date: Fri 24 Jun 2005 - 22:58:37 EST

On Fri, 24 Jun 2005, Martin Maechler wrote:

> I have written a nice (IMO) function that lets you explore the
> hcl space quite nicely, and show its calls.
>
> hcl.wheel <-
> function(chroma = 35, lums = 0:100, hues = 1:360, asp = 1,
> p.cex = 0.6, do.label = FALSE, rev.lum = FALSE,
> fixup = TRUE)
> {
> ## Purpose: show chroma "sections" of hcl() color space; see ?hcl
> ## ----------------------------------------------------------------------
> ## Arguments: chroma: can be vector -> multiple plots are done,
> ## lums, hues, fixup : all corresponding to hcl()'s args
> ## rev.lum: logical indicating if luminance
> ## should go from outer to inner
> ## ----------------------------------------------------------------------
> ## Author: Martin Maechler, Date: 24 Jun 2005
>
> stopifnot(is.numeric(lums), lums >= 0, lums <= 100,
> is.numeric(hues), hues >= 0, hues <= 360,
> is.numeric(chroma), chroma >= 0, (nch <- length(chroma)) >= 1)
> if(is.unsorted(hues)) hues <- sort(hues)
> if(nch > 1) {
> op <- par(mfrow= n2mfrow(nch), mar = c(0,0,0,0))
> on.exit(par(op))
> }
> for(i.c in 1:nch) {
> plot(-1:1,-1:1, type="n", axes = FALSE, xlab="",ylab="", asp = asp)
> ## main = sprintf("hcl(h = <angle>, c = %g)", chroma[i.c]),
> text(0.4, 0.99, paste("chroma =", format(chroma[i.c])),
> adj = 0, font = 4)
> l.s <- (if(rev.lum) rev(lums) else lums) / max(lums) # <= 1
> for(ang in hues) { # could do all this using outer() instead of for()...
> a. <- ang * pi/180
> z.a <- exp(1i * a.)
> cols <- hcl(ang, c = chroma[i.c], l = lums, fixup = fixup)
> points(l.s * z.a, pch = 16, col = cols, cex = p.cex)
> ##if(do."text") : draw the 0,45,90,... angle "lines"
> if(do.label)
> text(z.a*1.05, labels = ang, col = cols[length(cols)/2],
> srt = ang)
> }
> if(!fixup) ## show the outline
> lines(exp(1i * hues * pi/180))
> }
> invisible()
> }
>
> ##-- and now a few interesting calls
>
> hcl.wheel() # and watch it redraw when you fiddle with the graphic window
> hcl.wheel(rev.lum= TRUE) # dito
> hcl.wheel(do.lab = TRUE) # dito
>
>
> ## Now watch:
> hcl.wheel(ch = c(25,35,45,55))
>
> hcl.wheel(ch = seq(10, 90, by = 10), p.cex = 0.4)
> hcl.wheel(ch = seq(10, 90, by = 10), p.cex = 0.3, fixup = FALSE)
> hcl.wheel(ch = seq(10, 90, by = 10), p.cex = 0.3, rev.lum = TRUE)
> x11() # new device -- in order to compare with previous :
> hcl.wheel(ch = seq(10, 90, by = 10), p.cex = 0.3, rev.lum = TRUE, fixup=FALSE)
>
> ## the last two, in my eyes show that
> ## 1) fixup = TRUE {the default!} works quite nicely in most cases
> ## 2) Robin's original problem was a sample of a much larger "problem"
> ## where IMO the 'fixup' algorithm ``breaks down'' and I
> ## think should be improvable.

It shows that there are slow but massive hue shifts at low luminance. There are better algorithms than the C code uses but maybe not much better for colours way out of gamut.

-- 
Brian D. Ripley,                  ripley@stats.ox.ac.uk
Professor of Applied Statistics,  http://www.stats.ox.ac.uk/~ripley/
University of Oxford,             Tel:  +44 1865 272861 (self)
1 South Parks Road,                     +44 1865 272866 (PA)
Oxford OX1 3TG, UK                Fax:  +44 1865 272595

______________________________________________
R-help@stat.math.ethz.ch mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide! http://www.R-project.org/posting-guide.html
Received on Fri Jun 24 23:01:57 2005

This archive was generated by hypermail 2.1.8 : Fri 03 Mar 2006 - 03:33:02 EST