### ----------- 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)