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.1a <-
function(colr=palette("default")[2:3]){
if(device!="")hardcopy(device=device, width=4.25, height=4.25)
sex <- as.integer(possum$sex)
pairs(possum[,c(9:11)],oma=c(2,4,6,4),pch=c(0,2:7),col=colr[sex],
    labels=c("tail\nlength","foot\nlength","ear conch\nlength"))
sex <- as.integer(possum$sex)
oldpar <- par(xpd=T)
on.exit(par(oldpar))
if(pscript)yleg<-1.08 else yleg <- 1.03
legend(0.05,yleg,c("Cambarville","Bellbird"),pch=c(0,2), 
  x.intersp=0.5,y.intersp=0.75,cex=0.7,xjust=0, bty="n")
legend(0.30,yleg,c("Whian Whian","Byrangery"),pch=3:4,
  x.intersp=0.5,y.intersp=0.75,cex=0.7,xjust=0, bty="n")
legend(0.55,yleg,c("Conondale","Allyn River"),pch=5:6,
  x.intersp=0.5,y.intersp=0.75,cex=0.7,xjust=0, bty="n")
legend(0.80,yleg,c("Bulburin"),pch=7,
  x.intersp=0.5,y.intersp=0.75,cex=0.7, bty="n")
text(x=0.2,y=.935,labels=c("female"),col=colr[1],cex=0.7,xpd=T)
text(x=0.8,.935,labels=c("male"),col=colr[2],cex=0.7,xpd=T)
if(device!="")dev.off()
invisible()
}

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()
  }

g12.4 <-
function(colr=c("gray", "black"), device="", ntimes=4){
    if(device!="")hardcopy(width=3.5, height=3.5, trellis=TRUE,
                           device=device, pointsize=c(6,4))
    require(lattice)
    possum$sexsite <- paste(possum$sex, possum$site, sep=":")
    usepossum <- na.omit(possum[, -5])
    n <- dim(usepossum)[1]
    ntimes <- 4
    bootscores <- data.frame(matrix(0, nrow=ntimes*n, ncol=3))
    for (i in 1:ntimes){
        samprows <- sample(1:n, n, replace=TRUE)
        possumi <- usepossum[samprows, ]
        bootscores[n*(i-1)+(1:n), 1:2] <-
            princomp(possumi[, 5:13])$scores[, 1:2]
        bootscores[n*(i-1)+(1:n), 3] <- usepossum$sexsite[samprows]
    }
    names(bootscores) <- c("scores1","scores2", "sexsite")
    bootscores$another <- rep(1:ntimes, rep(n,ntimes))
    colr <- c("red", "blue")
    pchr <- c(3,4,0,8,2,10,1)
    ss <- expand.grid(site=1:7, sex=1:2)
    boot.xy <- xyplot(scores2 ~ scores1 | another, data=bootscores,
           groups = bootscores$sexsite, col=colr[ss$sex], pch=pchr[ss$site],
           xlab="1st Principal Component",
           ylab="2nd Principal Component", 
           key = list(points = list(pch=pchr),
                  columns=4, cex=.75, between=1, between.columns=2,
                  text=list(c("Cambarville","Bellbird","Whian Whian  ",
                  "Byrangery", "Conondale  ","Allyn River","Bulburin"))))
    print(boot.xy)
    if(device!="")dev.off()
  }

g12.5 <-
function(dset = leafshape17, show = "lines", color = F, device="")
{
    if(device!="") hardcopy(width=4.25, height=2.4, device=device)
    oldpar <- par(mfcol = c(1, 2), mar = par()$mar - c(0.5, 0.5, 0, 0),
                  oma=c(0,.25,0,2))
    on.exit(par(oldpar))
    require(DAAG); data(leafshape17)
    fig1txt <- paste("(a) Untransformed scale")
    fig2txt <- paste("(b) Logarithmic scale, both axes")
    figtxt <- paste("Leaf length versus leaf width, for different species",
                    "\nat a North Queensland site.")
    xlab <- "Leaf width (mm)"
    ylab <- "Leaf length (mm)"
    par(mgp = c(2.5, 0.75, 0))
    plot(dset$bladewid, dset$bladelen, xlab = xlab, ylab = ylab, type = "n")
    points(dset$bladewid, dset$bladelen, pch=c(1,3)[dset$arch+1])
    mtext(side=3,line=0.25,"A", adj=0)
    mtext(side = 1, line = 5.5, fig1txt, adj = 0)
    plot(log10(dset$bladewid), log10(dset$bladelen), 
         pch=c(1,3)[dset$arch+1],axes = F, xlab = 
         xlab, ylab = ylab)
    xpos <- pretty(dset$bladewid)
    ypos <- pretty(dset$bladelen)
    lxpos<-log10(xpos)
    lypos<-log10(ypos)
    axis(1, at = lxpos, label = paste(xpos),cex=.65)
    axis(3, at = round(lxpos,2))
    axis(4, at = round(lypos,2))
    par(mgp = c(2.5, 0.75, 0))
    axis(2, at = lypos, label = paste(ypos), srt = 90)
    mtext(side=3,line=0.25,"B", adj=0)
    mtext(side = 4, line = 2.5, "log10(Leaf length)")
    mtext(side = 3, line = 2.25, "log10(Leaf width)")
    box()
    if(device!="")dev.off()
}

g12.6 <-
function(device=""){
    require(MASS)
    if(device!="") hardcopy(width=4.25, height=4.25,
                            device=device)
    here<- !is.na(possum$footlgth)
    oldpar <-  par(pch= c(1,3,6,0,5,6,17))
    on.exit(par(oldpar))
    possum<-possum[here,]
    possum.lda <- lda(site~hdlngth+skullw+totlngth+taill+
                      footlgth+earconch+eye+chest+belly, data=possum)
    scores <- predict(possum.lda)$x[,1:3]
    options(digits=4)
    pchr <- c(3,4,0,8,2,10,1)
    colr <- trellis.par.get()$superpose.symbol$col
    possum.splom <- 
splom(~ scores, 
      groups = possum$site, pch = pchr,
      varnames=c("LD1","LD2","LD3"),
      key =list(points = list(pch=pchr, col=colr),
                text=list(c("Cambarville","Bellbird","Whian Whian","Byrangery",
                            "Conondale ","Allyn River", "Bulburin")), columns=4))
print(possum.splom)
    if(device!="")dev.off()
    invisible()
  }

g99.1 <-
function(device="", path="~/r-book/ed2/Art/")
{
  if(device!="")hardcopy(width=7.5, height=10, path=path,
                         device=device, pointsize=c(9,5))
  xplot(data=sweep(nMA$M,2,c(-1,1,-1,1,-1,1),"*"),
        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()
}

gdump <-
function(fnam=NULL, prefix="~/r-book/ed2/figures/figs",
           xtras=c("hardcopy","renum.fun","renum.files"), 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)), xtras)
    cat("\nDump to file:", fnam, "\n")
    print(objnames)
    dump(objnames, fnam)
  }

gsave <-
function(fnam=NULL, prefix="~/r-book/ed2/figures/figs",
           splitchar="/ch", xtras=c("hardcopy","renum.fun","renum.files")){
    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])))
  }

renum.fun <-
function(from.prefix=NULL, to.prefix="g",from=4:1, to=4:1, doit=F){
    path <- getwd()
    pathtag <- strsplit(path, "/ch", fixed=TRUE)[[1]]
    endbit <- pathtag[length(pathtag)]
    to.prefix <- paste(to.prefix, endbit, sep="")
    if(is.null(from.prefix))from.prefix <- to.prefix
    for(i in 1:length(to))
      {txt<-paste(to.prefix,".",to[i]," <- ", from.prefix,".",from[i],sep="")
       if(doit)eval(parse(text=txt),envir=sys.frame(0))
       print(txt)
       if(from.prefix!=to.prefix){
         rm.txt <- paste("rm(",from.prefix,".",from[i],")",sep="")
         if(doit)eval(parse(text=rm.txt),envir=sys.frame(0))
       print(rm.txt)
       }
     }
  }

renum.files <-
function(from.prefix="~/r-book/ed2/Art/", to.prefix="~/r-book/ed2/Art/",
           from=20:7, to=21:8, doit=F){
    path <- getwd()
    pathtag <- strsplit(path, "/ch", fixed=TRUE)[[1]]
    endbit <- pathtag[length(pathtag)]
    if(nchar(endbit)==2)chap <- paste(endbit) else
       chap <- paste("0",endbit,sep="")
    from.prefix <- paste(from.prefix, chap, "-", sep="")
    to.prefix <- paste(to.prefix, chap, "-", sep="")
    for(i in 1:length(from)){
      if (from[i]<=9) ltext <- paste("0",from[i],sep="")
      else ltext <- paste(from[i])
      if (to[i]<=9) rtext <- paste("0",to[i],sep="")
      else rtext <- paste(to[i])            
      txt<-paste("mv ", from.prefix, ltext, ".eps", " ",
                 to.prefix, rtext, ".eps", sep="")
      backup<-paste("cp ", from.prefix, ltext, ".eps", " ",
                 "archive", sep="")
      if(doit)system(backup)
      if(doit)system(txt)
      print(backup)
      print(txt)
    }
  }