g12.1 <-
function(device=""){
    library(lattice)
    if(device!="") hardcopy(width=4.25, height=4.25,
                            device=device, trellis=T, color=T)
    library(DAAG); data(possum)
    colr <- c("red","blue")
    pchr <- c(3,4,0,8,2,10,1)
    ss <- expand.grid(site=1:7, sex=1:2)
    ss$sexsite <- paste(ss$sex, ss$site, sep="-")
    sexsite <- paste(possum$sex, possum$site, sep="-")
    print(splom(~ possum[, c(9:11)], panel = panel.superpose,
                groups = sexsite, col = colr[ss$sex], pch = pchr[ss$site],
                varnames=c("tail\nlength","foot\nlength",
                  "ear conch\nlength"),
                key = list(points = list(pch=pchr),
                  text=list(c("Cambarville","Bellbird","Whian Whian  ",
                    "Byrangery", "Conondale  ","Allyn River","Bulburin")),
                  columns=4, cex=.75, between=1,
                  between.columns=2), cex=.65, main=""))
    if(device!="")dev.off()
  }

g12.11 <-
function(device="",path = "~/r-book/ed2/Art/"){
    if(device!="") hardcopy(width=5.25, height=2.75, trellis=F,
                            color=TRUE, pointsize=8, device=device,
                            path=path)
    oldpar <- par(mar = c(4.1, 3.6, 2.6, 0.1), mgp = c(2.25, 0.5,        
         0), mfrow = c(1, 2), oma = c(0, 0.6, 0, 1.1), pty="s")       
    on.exit(par(oldpar))
    attach(golubInfo)
    ##  tissue.mfB.cv <- cvdisc(dsetB, cl=tissue.mfB, nf.use=1:27)
    ##  tissue.mfB.scores <-                                      
    ##      cvscores(cvlist = tissue.mfB.cv,                     
    ##               nfeatures = 3, ndisc = NULL, cl.other = NULL)
    scoreplot(scorelist = tissue.mfB.scores, cl.circle=NULL,
           prefix="A: B-cell subset -", xlab="Discriminant function 1",
           ylab="Discriminant function 2",
           adj.title=0)
    ##    BMonly.scores <-
    ##        cvscores(cvlist=BMonly.cv, nfeatures=11, cl.other=NULL)
    scoreplot(scorelist=BMonly.scores, cl.circle=tissue.mfB, 
           circle=tissue.mfB%in%c("BM:f","BM:m"),
           params=list(circle=list(cex=1.3, col=c("pink","cyan")),
             points=list(cex=0.65)), xlab="Discriminant function 1",
              ylab="",
           prefix="B: BM samples -", adj.title=0)
    detach(golubInfo)
    if(device!="")dev.off()
  }

g12.2 <-
function(device=""){
    library(lattice)
    library(DAAG)
    if(device!="") hardcopy(width=4.5, height=4.5,
                            device=device, trellis=T, color=T)
    pchr <- c(3,4,0,8,2,10,1)
    colr <- trellis.par.get()$superpose.symbol$col
    print(cloud(earconch~taill+footlgth, data=possum, groups=site,
                pch=pchr, cex=.65, 
                ## x=0.05, y=0.93, 
                key = list(columns=4,
                  cex=.9, between=1, points = list(pch=pchr, col=colr),
                  text=list(c("Cambarville","Bellbird","Whian Whian  ",
                    "Byrangery", "Conondale  ","Allyn River","Bulburin")),
                  between.columns=2)))
    if(device!="")dev.off()
  }

g12.3 <-
function(colr=trellis.settings$superpose.symbol$col[c(2,5)],
           device=""){
    if(device!="")hardcopy(width=3.25, height=3.25,
                           device=device)
    require(lattice)               
    here<-!is.na(possum$footlgth)  # We need to exclude missing values
    print(sum(!here))              # Check how many values are missing
    possum.prc <- princomp(possum[here,6:14])  # Principal components
    colr <- c("red", "blue")
    pchr <- c(3,4,0,8,2,10,1)
    ss <- expand.grid(site=1:7, sex=1:2)
    ss$sexsite <- paste(ss$sex, ss$site, sep="-")
    sexsite <- paste(possum$sex, possum$site, sep="-")[here]
    print(xyplot(possum.prc$scores[,2] ~ possum.prc$scores[,1],
                 panel = panel.superpose,
                 groups = sexsite, col = colr[ss$sex], pch = pchr[ss$site],
                 key = list(points = list(pch=pchr),
                   text=list(c("Cambarville","Bellbird","Whian Whian  ",
                     "Byrangery", "Conondale  ","Allyn River","Bulburin")),
                   columns=4, cex=.5, between=1, between.columns=2),
                 cex=0.65, xlab="1st Principal Component",
                 ylab="2nd Principal Component"
                 ))
    if(device!="")dev.off()
  }

g99.1 <-
function(device=""){
    if(device!="")hardcopy(device=device, pointsize=7,
                        width=3.75, height=3.75)
    oldpar <- par(mar = par()$mar + c(-1, 0.5, -2, -0.5))        
    on.exit(par(oldpar))
    plot(1:6, rep(4.5, 6), cex=1:6, col=1:6, pch=0:5,
         xlim=c(1, 6.5), ylim=c(0,5.4), xlab="", ylab="")
                                        # Use type="n" to suppress the plotting of points
    code1 <-
      "plot(1:6, rep(4.5, 6), cex=1:6, col=1:6, pch=0:5,"
    text(1, 5.25, code1, adj=0)
                                        # Vary cex (character expansion), col (color), & pch (plot character)
    code2 <- "xlim=c(1, 6.5), ylim=c(0,5.4), xlab=\"\", ylab=\"\")"    
    text(1+strwidth("plot("), 5, code2, adj=0)
    abc <- c("a", "b", "c", "d", "e", "f")
    text(1:6, rep(3, 6), labels=abc, cex=1:6, col=1:6)
                                        # Plot the characters 0:5, with corresponding cex=1:6 & color=1:6
    code3 <- "abc <- c(\"a\", \"b\", \"c\", \"d\", \"e\", \"f\")"
    code4 <- "text(1:6,rep(3.25, 6), labels=abc, cex=1:6, col=1:6)"
    text(1, 3.75, code3, adj=0)
    text(1, 3.5, code4, adj=0)
    ## Now show the plot characters 0 to 25, & put labels underneath
    plotchars <- 0:12
    points((1:13)*0.48, rep(1.5,13), pch=plotchars)
    text((1:13)*0.48, rep(1.5,13), paste(plotchars), pos=1, cex=0.75)
    code4.5 <- "plotchars <- 0:12"
    code5 <- "points((1:13)*0.48, rep(1.5,13), pch=plotchars)"
    code6 <-
      "text((1:13)*0.48, rep(1.75,13), paste(plotchars), pos=1, cex=0.75)"
    text(1, 2.25, code4.5, adj=0)
    text(1, 2.0, code5, adj=0)
    text(1, 1.75, code6, adj=0)
    plotchars <- 13:25
    points((1:13)*0.48, rep(0.25,13), pch=plotchars)
    text((1:13)*0.48, rep(0.25,13), paste(13:25), pos=1, cex=0.75)
    code7 <- "plotchars <- 13:25"
    code8 <- "## Now rerun the previous two lines of code"
    text(1, 0.75, code7, adj=0)
    text(1, 0.5, code8, adj=0)
    if(device!="")dev.off()
  }

g99.2 <-
function(device="", path="~/r-book/ed2/plateArt/")
{
  library(limma)
  if(device!="")hardcopy(width=5.8, height=7.6, path=path,
                         device=device, pointsize=c(9,5))
  xplot(data=sweep(nMA$M,2,c(-1,1,-1,1,-1,1),"*"),
        images=1:6, mfrow=c(3,2),
        legend = c("1", "1A (dyeswap of 1)", "2", 
          "2A (dyeswap of 2)", "3", "3A (dyeswap of 3)"),
        FUN=function(z,layout)imageplot(z,layout,legend=F, xlab="",
          low="yellow3", high="blue",
          mar=c(.3,.6,1.4,.50)))
  if(device!="")dev.off()
  invisible()
}

g99.3 <-
function(device="", las=1, zlim=c(0, 1), nlevels = 9,
           levels = pretty(zlim, nlevels), color.palette = rgb.palette,
           colpal=rev(rgb.palette(10)), path="~/r-book/ed2/plateArt/")
{
  library(dichromat)
  rgb.palette<-colorRampPalette(c("red","orange","blue"), space="rgb")  
  fac <- c(0, 0.33, 0.66, 1)
  if(device!="")hardcopy(width=4.5, height=2.4, device=device, path=path)
  if(!exists("frogs.glm"))frogs.glm <-
    glm(formula = pres.abs ~ log(distance) + log(NoOfPools) + meanmin + 
        meanmax, family = binomial, data = frogs)
  nlevels <- length(levels)
  mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar
  on.exit(par(par.orig))
  w <- (mar.orig[2]) * par("csi") * 2.54
  layout(matrix(c(2, 1), nc = 2), widths = c(1, lcm(w)))
  par(las = las, mgp=c(2.75, .75, 0))
  mar <- c(4.6, 0.5, 1.6, 1)
  par(mar = mar)
  plot.new()
  plot.window(xlim = c(0, 1), ylim = range(levels), xaxs = "i", 
              yaxs = "i")
  rect(0, levels[-length(levels)], 1, levels[-1], col = colpal)
  color.lab <- paste(levels[-nlevels], "-", levels[-1], sep="")
  text(0.5, 0.5*(levels[-1]+levels[-nlevels]), color.lab, cex=0.75)
  mar[2] <- 4.1
  mar[4] <- 0.5
  par(mar=mar)
  hat <- fitted(frogs.glm)
  plot(northing~easting, data=frogs, type="n",
       xlab="Meters east of reference point",ylab="Meters north")
  points(northing~easting, data=frogs, pch=15, 
         col=colpal[trunc(hat*nlevels)+1], cex=1.25)
  points(northing~easting, data=frogs, pch=c(1,3)[frogs$pres.abs+1],
         cex=0.65)
  if(device!="")dev.off()
  invisible()
}

g99.4 <-
function(df=nsw74psid1, device="",path="~/r-book/ed2/plateArt/"){
    if(device!="")hardcopy(width=4.5, height=4.5, trellis=TRUE, path=path,
                           device=device, pointsize=c(8,5), color=TRUE)
    dsetnam <- deparse(substitute(df))
    print(dsetnam)
    offset <- round(mean(sapply(nsw74psid1[,8:10],
                                function(x)unique(sort(x))[2])))
    cols <- c(rgb(0,0.5,0.5), rgb(0.65,0,0.65))
    trellis.par.set(superpose.symbol=list(cex=0.25),
                    superpose.line=list(lwd=2, col=cols))
    varlist <- c("educ","age","re74","re75","re78")
    dfn <- df[, varlist]
    dfn[,-(1:2)] <- log(dfn[,-(1:2)] + offset)
    lab <- c(varlist[1:2], paste("log\n", varlist[-(1:2)], "+",
                                 offset))
    trt <- factor(df$trt, labels=c("Control","Treatment"))
    print(splom(~dfn, type=c("p","smooth"), groups=trt, varnames=lab,
                auto.key=list(columns=2)))
                                        #    print(table(trt[here]))
    if(device!="")dev.off()
  }

g99.5 <-
function(device="",new=F, ycol = 50-(0:23)*2.1-rep(c(0, 0.5), c(8,16)),
           path="~/r-book/ed2/plateArt/"){
    if(device!="")hardcopy(width=5.8, height=6.8, device=device)
    else if(new)x11(width=6.0, height=9)
    yline <- 4.2
    ypmax <- ycol[1]-1.25
    farleft <- -7.0
    oldpar <- par(mar=c(0,0,0.5,0))     
    on.exit(par(oldpar))
    par(xpd=TRUE)
    library(RColorBrewer)
    plot(c(-7.5,31), c(0, ypmax), type="n", xlab="", ylab="", axes=F)
    plot.palette <- function(y, colr, txt=NULL, x=farleft-0.5, x0=1.75){
      if(is.null(txt)) txt <- deparse(substitute(colr))
      num <- length(colr)
      wid <- (31-x0)/num
      oset <- (0:(num-1))*wid+x0
      rect(oset,y-1.5,oset+wid,y, col=colr)
      text(x, y-0.8, txt, adj=0)
    }
    plot.palette(y=ycol[1], colr=palette(), "Default palette")
    ##    rect(oset8,ycol[1]-1.6,oset8+3.45,ycol[1], col=palette())
    ##    text(farleft-0.5, ycol[1]-0.8, "Default palette", adj=0)
    plot.palette(y=ycol[2], colr=heat.colors(12))    
    plot.palette(y=ycol[3], colr=terrain.colors(12))    
    plot.palette(y=ycol[4], colr=topo.colors(12))
    plot.palette(y=ycol[5], colr=rainbow(12))
    chh <- par()$cxy[2]
    text(farleft-0.5, ycol[6]-1.5,
         "Color schemes generated by hcl(h=seq(from=0, to=360, by=30), c, l)",
         adj=0)
    plot.palette(y=ycol[7]-0.25, colr=hcl(h=seq(from=0, to=360, by=30),
                                   c=55,l=75), txt= "c = 55, l = 75",
                 x=farleft+2.25)    
    plot.palette(y=ycol[8]-0.25, colr=hcl(h=seq(from=0, to=360, by=30),
                                   c=35,l=85), txt= "c = 35, l = 85",
                 x=farleft+2.25)        
    text(farleft-0.5, ycol[9]-1.75,
         expression(italic("RColorBrewer")*
             " package, "* 'e.g. brewer.pal(12, "Set3")'), adj=0)
    text(farleft+0.5, ycol[10]-1.25, "Qualitative scales", adj=0)
    plot.palette(y=ycol[11], colr=brewer.pal("Set3", n=12),
                 x=farleft+2.25, txt="Set3 (n=12)")
    plot.palette(y=ycol[12], colr=brewer.pal("Paired", n=12),
                 txt="Paired (n=12)", x=farleft+2.25)
    plot.palette(y=ycol[13], colr=brewer.pal("Spectral", n=11),
                 x=farleft+2.25, txt="Spectral (n=11)")
    plot.palette(y=ycol[14], colr=brewer.pal("Set1", n=9),
                 x=farleft+2.25, txt="Set1 (n=9)")
    plot.palette(y=ycol[15], colr=brewer.pal("Pastel1", n=9),
                 x=farleft+2.25, txt="Pastel1 (n=9)")
    plot.palette(y=ycol[16], colr=brewer.pal("Pastel2", n=8),
                 x=farleft+2.25, txt="Pastel2 (n=8)")
    plot.palette(y=ycol[17], colr=brewer.pal("Dark2",n=8), 
                 txt="Dark2 (n=8)", x=farleft+2.25)                 
    plot.palette(y=ycol[18], colr=brewer.pal("Accent",n=8),
                 txt="Accent (n=8)", x=farleft+2.25)
    text(farleft+0.5, ycol[19]-1.25, "Divided scales (examples only)", adj=0)
    plot.palette(y=ycol[20], colr=brewer.pal("RdGy", n=11),
                 x=farleft+2.25, txt="RdGy (n=11)")
    plot.palette(y=ycol[21], colr=brewer.pal("BrBG", n=11),
                 x=farleft+2.25, txt="BrBG (n=11)")
    
    text(farleft+0.5, ycol[22]-1.25, "Quantitative scales (examples only)",
         adj=0)
    plot.palette(y=ycol[23], colr=brewer.pal("PuBuGn", n=9),
                 x=farleft+2.25, txt="PuBuGn (n=9)")
    plot.palette(y=ycol[24], colr=brewer.pal("OrRd", n=9),
                 x=farleft+2.25, txt="OrRd (n=9)")
    if(device!="")dev.off()
  }

g99.6 <-
function(device="", new=F, ycol = 47.5-(0:19)*2.1,
           inc=c(3,5,10,12,13:14,18), path="~/r-book/ed2/plateArt/"){
    if(device!="")hardcopy(width=5.8, height=6.8, path=path,
                           device=device)
    else if(new)x11(width=6.0, height=9)
    eps <- numeric(length(ycol))
    eps[inc] <- 0.35
    ycol <- ycol-cumsum(eps)
    yline <- 4.2
    ypmax <- ycol[1]-1.75
    ypmin <- min(ycol)-1.25
    farleft <- -6
    oldpar <- par(mar=c(0,0,0.5,0))     
    on.exit(par(oldpar))
    par(xpd=TRUE)
    library(dichromat)
    plot(c(-7,31), c(ypmin, ypmax), type="n", xlab="", ylab="", axes=F)
    plot.palette <- function(y, colr, txt=NULL, x=farleft-0.5,
                             simulate=NULL, x0=3.5, dichrom=F, xtra=NULL){
      if(is.null(txt)){
        if(is.character(colr))txt <- colr else
        txt <- deparse(substitute(colr))
      }
      if(dichrom)colr <- colorschemes[[colr]]
      num <- length(colr)
      wid <- (31-x0)/num
      if(!is.null(xtra))wid <- (31-x0)/(num+1.25)
      oset <- (0:(num-1))*wid+x0
      if(!is.null(simulate)){
        colr <- dichromat(colr, simulate)
        addtxt <- switch(simulate, deutan="D", protan="P")
        txt <- paste(txt,": ",addtxt, sep="")
        if(!is.null(xtra)) xtra <- dichromat(xtra, simulate)
      }
      rect(oset,y-1.5,oset+wid,y, col=colr)
      if(!is.null(xtra))rect(31-wid, y-1.5, 31, y, col=xtra)
      text(x, y-0.8, txt, adj=0)
    }
    text(farleft-0.75, ycol[1]-1.0,
         expression("Selected schemes from the "*italic("dichromat")*
             " package, "* "e.g. colorshemes$GreentoMagenta.16"), adj=0)
    plot.palette(y=ycol[2], colr="GreentoMagenta.16", dichrom=TRUE,
                 x=farleft+0.25)
    plot.palette(y=ycol[3], colr="BluetoGreen.14", dichrom=TRUE,
                 x=farleft+0.25)
    plot.palette(y=ycol[4], colr="BluetoOrangeRed.14", dichrom=TRUE,
                 x=farleft+0.25)
    plot.palette(y=ycol[5], colr="DarkRedtoBlue.12", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[6], colr="BluetoOrange.12", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[7], colr="DarkRedtoBlue.12", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[8], colr="BluetoDarkOrange.12", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[9], colr="BrowntoBlue.12", dichrom=TRUE,
                 txt="BrowntoBlue.12", x=farleft+0.25)
    plot.palette(y=ycol[10], colr="BluetoGray.8", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[11], colr="BluetoOrange.8", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[12], colr="LightBluetoDarkBlue.7", dichrom=T,
                 x=farleft+0.25) 
    plot.palette(y=ycol[13], colr="SteppedSequential.5", dichrom=T,
                 x=farleft+0.25)
    text(farleft-0.75, ycol[14]-1.0,
         "Simulation of Effects of Two Common types of Red-Green Color Blindness",
         adj=0)
    plot.palette(y=ycol[15], colr=c(palette()), x=farleft+0.25, x0=4.65,
                 xtra="green", txt="Default palette + green")
    plot.palette(y=ycol[16], colr=c(palette()), x=farleft+0.25, x0=4.65,
                 xtra="green", txt="Default palette + green", simulate="deutan")
    plot.palette(y=ycol[17], colr=c(palette()), x=farleft+0.25, x0=4.65,
                 txt="Default palette + green", xtra="green", simulate="protan")

    plot.palette(y=ycol[18], colr="Categorical.12",  dichrom=T, x0=4.65,
                 txt=expression("Categorical.12 "*italic("(dichromat)")),
                 x=farleft+0.25)
    plot.palette(y=ycol[19], colr="Categorical.12",  dichrom=T, x0=4.65,
                 txt="Categorical.12", x=farleft+0.25, simulate="deutan")
    plot.palette(y=ycol[20], colr="Categorical.12", dichrom=T, x0=4.65,
                 txt="Categorical.12", x=farleft+0.25,
                 simulate="protan")    
    if(device!="")dev.off()
  }

g99.7 <-
function(device="", new=F, ycol = 47.5-(0:19)*2.1,
           inc=c(3,5,10,12,13:14,18), path="~/r-book/ed2/plateArt/"){
    if(device!="")hardcopy(width=5.8, height=6.8, path=path,
                           device=device)
    else if(new)x11(width=6.0, height=9)
    eps <- numeric(length(ycol))
    eps[inc] <- 0.35
    ycol <- ycol-cumsum(eps)
    yline <- 4.2
    ypmax <- ycol[1]-1.75
    ypmin <- min(ycol)-1.25
    farleft <- -6
    oldpar <- par(mar=c(0,0,0.5,0))     
    on.exit(par(oldpar))
    par(xpd=TRUE)
    library(dichromat)
    plot(c(-7,31), c(ypmin, ypmax), type="n", xlab="", ylab="", axes=F)
    plot.palette <- function(y, colr, txt=NULL, x=farleft-0.5,
                             simulate=NULL, x0=3.5, dichrom=F, xtra=NULL){
      if(is.null(txt)){
        if(is.character(colr))txt <- colr else
        txt <- deparse(substitute(colr))
      }
      if(dichrom)colr <- colorschemes[[colr]]
      num <- length(colr)
      wid <- (31-x0)/num
      if(!is.null(xtra))wid <- (31-x0)/(num+1.25)
      oset <- (0:(num-1))*wid+x0
      if(!is.null(simulate)){
        colr <- dichromat(colr, simulate)
        addtxt <- switch(simulate, deutan="D", protan="P")
        txt <- paste(txt,": ",addtxt, sep="")
        if(!is.null(xtra)) xtra <- dichromat(xtra, simulate)
      }
      rect(oset,y-1.5,oset+wid,y, col=colr)
      if(!is.null(xtra))rect(31-wid, y-1.5, 31, y, col=xtra)
      text(x, y-0.8, txt, adj=0)
    }
    text(farleft-0.75, ycol[1]-1.0,
         expression("Selected schemes from the "*italic("dichromat")*
             " package, "* "e.g. colorshemes$GreentoMagenta.16"), adj=0)
    plot.palette(y=ycol[2], colr="GreentoMagenta.16", dichrom=TRUE,
                 x=farleft+0.25)
    plot.palette(y=ycol[3], colr="BluetoGreen.14", dichrom=TRUE,
                 x=farleft+0.25)
    plot.palette(y=ycol[4], colr="BluetoOrangeRed.14", dichrom=TRUE,
                 x=farleft+0.25)
    plot.palette(y=ycol[5], colr="DarkRedtoBlue.12", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[6], colr="BluetoOrange.12", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[7], colr="DarkRedtoBlue.12", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[8], colr="BluetoDarkOrange.12", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[9], colr="BrowntoBlue.12", dichrom=TRUE,
                 txt="BrowntoBlue.12", x=farleft+0.25)
    plot.palette(y=ycol[10], colr="BluetoGray.8", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[11], colr="BluetoOrange.8", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[12], colr="LightBluetoDarkBlue.7", dichrom=T,
                 x=farleft+0.25) 
    plot.palette(y=ycol[13], colr="SteppedSequential.5", dichrom=T,
                 x=farleft+0.25)
    text(farleft-0.75, ycol[14]-1.0,
         "Simulation of Effects of Two Common types of Red-Green Color Blindness",
         adj=0)
    plot.palette(y=ycol[15], colr=c(palette()), x=farleft+0.25, x0=4.65,
                 xtra="green", txt="Default palette + green")
    plot.palette(y=ycol[16], colr=c(palette()), x=farleft+0.25, x0=4.65,
                 xtra="green", txt="Default palette + green", simulate="deutan")
    plot.palette(y=ycol[17], colr=c(palette()), x=farleft+0.25, x0=4.65,
                 txt="Default palette + green", xtra="green", simulate="protan")

    plot.palette(y=ycol[18], colr="Categorical.12",  dichrom=T, x0=4.65,
                 txt=expression("Categorical.12 "*italic("(dichromat)")),
                 x=farleft+0.25)
    plot.palette(y=ycol[19], colr="Categorical.12",  dichrom=T, x0=4.65,
                 txt="Categorical.12", x=farleft+0.25, simulate="deutan")
    plot.palette(y=ycol[20], colr="Categorical.12", dichrom=T, x0=4.65,
                 txt="Categorical.12", x=farleft+0.25,
                 simulate="protan")    
    if(device!="")dev.off()
  }

g99.8 <-
function(device="", new=F, ycol = 47.5-(0:19)*2.1,
           inc=c(3,5,10,12,13:14,18), path="~/r-book/ed2/plateArt/"){
    if(device!="")hardcopy(width=5.8, height=6.8, path=path,
                           device=device)
    else if(new)x11(width=6.0, height=9)
    eps <- numeric(length(ycol))
    eps[inc] <- 0.35
    ycol <- ycol-cumsum(eps)
    yline <- 4.2
    ypmax <- ycol[1]-1.75
    ypmin <- min(ycol)-1.25
    farleft <- -6
    oldpar <- par(mar=c(0,0,0.5,0))     
    on.exit(par(oldpar))
    par(xpd=TRUE)
    library(dichromat)
    plot(c(-7,31), c(ypmin, ypmax), type="n", xlab="", ylab="", axes=F)
    plot.palette <- function(y, colr, txt=NULL, x=farleft-0.5,
                             simulate=NULL, x0=3.5, dichrom=F, xtra=NULL){
      if(is.null(txt)){
        if(is.character(colr))txt <- colr else
        txt <- deparse(substitute(colr))
      }
      if(dichrom)colr <- colorschemes[[colr]]
      num <- length(colr)
      wid <- (31-x0)/num
      if(!is.null(xtra))wid <- (31-x0)/(num+1.25)
      oset <- (0:(num-1))*wid+x0
      if(!is.null(simulate)){
        colr <- dichromat(colr, simulate)
        addtxt <- switch(simulate, deutan="D", protan="P")
        txt <- paste(txt,": ",addtxt, sep="")
        if(!is.null(xtra)) xtra <- dichromat(xtra, simulate)
      }
      rect(oset,y-1.5,oset+wid,y, col=colr)
      if(!is.null(xtra))rect(31-wid, y-1.5, 31, y, col=xtra)
      text(x, y-0.8, txt, adj=0)
    }
    text(farleft-0.75, ycol[1]-1.0,
         expression("Selected schemes from the "*italic("dichromat")*
             " package, "* "e.g. colorshemes$GreentoMagenta.16"), adj=0)
    plot.palette(y=ycol[2], colr="GreentoMagenta.16", dichrom=TRUE,
                 x=farleft+0.25)
    plot.palette(y=ycol[3], colr="BluetoGreen.14", dichrom=TRUE,
                 x=farleft+0.25)
    plot.palette(y=ycol[4], colr="BluetoOrangeRed.14", dichrom=TRUE,
                 x=farleft+0.25)
    plot.palette(y=ycol[5], colr="DarkRedtoBlue.12", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[6], colr="BluetoOrange.12", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[7], colr="DarkRedtoBlue.12", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[8], colr="BluetoDarkOrange.12", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[9], colr="BrowntoBlue.12", dichrom=TRUE,
                 txt="BrowntoBlue.12", x=farleft+0.25)
    plot.palette(y=ycol[10], colr="BluetoGray.8", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[11], colr="BluetoOrange.8", dichrom=T,
                 x=farleft+0.25)
    plot.palette(y=ycol[12], colr="LightBluetoDarkBlue.7", dichrom=T,
                 x=farleft+0.25) 
    plot.palette(y=ycol[13], colr="SteppedSequential.5", dichrom=T,
                 x=farleft+0.25)
    text(farleft-0.75, ycol[14]-1.0,
         "Simulation of Effects of Two Common types of Red-Green Color Blindness",
         adj=0)
    plot.palette(y=ycol[15], colr=c(palette()), x=farleft+0.25, x0=4.65,
                 xtra="green", txt="Default palette + green")
    plot.palette(y=ycol[16], colr=c(palette()), x=farleft+0.25, x0=4.65,
                 xtra="green", txt="Default palette + green", simulate="deutan")
    plot.palette(y=ycol[17], colr=c(palette()), x=farleft+0.25, x0=4.65,
                 txt="Default palette + green", xtra="green", simulate="protan")

    plot.palette(y=ycol[18], colr="Categorical.12",  dichrom=T, x0=4.65,
                 txt=expression("Categorical.12 "*italic("(dichromat)")),
                 x=farleft+0.25)
    plot.palette(y=ycol[19], colr="Categorical.12",  dichrom=T, x0=4.65,
                 txt="Categorical.12", x=farleft+0.25, simulate="deutan")
    plot.palette(y=ycol[20], colr="Categorical.12", dichrom=T, x0=4.65,
                 txt="Categorical.12", x=farleft+0.25,
                 simulate="protan")    
    if(device!="")dev.off()
  }

gdump <-
function(fnam=NULL, prefix="~/r-book/ed2/figures/figs",
           splitchar="/ch"){
    if(is.null(fnam)){
      path <- getwd()
      pathtag <- strsplit(path, "/ch", fixed=TRUE)[[1]]
      fnam <- paste(prefix, pathtag[length(pathtag)],
                    ".R", sep="")
    }
    else fnam <- paste(prefix, fnam, sep="/")
    objnames <- c(objects(pattern="^g", envir=sys.frame(0)), "hardcopy")
    cat("\nDump to file:", fnam, "\n")
    print(objnames)
    dump(objnames, fnam)
  }

genelist <-
structure(c("M58459_at", "U91327_at", "X54870_at", "M58459_at", 
"X54870_at", "U91327_at", "M58459_at", "U91327_at", "X54870_at", 
"M58459_at", "L08666_at", "U91327_at", "M58459_at", "X00437_s_at", 
"X62654_rna1_at", "U29195_at", "U49395_at", "X82494_at", "S74221_at", 
"M58459_at", "U91327_at", "M58459_at", "X54870_at", "U91327_at", 
"M58459_at", "X54870_at", "X62654_rna1_at", "M58459_at", "X54870_at", 
"X53416_at", "M58459_at", "U91327_at", "X54870_at", "M58459_at", 
"U91327_at", "X54870_at", "M58459_at", "X00437_s_at", "X62654_rna1_at", 
"U29195_at", "U49395_at", "X82494_at", "M58459_at", "X54870_at", 
"X53416_at", "M58459_at", "L08666_at", "U91327_at", "S74221_at", 
"M58459_at", "U91327_at", "M58459_at", "X54870_at", "X62654_rna1_at", 
"M58459_at", "X54870_at", "U91327_at", "M58459_at", "X54870_at", 
"U91327_at", "S74221_at", "M58459_at", "U91327_at", "U29195_at", 
"U49395_at", "X82494_at", "M58459_at", "L08666_at", "U91327_at", 
"M58459_at", "U91327_at", "X54870_at", "M58459_at", "X54870_at", 
"U91327_at", "M58459_at", "X54870_at", "X62654_rna1_at", "M58459_at", 
"X54870_at", "X53416_at", "M58459_at", "U91327_at", "X54870_at", 
"M58459_at", "X54870_at", "U91327_at", "M58459_at", "X00437_s_at", 
"X62654_rna1_at", "M58459_at", "U91327_at", "X54870_at", "U29195_at", 
"U49395_at", "X82494_at", "M58459_at", "X54870_at", "U91327_at", 
"M58459_at", "L08666_at", "U91327_at", "M58459_at", "U91327_at", 
"X54870_at", "M58459_at", "X54870_at", "U91327_at", "M58459_at", 
"X54870_at", "X62654_rna1_at", "S74221_at", "M58459_at", "U91327_at", 
"M58459_at", "X54870_at", "X53416_at", "M58459_at", "X00437_s_at", 
"X62654_rna1_at"), .Dim = c(3L, 40L))
gfile <-
function(width=3.75, height=3.75, color=F, trellis=F,
           device=c("","pdf","ps"), path="", pointsize=c(8,5), horiz=F){
    ## 1 x 1: 2.25" x 2.25"
    ## 2 x 2: 2.75" x 2.75"
    ## 3 x 3: 3.75" x 3.75" or 3.25" x 3.25" for simple scatterplots
    ## 1 x 2: 4" x 2.25"
    ## 2 x 3: 4" x 2.8"
    ## 3 x 4: 4.5" x 3.25
    if(!trellis)pointsize <- pointsize[1]
    funtxt <- sys.call(1)
    fnam <- strsplit(as.character(funtxt), "(", fixed=T)[[1]][1]
    dotsplit <- strsplit(fnam, "\\.")[[1]]
    dotsplit[1] <- substring(dotsplit[1], 2)
    prefix1 <- paste(if(nchar(dotsplit[1])==1)"0" else "", dotsplit[1],
                     sep="")
    prefix2 <- paste(if(nchar(dotsplit[2])==1)"0" else "", dotsplit[2],
                     sep="")
    if(device=="")stop("No device has been specified")
    suffix <- switch(device, ps=".eps", pdf=".pdf")
    fnam <- paste("~/r-book/second/Art/",prefix1,"-",prefix2,
                  suffix, sep="")
    print(fnam)
    dev.out <- device[1]
    dev.fun <- switch(dev.out, pdf=pdf, ps=postscript)
    if(trellis){
      library(lattice)
      trellis.device(file=fnam, device=dev.fun, color = color,
                     width=width, height=height, horiz=horiz)
      trellis.par.set(fontsize=list(text=pointsize[1], points=pointsize[2]))
    }
    else 
      if (dev.out!=""){
        print(c(width, height))
        dev.fun(file=fnam, paper="special",
                enc="MacRoman", horiz=horiz,
                width=width, height=height, pointsize=pointsize[1])
      }
  }

gsave <-
function(fnam=NULL, prefix="~/r-book/ed2/figures/figs",
           splitchar="/ch", xtras=c("renum.fun","renum.files","hardcopy")){
    if(is.null(fnam)){
      path <- getwd()
      pathtag <- strsplit(path, "/ch", fixed=TRUE)[[1]]
      fnam <- paste(prefix, pathtag[length(pathtag)],
                    ".RData", sep="")
    }
    else fnam <- paste(prefix, fnam, sep="/")
    objnames <- c(objects(pattern="^g", envir=sys.frame(0)), xtras)
    cat("\nDump to file:", fnam, "\n")
    print(objnames)
    save(list=objnames, file=fnam)
  }

hardcopy <-
function(width=3.75, height=3.75, color=FALSE, trellis=FALSE,
           device=c("","pdf","ps"), path="~/r-book/ed2/Art/", file=NULL,
           format=c("nn-nn", "name"), split="\\.", pointsize=c(8,4),
           fonts=NULL,
           horiz=FALSE, ...){
    if(!trellis)pointsize <- pointsize[1]
    funtxt <- sys.call(1)
    nam <- strsplit(as.character(funtxt), "(", fixed=TRUE)[[1]][1]
    suffix <- switch(device, ps=".eps", pdf=".pdf")
    if(is.character(path) & nchar(path)>1 & substring(path, nchar(path))!="/")
      path <- paste(path, "/", sep="")
    if(is.null(file)) if(format[1]=="nn-nn"){
      if(!is.null(split))dotsplit <- strsplit(nam, split)[[1]] else
      dotsplit <- nam
      if(length(dotsplit)==1)dotsplit <- c("", dotsplit)
      nn2 <- paste(if(nchar(dotsplit[2])==1)"0" else "", dotsplit[2],
                   sep="")
      if(nchar(dotsplit[1])>0){
        numstart <- which(unlist(strsplit(dotsplit[1], "")) %in% paste(0:9))[1]
        nn1 <- substring(dotsplit[1], numstart)
        nn1 <- paste(if(nchar(nn1) == 1) "0" else "", nn1, "-", sep="")
      } else nn1 <- ""
      file <- paste(nn1, nn2, sep="")
    } else file <- nam
    if(nchar(file)>4 & substring(file, nchar(file)-nchar(suffix)+1)==suffix)
      suffix <- ""
    file <- paste(path, file, suffix, sep="")
    print(paste("Output will be directed to file:", file))
    dev.out <- device[1]
    dev.fun <- switch(dev.out, pdf=pdf, ps=postscript)
    if(trellis){
      library(lattice)
      if(device=="ps")
        trellis.device(file=file, device=dev.fun,
                       color = color, horiz=horiz, fonts=fonts,
                       width=width, height=height, ...) else
      trellis.device(file=file, device=dev.fun, fonts=fonts,
                     color = color, width=width, height=height, ...)

      trellis.par.set(list(fontsize=list(text=pointsize[1], points=pointsize[2])))
    } else
    if (dev.out!=""){
      print(c(width, height))
      if(device=="ps")
        dev.fun(file=file, paper="special",  horiz=horiz, fonts=fonts,
                width=width, height=height, pointsize=pointsize[1], ...) else
      dev.fun(file=file, paper="special", fonts=fonts,
              width=width, height=height, pointsize=pointsize[1], ...)      
    }
    if(trellis)trellis.par.set(list(fontsize=list(text=pointsize[1],
                                      points=pointsize[2])))
  }