### ----------- Show (almost) all named colors ---------------------

## 1) with traditional 'graphics' package:
showCols1 <- function(bg = "gray", cex = 0.75, srt = 30) {
    m <- ceiling(sqrt(n <- length(cl <- colors())))
    length(cl) <- m*m; cm <- matrix(cl, m)
    ##
    require("graphics")
    op <- par(mar=rep(0,4), ann=FALSE, bg = bg); on.exit(par(op))
    plot(1:m,1:m, type="n", axes=FALSE)
    text(col(cm), rev(row(cm)), cm,  col = cl, cex=cex, srt=srt)
}
showCols1()

## 2) with 'grid' package:
showCols2 <- function(bg = "grey", cex = 0.75, rot = 30) {
    m <- ceiling(sqrt(n <- length(cl <- colors())))
    length(cl) <- m*m; cm <- matrix(cl, m)
    ##
    require("grid")
    grid.newpage(); vp <- viewport(width = .92, height = .92)
    grid.rect(gp=gpar(fill=bg))
    grid.text(cm, x = col(cm)/m, y = rev(row(cm))/m, rot = rot,
              vp=vp, gp=gpar(cex = cex, col = cm))
}
showCols2()
showCols2(bg = "gray33")

###

##' @title Comparing Colors
##' @param col
##' @param nrow
##' @param ncol
##' @param txt.col
##' @return the grid layout, invisibly
##' @author Marius Hofert, originally
plotCol <- function(col, nrow=1, ncol=ceiling(length(col) / nrow),
                    txt.col="black") {
    stopifnot(nrow >= 1, ncol >= 1)
    if(length(col) > nrow*ncol)
        warning("some colors will not be shown")
    require(grid)
    grid.newpage()
    gl <- grid.layout(nrow, ncol)
    pushViewport(viewport(layout=gl))
    ic <- 1
    for(i in 1:nrow) {
        for(j in 1:ncol) {
            pushViewport(viewport(layout.pos.row=i, layout.pos.col=j))
            grid.rect(gp= gpar(fill=col[ic]))
            grid.text(col[ic], gp=gpar(col=txt.col))
            upViewport()
            ic <- ic+1
        }
    }
    upViewport()
    invisible(gl)
}

## A Chocolate Bar of colors:
plotCol(c("#CC8C3C", paste0("chocolate", 2:4),
          paste0("darkorange", c("",1:2)), paste0("darkgoldenrod", 1:2),
          "orange", "orange1", "sandybrown", "tan1", "tan2"),
        nrow=2)

##' Find close R colors() to a given color {original by Marius Hofert)
##' using Euclidean norm in (HSV / RGB / ...) color space
nearRcolor <- function(rgb, cSpace = c("hsv", "rgb255", "Luv", "Lab"),
                       dist = switch(cSpace, "hsv" = 0.10, "rgb255" = 30,
                       "Luv" = 15, "Lab" = 12))
{
    if(is.character(rgb)) rgb <- col2rgb(rgb)
    stopifnot(length(rgb <- as.vector(rgb)) == 3)
    Rcol <- col2rgb(.cc <- colors())
    uniqC <- !duplicated(t(Rcol)) # gray9 == grey9 (etc)
    Rcol <- Rcol[, uniqC] ; .cc <- .cc[uniqC]
    cSpace <- match.arg(cSpace)
    convRGB2 <- function(Rgb, to)
        t(convertColor(t(Rgb), from="sRGB", to=to, scale.in=255))
    ## the transformation,  rgb{0..255} --> cSpace :
    TransF <- switch(cSpace,
                     "rgb255" = identity,
                     "hsv" = rgb2hsv,
                     "Luv" = function(RGB) convRGB2(RGB, "Luv"),
                     "Lab" = function(RGB) convRGB2(RGB, "Lab"))
    d <- sqrt(colSums((TransF(Rcol) - as.vector(TransF(rgb)))^2))
    iS <- sort.list(d[near <- d <= dist])# sorted: closest first
    setNames(.cc[near][iS], format(zapsmall(d[near][iS]), digits=3))
}

nearRcolor(col2rgb("tan2"), "rgb")
nearRcolor(col2rgb("tan2"), "hsv")
nearRcolor(col2rgb("tan2"), "Luv")
nearRcolor(col2rgb("tan2"), "Lab")

nearRcolor("#334455")

## Now, consider choosing a color by looking in the
## neighborhood of one you know :

plotCol(nearRcolor("deepskyblue", "rgb", dist=50))
plotCol(nearRcolor("deepskyblue", dist=.1))

plotCol(nearRcolor("tomato", "rgb", dist= 50), nrow=3)
plotCol(nearRcolor("tomato", "hsv", dist=.12), nrow=3)
plotCol(nearRcolor("tomato", "Luv", dist= 25), nrow=3)
plotCol(nearRcolor("tomato", "Lab", dist= 18), nrow=3)
### ------ hcl() explorations

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

    require("graphics")
    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), xpd = TRUE)
        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) # ditto
hcl.wheel(do.label = TRUE) # ditto


## Now watch:
hcl.wheel(chroma = c(25,35,45,55))

hcl.wheel(chroma = seq(10, 90, by = 10), p.cex = 0.4)
hcl.wheel(chroma = seq(10, 90, by = 10), p.cex = 0.3, fixup = FALSE)
hcl.wheel(chroma = seq(10, 90, by = 10), p.cex = 0.3, rev.lum = TRUE)
if(dev.interactive()) # new "graphics window" -- to compare with previous :
    dev.new()
hcl.wheel(chroma = seq(10, 90, by = 10), p.cex = 0.3, rev.lum = TRUE, fixup=FALSE)
