R/show-trellis-colors-function.R

In claus-e-andersen/clanLattice: R functions for lattice plotting

#' @title Show available colors in Lattice graphs
#' @description Show the various colors
#' @usage
#' show.trellis.colors(one.panel=TRUE)
#' @name show.trellis.colors
#' @author Claus E. Andersen
#' @return plt A Lattice plot showing the colors
#' @param one.panel indicated if everything should be in one single panel. This will give a lot
#' of overlap among points, but could still be useful.
#' @export show.trellis.colors
show.trellis.colors <- function(one.panel=FALSE){
  # Task   : Show the various colors and symbols in Trellis based on color names
  # Library: clan
  # Created: September 18, 2011
  # Revised: September 18, 2011
  # Name   : Claus E. Andersen
  # Sample call:
  #   pdf("show-trellis-colors.pdf",onefile=T,paper="a4r",width=0,height=0)
  #   palette("default")
  #   show.trellis.symbols(palette(),"default palette")
  #   show.trellis.colors(one.panel=TRUE)
  #   show.trellis.colors(one.panel=FALSE)
  #   dev.off()
  cc <- colors()
  
  N.xx <- 12
  N.yy <- 55  
  N.panel <- 120
  
  if(one.panel) {
    N.xx <- 18
    N.yy <- 37  
    N.panel <- N.xx * 37
  }
  
  xx <- rep(1:N.xx,N.yy)
  yy <- rep(1:N.yy,each=N.xx)
  zz <- rep(1:1000,each=N.panel)
  zz <- zz[1:length(xx)]
  N.col <- N.xx * N.yy
  col.xy <- 1:N.col
  
  df <- data.frame(xx=xx,yy=yy,zz=zz,col.xy=col.xy,col.name=cc[col.xy])
  df <- df[1:length(cc),]
  
  if(one.panel) {
    plt <- xyplot(yy ~ xx,
                  layout=c(1,1),
                  main=list("R-colors generated by show.trellis.colors(). See also P. Murrell: R graphics,  p. 54 and colors()",cex=0.8),
                  scales=list(x=list(at=NULL),y=list(relation="sliced",at=NULL)),
                  xlab = "", 
                  ylab = "", 
                  panel = function(x, y, subscripts, ...){
                    panel.xyplot(x,y,pch=16,cex=4,col=cc[col.xy[subscripts]])
                    ltext(x,y-0.5,cc[col.xy[subscripts]],cex=.5,srt=0,adj=0.5)
                    ltext(x,y,col.xy[subscripts],cex=.5,srt=0,adj=0.5)
                  },
                  data=df)
  } else { 
    plt <- xyplot(yy ~ xx | paste('Panel no.',zz),
                  layout=c(1,1),
                  main=list("R-colors generated by show.trellis.colors(). See also P. Murrell: R graphics,  p. 54 and colors()",cex=0.8),
                  scales=list(x=list(at=NULL),y=list(relation="sliced",at=NULL)),
                  xlab = "", 
                  ylab = "", 
                  panel = function(x, y, subscripts, ...){
                    panel.xyplot(x,y,pch=16,cex=4,col=cc[col.xy[subscripts]])
                    ltext(x,y-0.4,cc[col.xy[subscripts]],cex=.5,srt=0,adj=0.5)
                    ltext(x,y,col.xy[subscripts],cex=.5,srt=0,adj=0.5)
                  },
                  data=df)
  }
  return(plt)              
} # function