gcol1 <-
function(device=""){
    if(device!="")hardcopy(device=device, pointsize=10,
                           width=6, height=7.25, family="Times",
                           fonts=c("Courier","Times"))
    oldpar <- par(mar = c(0,0,2.75,0), oma=c(0,0.5,0,0.5), xaxs="i",
                  xaxt="n", yaxt="n", ann=FALSE, cex.main=1.15)
    on.exit(par(oldpar))
    ##
    code10 <- "par(fig=c(0, 1, 0.425, 1))"
    code11 <- "A: Plot symbols and text; specify colors and/or character expansion"
    code1 <- c('plot(0, 0, xlim=c(0, 13.25), ylim=c(0, 19), type="n");',
               "xpos <- rep((0:12)+0.5, 2);  ypos <- rep(c(14.5,12.75), c(13,13));",
               "points(xpos, ypos, cex=2.5, col=1:26, pch=0:25);",
               "text(xpos, ypos, labels=paste(0:25), cex=0.75);")
    makefig <- function(tx10=code10, tx11=code11, tx1=code1){
      comm <- regexpr("#", code1, fixed=TRUE)==1
      eval(parse(text=paste(c(tx10, ";", tx1[!comm]), collapse=" ")))
      box(col="gray")
      par(family="Courier")
      mtext(side=3, line=0.3, tx10, adj=0.015)
      par(family="Times")
      title(main=tx11, adj=0, line=1.5, cex=1.25)
      par(family="Courier")
      ht <- par()$cxy[2]*1.025
      y0 <- par()$usr[4]
      for(i in 1:length(tx1))text(0.15, y0-(i-0.25)*ht,
                                  substring(tx1[i], 1, nchar(tx1[i])-1), adj=0)
    }
    makefig()
    code21 <- "## Plot characters, vary cex (expansion)"
    ht <- par()$cxy[2]*1.025
    text(0.15, 11.5*ht, code21, adj=0)
    code22 <- 'text((0:4)+0.5, rep(9*ht, 5), letters[1:5], cex=c(2.5,2,1,1.5,2))'
    text(0.15, 10.5*ht, code22, adj=0)
    eval(parse(text=code22))
    code23 <- "## Position label with respect to point"
    text(0.15, 6.9*ht, code23, adj=0)
    code24 <- c('xoff <- c(0, -0.5, 0, 0.5)', 
                'yoff <- c(-1,0,1,0)',
                'col4 <- colors()[c(52, 116, 547, 610)]',
                'points(10.6+xoff, 6+yoff, pch=16, cex=1.5, col=col4)',
                'posText <- c("below (pos=1)", "left (2)", "above (3)", "right (4)")',
                'text(10.6+xoff, 6+yoff, posText, pos=1:4)',
                'rect(8.2, 3.8, 13.1, 8.2, border="red")')
    eval(parse(text=code22))
    eval(parse(text=paste(code24, collapse="; ")))
    len <- length(code24)
    for(i in 1:len)text(0.15,(len-0.1-i)*ht, code24[i], adj=0) 

    code10 <- "par(fig=c(0, 1, 0.01, 0.41), new=TRUE)"
    code11 <- 'B: Rectangles, polygons, circles, and mathematical text'
    code1 <- c('plot(0, 0, xlim=c(0, 13.25), ylim=c(0, 12), type="n");', 
               'xleft <- 10.4; xright <- 13.15;', 
               'ylo <- 0; yhi <- 12;', 
               'rect(xleft, ylo, xright, yhi, border="red");', 
               'polygon(x=c(10.5,13,12), y=c(7,8,11.5), col="gray");',
               ' ',
               '## Draw a circle, overlay 2-headed arrow (code=3) ',
               'symbols(11.8, 3.5, circles=1.2, bg="gray", add=TRUE, ',
               '        inches=FALSE);',
               'arrows(11.8, 3.5, 10.6, 3.5, length=.05, code=3);',
               ' ',
               '## Use expressions to add labeling information ',
               'text(11.2, 3.5-strheight("R"), expression(italic(r)));',
               'text(11.8, 5, expression("Area" == pi*italic(r)^2));')
    makefig()
    if(device!="")dev.off()
  }

gcol2 <-
function(device="", pointsize=c(8,4)){
    if(!require(DAAG))return("Package 'DAAG' is not installed -- cannot proceed")   
    if(device!="")hardcopy(width=5.5, height=3.25,
                           pointsize=pointsize,
                           device=device, trellis=T, color=T)
    par(fig=c(0, 0.525, 0, 1))
    plot.new()
    mtext(side=3, line=2.5, "A", adj=-0.225, cex=0.75)
    par(fig=c(0.455, 1, 0, 1), new=TRUE)
    mtext(side=3, line=2.5, "B", adj=-0.225, cex=0.75)
    colr <- c("gray40","black")
    plotchar <- c(1, 16)
    targplot <- xyplot(csoa ~ it|sex*agegp, data=tinting, groups=target,
                       col=colr, pch=plotchar, aspect=0.8,
                       key=list(space="top", columns=2,
                         points=list(pch=plotchar, col=colr),
                         text=list(levels(tinting$target))),
                       scale=list(y=list(alternating=1)))
    print(targplot, position=c(0, 0, 0.525, 1), newpage=FALSE)
    colr <- c("skyblue1", "skyblue4")[c(2,1,2)]
    plotchar <- c(1,16,16)  # open, filled, filled
    u <- xyplot(csoa~it|sex*agegp, data=tinting, groups=tint, 
                col=colr, pch=plotchar, aspect=0.8,
                type=c("p","smooth"), span=1.25,
                key=list(space="top", columns=3,
                  points=list(pch=c(1,16,16), col=colr),
                  text=list(levels(tinting$tint), col=colr)),
                scale=list(y=list(alternating=2)), ylab="")
    print(u, position=c(0.475, 0, 1, 1), newpage=FALSE)
    if(device!="")dev.off()
  }

gcol3 <-
function(device="", path="~/dbeta/Art/")
{
  if(!require(limma))return("Package 'limma' is not installed -- cannot proceed")
  if(!require(DAAGbio))return("Package 'DAAGbio' is not installed -- cannot proceed")
  MA <- normalizeWithinArrays(coralRG, method = "printtiploess")
  nMA <- normalizeBetweenArrays(MA)
  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),
        paneltitles = 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="",
          mar=c(.3,.6,1.4,.50)))
  if(device!="")dev.off()
  invisible()
}

gcol4 <-
function(device="", las=1, zlim=c(0, 1), nlevels = 9,
           levels = pretty(zlim, nlevels), color.palette = rgb.palette,
           colpal=rev(rgb.palette(10)), path="~/dbeta/Art/")
{
  if(!require(dichromat))return("Package 'dichromat' is not installed -- cannot proceed")   
  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", asp=1,
       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()
}

gcol5 <-
function(device=""){
    if(!require(lattice))return("Package 'lattice' is not installed -- cannot proceed")   
    if(device!="") hardcopy(width=4.25, height=4.25,
                            device=device, trellis=T, color=T)
    if(!require(DAAG))return("Package 'DAAG' is not installed -- cannot proceed")   
    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()
  }

gcol6 <-
function(device=""){
    if(!require(lattice))return("Package 'lattice' is not installed -- cannot proceed")   
    if(!require(DAAG))return("Package 'DAAG' is not installed -- cannot proceed")       
    if(device!="") hardcopy(width=4.5, height=9,
                            device=device, trellis=T, color=T)
    pchr <- c(3,4,0,8,2,10,1)
    cloudgph <- cloud(earconch~taill+footlgth, data=possum, groups=site,
                par.settings=simpleTheme(pch=pchr, cex=0.7),
                zoom=0.925, zlab=list("earconch", rot=90),                      
                auto.key = list(text=c("Cambarville","Bellbird","Whian Whian  ",
                    "Byrangery", "Conondale  ","Allyn River","Bulburin"),
                                columns=4, between=1, points=TRUE, 
                                between.columns=2))
    plot(cloudgph)
    if(device!="")dev.off()
  }

gcol7 <-
function(colr=trellis.settings$superpose.symbol$col[c(2,5)],
           device=""){
    if(device!="")hardcopy(width=3.25, height=3.25,
                           device=device)
    if(!require(lattice))return("Package 'lattice' is not installed -- cannot proceed")              
    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], aspect="iso",
                 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()
  }

gcol8 <-
function(device=""){
    if(device!="") hardcopy(width=6.25, height=3.5, trellis=F,
                            color=TRUE, pointsize=8, device=device)
    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))
    if(!require(hddplot))return("Package 'hddplot' is not installed -- cannot proceed")       
    attach(golubInfo)
    ## Identify allB samples for that are BM:f or BM:m or PB:m
subsetB <- cancer=="allB" & tissue.mf%in%c("BM:f","BM:m","PB:m")
## Form vector that identifies these as BM:f or BM:m or PB:m
tissue.mfB <- tissue.mf[subsetB, drop=TRUE]
## Separate off the relevant columns of the matrix Golub
data(Golub)
GolubB <- Golub[, subsetB]
      tissue.mfB.cv <- cvdisc(GolubB, cl=tissue.mfB, nfeatures=1:23)
      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)
     Golub.BM <- with(golubInfo, Golub[, BM.PB=="BM"]) 
     cancer.BM <- with(golubInfo, cancer[BM.PB=="BM"])
     BMonly.cv <- cvdisc(Golub.BM, cl=cancer.BM, nfeatures=1:23, 
                         nfold=c(10,4)) 
    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()
  }

gcol9 <-
function(device=""){
    load('cps3.RData')
    if(device!="")hardcopy(width=6, height=4.5, trellis=TRUE, color=TRUE,
                           device=device, pointsize=c(6,3))
    if(!require(grid))return("Package 'grid' is not installed -- cannot proceed")        
    dsetnames <- c("nsw-ctl", "nsw-trt", "psid1", "psid2", "psid3",
                   "cps1", "cps2", "cps3")   
    colrs <- c("gray","black", trellis.par.get()$superpose.line$col[1:3])
    lty <- c(1,2,1,1,1)
    lwd <- c(1.5,1,1,1,1)
    denplot <-
      function(sel=c(1:2,6:8), yvar="re75", offset=30, ylim=c(0,1.75),
               from=NULL, at=c(.5,1,1.5), labels=paste(at), bw="nrd0",
               ylab="Density", takelog=TRUE, col.axis="black"){
        nzre <- unlist(lapply(list(subset(nswdemo, trt==0),
                                   subset(nswdemo, trt==1),
                                   psid1, psid2, psid3, cps1, cps2, cps3)[sel],
                              function(x){z <- x[,yvar]; z[z>0]}))
        num <- unlist(lapply(list(subset(nswdemo, trt==0), subset(nswdemo, trt==1),
                                  psid1, psid2, psid3, cps1, cps2, cps3), 
                             function(x){z <- x[,yvar]; sum(z>0)}))
        xy <- data.frame(nzre=nzre,
                         fac = factor(rep(dsetnames[sel], num[sel]),
                           levels=dsetnames[sel]))
        if(takelog) {
          y <- log(xy$nzre+offset) 
          xlab <- paste("log(", yvar, "+", offset, ")", sep="")} else
        {
          y <- xy$nzre
          xlab <- yvar
        }
        densityplot(~ y, groups=fac, data=xy, bw=bw, from=from,
                    scales=list(y=list(at=at, labels=labels, col=col.axis),
                      tck=0.25),
                    plot.points=FALSE, 
                    col=colrs[1:5], lwd=lwd, lty=lty,
                    key=list(x=0.01, y=0.99, text=list(dsetnames[sel[3:5]]),
                      col=colrs[3:5],
                      lines=list(lwd=rep(1.5,3)), between=1),
                    par.settings=simpleTheme(col=colrs, lty=lty,
                      lwd=lwd), ylim=ylim, ylab=ylab,
                    xlab=xlab)
      }
    print(denplot(), position=c(0, 0, 0.32, 0.505))
    print(denplot(1:5, ylab=" ", col.axis="white"),
          position=c(0.21, 0, .53, 0.505), newpage=FALSE)
    print(denplot(ylab=" ", yvar="re78", col.axis="white"),
          position=c(0.47, 0, 0.79, 0.505),
          newpage=FALSE)
    print(denplot(1:5, ylab=" ", yvar="re78", col.axis="white"),
          position=c(0.68, 0, 1, 0.505), newpage=FALSE)
    ## Age
    print(denplot(yvar="age", takelog=FALSE, ylim=c(0,0.1), from=16,
                  at=c(.02,.04,.06,.08), labels=c(".02",".04",".06",".08")),
          position=c(0, 0.48, 0.32, .985), newpage=FALSE)
    print(denplot(1:5, yvar="age", takelog=FALSE, ylim=c(0,0.1), from=16,
                  at=c(.02,.04,.06,.08), labels=c(".02",".04",".06",".08"),
                  ylab=" ", col.axis="white"),
          position=c(0.21, 0.48, .53, .985), newpage=FALSE)
    ## educ
    print(denplot(1:5, yvar="educ", takelog=FALSE, ylim=c(0,0.5), bw=0.5,
                  at=c(.1,.2,.3,.4), ylab=" "),
          position=c(0.47, 0.48, .79, .985), newpage=FALSE)
    print(denplot(yvar="educ", takelog=FALSE, ylim=c(0,0.75), bw=0.5,
                  at=c(.1,.2,.3,.4), ylab=" ", col.axis="white"),
          position=c(0.68, 0.48, 1, .985), newpage=FALSE)        
    ## Now use grid functions to add text to the graphics page
    pushViewport(viewport(y=unit(1,"npc"), gp=gpar(cex=0.5),
                          width=0.5, height=unit(1.5,"lines"),
                          just=c("centre","top")))
    draw.key(key=list(text=list(dsetnames[1:2]), lines=list(lty=lty[1:2],
                                                   lwd=lwd[1:2], col=colrs[1:2]), columns=2, between=1),
             draw=TRUE)
    popViewport(0)
    if(device!="")dev.off()
  }

gcol10 <-
function(nsw=rbind(psid1, subset(nswdemo, trt==1)), offset=30,
           device="", path="~/dbeta/Art/"){
    if(device!="")hardcopy(width=5.25, height=5.25, trellis=TRUE, path=path,
                           device=device, pointsize=c(8,5), color=TRUE)
    vnames <- c("trt","educ","age","re75","re78")
    nsw <- rbind(psid1, subset(nswdemo, trt==1))
    ## Check minimum non-zero values of re75 and re78
    round(sapply(nsw[,c("re75","re78")], function(x)unique(sort(x))[2]))
    nsw[,c("re75","re78")] <- log(nsw[,c("re75","re78")] + offset)
    lab <- c(vnames[2:3], paste("log\n", vnames[-(1:3)], "+", offset))
    nsw$trt <- factor(nsw$trt, labels=c("Control (psid1)","Treatment"))
    trellis.par.set(superpose.symbol=list(cex=0.25, alpha=0.5),
                    superpose.line=list(lwd=2, alpha=0.5))
    print(splom(~ nsw[,vnames[-1]], type=c("p","smooth"),
                groups=nsw$trt, varnames=lab,
                auto.key=list(columns=2, lines=TRUE)))
                                        #    print(table(trt[here]))
    if(device!="")dev.off()
  }

gcol11 <-
function(device="")
{
  if(!require(splines))return("Package 'splines' is not installed -- cannot proceed")     
  if(!require(lattice))return("Package 'lattice' is not installed -- cannot proceed") 
  if(!require(MASS))return("Package 'MASS' is not installed -- cannot proceed")       
  if(device!="")hardcopy(width=5.25, height=5.25, device=device,
                         color=TRUE, trellis=TRUE, pointsize=c(8,4))
  if(!require(randomForest))return("Package 'randomForest' is not installed -- cannot proceed") 
  trellis.par.set(fontsize=list(text=8,points=4))
  col.line <- trellis.par.get()$superpose.line$col[1:2]
  col.point <- trellis.par.get()$superpose.symbol$col[1:2]
  nsw <- rbind(psid1, subset(nswdemo, trt==1))
  nsw$trt <- factor(nsw$trt, labels=c("Control (psid1)",
                                    "Treated (experimental)"))
  nsw$fac74 <- factor(nsw$re74>0, exclude=NULL)
  levels(nsw$fac74) <- c("0","gt0","<NA>")
  set.seed(41)
  nsw.rf <- randomForest(as.factor(trt) ~ ., data=nsw[, -c(7:8,10)],
                         sampsize=c(297,297))
  logit <- function(p, offset=0.001)log((p+offset)/(1+offset-p))
  trt <-  nsw$trt
  lprob.rf <- logit(predict(nsw.rf, type="prob")[,2])
  nsw.lda <- lda(trt ~ ns(age,2) + ns(educ,2) + black + hisp + fac74 +
                 ns(log(re75+100),3), prior=c(.5, .5), data=nsw) 
  lprob.lda <- logit(predict(nsw.lda)$posterior[,2])
  print(table(nsw$trt[lprob.lda > -4]))
  nswa <- nsw[lprob.rf > -1.5, ]
  nswb <- nsw[lprob.lda >- 4, ]
  ## Note that proximities are now requested.
  nswa.rf <- randomForest(trt ~ ., data=nswa[, -c(7:8,10)])
  lproba.rf <- logit(predict(nswa.rf, type="prob")[,2])
  nswb.lda <- lda(trt ~ ns(age,2) + ns(educ,2) + black + hisp + fac74 +
                 ns(log(re75+100),3), prior=c(.5, .5), data=nswb) 
  lprobb.lda <- logit(predict(nswb.lda)$posterior[,2])
  gph.key <- list(space="top", columns=2,
                  points=list(pch=c(1,3), cex=0.5, col=col.point), 
                  lines=list(lwd=c(1.5,1.5), col=col.line),
                  text=list(c("psid1 controls", "experimental treatment")),
                  padding.text=1
                  )
  gph0 <- xyplot(1 ~ 1, panel=function(x,y,...){}, xlab="", ylab="",
                 scales=list(draw=F),
                  key=gph.key,   
                 par.settings=list(axis.line=list(col="transparent")))
  gph1 <-
    xyplot(age + educ + log(re75+100) ~ lproba.rf, groups=trt, layout=c(3,1), 
           data=nswa, type=c("p","smooth"), span=0.4, aspect=1,
           par.settings=simpleTheme(lwd=c(1.5,1.5), 
             alpha.points=0.5,
             pch=c(1,3), cex=0.4), 
           scales=list(y=list(relation="free"), tck=0.5),
           xlab=" ", par.strip.text=list(cex=0.9),
           main=textGrob("A: Random forest scores (filtered data)",
             x=unit(0.075, "npc"), 
             y = unit(0, "npc"), just="left", 
             gp=gpar(cex=1)) 
           )  
  gph2 <-
    xyplot(age + educ + log(re75+100) ~ lprobb.lda, groups=trt, layout=c(3,1), 
           data=nswb, type=c("p","smooth"), span=0.4, aspect=1,
           par.settings=simpleTheme(lwd=c(1.5,1.5), 
             pch=c(1,3), cex=0.4, alpha.points=0.5),
           scales=list(y=list(relation="free"), tck=0.5),
           xlab="Score", par.strip.text=list(cex=0.9),
           main=textGrob("B: Linear discriminant analysis scores (filtered data)",
             x=unit(.075, "npc"), y = unit(0, "npc"), just="left",
             gp=gpar(cex=1)))           
  print(gph0, position=c(0,0.6,1,1))
  print(gph1, position=c(0,0.475,1,0.95),newpage=FALSE)
  print(gph2, position=c(0,0,1,0.525), newpage=FALSE)
  if(device!="")dev.off()
  invisible()
}

gcol12 <-
function(device="",new=F, ycol = 50-(0:23)*2.1-rep(c(0, 0.5), c(8,16)),
           path="~/dbeta/Art/"){
    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)
    if(!require(RColorBrewer))return("Package 'RColorBrewer' is not installed -- cannot proceed")        
    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()
  }

gcol13 <-
function(device="", new=F, ycol = 47.5-(0:19)*2.1,
           inc=c(3,5,10,12,13:14,18), path="~/dbeta/Art/"){
    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)
    if(!require(dichromat))return("Package 'dichromat' is not installed -- cannot proceed")       
    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()
  }

gcol15 <-
function(width=9.25, height=5, pointsize=c(8,5), device=""){
    if(device!="") hardcopy(width=width, height=height, trellis=T,
                            color=TRUE, horiz=TRUE,
                            pointsize=pointsize, device=device) 
if(!require(latticeExtra))return("Package 'lattice' is not installed -- cannot proceed") 
if(!require(DAAGxtras))return("Package 'DAAGxtras' is not installed -- cannot proceed") 
CO2smu <- with(edcCO2, supsmu(age, co2, span=.005))
tempsmu <- with(edcT, supsmu(Age, dT, span=.001))
co2_layer <- xyplot(y ~ I(-x), data=CO2smu, type="l",
                    xlab="Years Before Present", 
                    ylab = expression(CO[2]*" (ppm)"))
temp_layer <- xyplot(I(y+54.5) ~ I(-x), data=tempsmu, type="l",
                     ylab=expression("Temperature ("*degree*C*")"))
print(doubleYScale(co2_layer, temp_layer, add.ylab2 = TRUE))
    if(device!="")dev.off()
  }

pkgs <- c("latticeExtra","DAAG", "RColorBrewer", "dichromat", "grid", "hddplot","DAAGbio",
          "randomForest","MASS","splines","limma")
z <- sapply(pkgs, require, character.only=TRUE, warn.conflicts=FALSE, quietly=TRUE)
## randomForest 4.6-10
## Type rfNews() to see new features/changes/bug fixes.
if(any(!z)){
  notAvail <- paste(names(z)[!z], collapse=", ")
  stop(paste("The following packages should be installed:", notAvail))
}
gcol1()

plot of chunk unnamed-chunk-2

gcol2()