[R] color palette for points, lines, text / interactive Rcolorpicker?

[Michael Friendly]

Below is a 'pretty-poor' version of a color picker I wrote using the 
code on the color chart page I cited.  It's slightly 'pretty' in terms 
of layout, but 'poor' in terms of usability and flexibility.  Still,
it is more useful to me than the nearly-null set of alternatives
I have found in R. Maybe someone else can do better.
[Some lines below have been broken by my mail client.]

# Using code from http://research.stowers-institute.org/efg/R/Color/Chart/

colorpicker <- function(n, order=c("index", "hue"), cols=colors(), 
value=c("name", "index")) {
##  n:  max number of colors to pick (default: as many are selected in 
identify)
##  order: how to order the colors in cols
##  cols: vector of colors
##  value: return color names or indices in cols?


   SetTextContrastColor <- function(color)
   {
     ifelse( mean(col2rgb(color)) > 127, "black", "white")
   }

   # Define this array of text contrast colors that corresponds to each
   # member of the colors() array.
   TextContrastColor <- unlist( lapply(cols, SetTextContrastColor) )

	ncolors <- length(cols)
	if (missing(n)) n <- ncolors

	# store coordinates of centers
	x <- vector("integer", length=0)
	y <- vector("integer", length=0)
	ind <- vector("integer", length=0)
	
	nr <- ceiling(sqrt(ncolors))
	nc <- ceiling( ncolors/nr )

	order <- match.arg(order)
	value <- match.arg(value)
	
	if (order=="index") {
     # 1a. Plot matrix of R colors, in index order, nc per row.
     # This example plots each row of rectangles one at a time.

     plot( c(1,nc), c(0,nr), type="n", ylab="", xlab="",
       axes=FALSE, ylim=c(nr,0))
     title("R colors (index order): LT click to select; RT click to end")

     for (j in 0:(nr-1))
     {
       base <- j*nc
       remaining <- length(cols) - base
       RowSize <- ifelse(remaining < nc, remaining, nc)
       x <- c(x, 1:RowSize)
       y <- c(y, rep(j, RowSize))
       ind <- c(ind, base + (1:RowSize))
       rect((1:RowSize)-0.5,j-0.5, (1:RowSize)+0.5,j+0.5,
         border="black",
         col=cols[base + (1:RowSize)])
       text((1:RowSize), j, paste(base + (1:RowSize)), cex=0.7,
         col=TextContrastColor[base + (1:RowSize)])
     }
   }
   else  ## if (order=="hue")
   {

     # 1b. Plot matrix of R colors, in "hue" order, nc per row.
     # This example plots each rectangle one at a time.
     RGBColors <- col2rgb(cols[1:length(cols)])
     HSVColors <- rgb2hsv( RGBColors[1,], RGBColors[2,], RGBColors[3,],
                  maxColorValue=255)
     HueOrder <- order( HSVColors[1,], HSVColors[2,], HSVColors[3,] )

     plot(0, type="n", ylab="", xlab="",
       axes=FALSE, ylim=c(nr,0), xlim=c(1,nc))
     title("R colors (HSV order): LT click to select; RT click to end")

     for (j in 0:(nr-1))
     {
       for (i in 1:nc)
       {
        k <- j*nc + i
        if (k <= length(cols))
        {
				x <- c(x, i)
				y <- c(y, j)
				ind <- c(ind, HueOrder[k] )
         rect(i-0.5,j-0.5, i+0.5,j+0.5, border="black", col=cols[ 
HueOrder[k] ])
         text(i,j, paste(HueOrder[k]), cex=0.7, col=TextContrastColor[ 
HueOrder[k] ])
        }
       }
     }
   }

   ## use identify to select n colors
	result <- identify(x, y, ind, n=n, offset=-1, pos=FALSE)
	result <- if (value=="index") result else cols[result]
	result
}

Greg Snow wrote:
> I don't know of any existing palettes that meet your conditions, but here are a couple of options for interactive exploration of colorsets (this is quick and dirty, there are probably some better orderings, base colors, etc.):
> 
> colpicker <- function( cols=colors() ) {
> 	n <- length(cols)
> 	nr <- ceiling(sqrt(n))
> 	nc <- ceiling( n/nr )
> 
> 	imat <- matrix(c(seq_along(cols), rep(NA, nr*nc-n) ),
> 				ncol=nc, nrow=nr)
> 
> 	image( seq.int(nr),seq.int(nc), imat, col=cols, xlab='', ylab='' )
> 	xy <- locator()
> 
> 	cols[ imat[ cbind( round(xy$x), round(xy$y) ) ] ]
> }
> 
> colpicker()
> 
> 
> ## another approach
> 
> library(TeachingDemos)
> 
> cols <- colors()
> n <- length(cols)
> par(xpd=TRUE)
> 
> # next line only works on windows
> HWidentify( (1:n) %% 26, (1:n) %/% 26, label=cols, col=cols, pch=15, cex=2 )
> 
> # next line works on all platforms with tcltk
> HTKidentify( (1:n) %% 26, (1:n) %/% 26, label=cols, col=cols, pch=15, cex=2 )
> 
> 
> # reorder
> cols.rgb <- col2rgb( cols )
> d <- dist(t(cols.rgb))
> clst <- hclust(d)
> 
> colpicker(cols[clst$order])
> HWidentify( (1:n) %% 26, (1:n) %/% 26, label=cols[clst$order], col=cols[clst$order], pch=15, cex=2 )
> ## or HTKidentify
> 
> cols.hsv <- rgb2hsv( cols.rgb )
> d2 <- dist(t(cols.hsv))
> clst2 <- hclust(d2)
> 
> HWidentify( (1:n) %% 26, (1:n) %/% 26, label=cols[clst2$order], col=cols[clst2$order], pch=15, cex=2 )
> ## or HTKidentify
> 
> Hope this helps,
> 	
> 


-- 
Michael Friendly     Email: friendly AT yorku DOT ca
Professor, Psychology Dept.
York University      Voice: 416 736-5115 x66249 Fax: 416 736-5814
4700 Keele Street    http://www.math.yorku.ca/SCS/friendly.html
Toronto, ONT  M3J 1P3 CANADA