`g10.1` <-
function(device=""){
    if(device!="")hardcopy(width=3.25, height=2.25,
                           device=device, trellis=T, pointsize=c(9,6))
    oldpar <- par(mar = par()$mar - c(1, 0, 1, 0))
    on.exit(par(oldpar))
    library(lattice)
    print(stripplot(loc ~ harvwt, data=ant111block,
                    xlab="Harvest weight of corn"))
    if(device!="")dev.off()
  }

`g10.10` <-
function(device=""){
    if(device!="")hardcopy(device=device, width=4.5, height=2.25,
                           color=TRUE, pointsize=8)

    oldpar <- par(mar=c(4.1,4.1,1.1,1.1), mgp=c(2.5,0.75,0), pty="s",
                  mfrow=c(1,2))
    on.exit(par(oldpar))
    library(lme4)
##    library(MEMSS)
    Orthodont$age <- Orthodont$age-11
    ab <- coef(lmList(distance ~ age|Subject, data=Orthodont))
    ab$sex <- substring(rownames(ab),1,1)
    names(ab) <- c("a", "b", "sex")
    xlim <- range(ab[,1])
    xlim <- xlim+diff(xlim)*c(-.015, .185)
    ylim <- range(ab[,2])
    ylim <- ylim+diff(ylim)*c(-.015, .015)
    plot(ab[,1], ab[,2], col=c(F="red", M="blue")[ab$sex],
         pch=c(F=1, M=3)[ab$sex], xlim=xlim, ylim=ylim,
         xlab="Intercept", ylab="Slope")
    use <- ab$a %in% range(ab$a) | ab$b %in% range(ab$b) |
    ab$b==min(ab$b[ab$sex=="M"])
    text(ab[use, 1], ab[use, 2], rownames(ab)[use], pos=4, xpd=TRUE)
    mtext(side=3, line=1,"A: Distances", adj=0)
    ##
    Orthodont$logdist <- log(Orthodont$distance)
    ab <- coef(lmList(logdist ~ age|Subject, data=Orthodont))
    ab$sex <- substring(rownames(ab),1,1)
    names(ab) <- c("a", "b", "sex")
    xlim <- range(ab[,1])
    xlim <- xlim+diff(xlim)*c(-.015, .185)
    ylim <- range(ab[,2])
    ylim <- ylim+diff(ylim)*c(-.015, .015)
    plot(ab[,1], ab[,2], col=c(F="red", M="blue")[ab$sex],
         pch=c(F=1, M=3)[ab$sex], xlim=xlim, ylim=ylim,
         xlab="Intercept", ylab="Slope")
    text(ab[use, 1], ab[use, 2], rownames(ab)[use], pos=4, xpd=TRUE)
    mtext(side=3, line=1,"B: Logarithms of distances", adj=0)
    if(device!="")dev.off()
  }

`g10.2` <-
function(device="")
{
  if(device!="")hardcopy(width=3, height=1.85, device=device)
  oldpar <- par(mar = c(4.1, 6.1,1.1,1.1), mgp=c(2.5, 0.75,0))
  on.exit(par(oldpar))
  require(DAAG); data(science)
  attach(science)
  classmeans <- aggregate(like,by=list(PrivPub,Class),mean)
  names(classmeans) <- c("PrivPub","Class","like")
  dim(classmeans)
  detach(science)
  attach(classmeans)
  boxplot(split(like, PrivPub), xlab = "Class average of score",
          boxwex = 0.4, horizontal=TRUE, las=2)
  rug(like[PrivPub == "private"], side = 1)
  rug(like[PrivPub == "public"], side = 3)
  detach(classmeans)
  if(device!="")dev.off()
}

`g10.3` <-
function(pnum=c(1,3), device=""){
                                        #    leg <- c("Class effect vs #", "W/i class var vs #",
                                        #             "qnorm(); site effect", "qnorm(); w/i class resids")
    require(lme4)
    leg <- rep("",4)
    mtext3 <- function(item="A", txt=leg[1],
                       xleft=par()$usr[1]+1.25*par()$cxy[1]){
      mtext(side = 3, line = 0.25, item, adj = 0)
      mtext(side = 3, line = 0.25, txt, cex = 0.85, at=xleft, adj = 0)
    }
    science$class <- factor(science$class)
    science$school <- factor(science$school)
    if(device!="")hardcopy(width=3.75, height=3.75,
                           device=device, pointsize=9)    
    science1.lmer <- lmer(like ~ sex + PrivPub + (1 | school:class),
                          data = science, na.action=na.exclude)
    oldpar <- par(mfrow=c(2,2), mar = c(4.6, 4.1, 2.6, 2.1), mgp=c(2.5,0.75,0),
                  oma=c(0,0,2,0))
    on.exit(par(oldpar))
    rfinfo <- ranef.extract(obj = science1.lmer, term = "school:class",
                            fun = c("length", "var"), addfact="PrivPub")
    num <- rfinfo[, "length"]
    use <- num>5
    numlabs <- pretty(num)
    privpub <- rfinfo[, "PrivPub"]
    rf <- rfinfo[, "school:class"]
    plot(sqrt(num), rf, xaxt="n", pch=pnum[as.numeric(privpub)],
         xlab="# in class (square root scale)",
         ylab="Estimate of class effect")
    lines(lowess(sqrt(num[privpub=="private"&num>5]),
                 rf[privpub=="private"&num>5], f=1.1), lty=2)
    lines(lowess(sqrt(num[privpub=="public"]),
                 rf[privpub=="public"], f=1.1), lty=3)
    axis(1, at=sqrt(numlabs), labels=paste(numlabs))
    mtext3(item="A", txt=leg[1], xleft=par()$usr[1]+1.25*par()$cxy[1])    
    vars <- rfinfo[, "var"]
    plot(sqrt(num), vars, xaxt="n", pch=pnum[as.numeric(privpub)],
         xlab="# in class (square root scale)",
         ylab="Within class variance")
    lines(lowess(sqrt(num[privpub=="private"&num>5]),
                 as.vector(vars)[privpub=="private"&num>5], f=1.1), lty=2)
    lines(lowess(sqrt(num[privpub=="public"]),
                 as.vector(vars)[privpub=="public"], f=1.1), lty=3)    
    axis(1, at=sqrt(numlabs), labels=paste(numlabs))
    mtext3(item="B", txt=leg[2], xleft=par()$usr[1]+1.25*par()$cxy[1])
    qqnorm(rf, ylab="Ordered site effects", main="")
    mtext3(item="C", txt=leg[3], xleft=par()$usr[1]+1.25*par()$cxy[1])
    qqnorm(residuals(science1.lmer), ylab="Ordered w/i class residuals",
           main="")
    mtext3(item="D", txt=leg[4], xleft=par()$usr[1]+1.25*par()$cxy[1])    
    
    par(mfrow=c(1,1))
    par(fig=c(0,1,0.8,1), mar=c(0,0,0,0), mgp=c(0,0,0),
        oma=c(0,0,0.5,0), new=TRUE)
    plot.new()
    plot.window(xlim=c(0,1), ylim=c(0,1))
    legend(x="top", legend=c("Private     ", "Public"), pch=c(1,3),
           lwd=c(1,1), lty=2:3,
           xjust=0.5, yjust=0, horiz=TRUE, merge=FALSE, bty="n")
    if(device!="")dev.off()
  }

`g10.4` <-
function(device=""){
    if(device!="")hardcopy(width=4.25, height=4.25, device=device)
    oldpar <- par(mar=c(0.5,1,1,1),mgp=c(0,.5,.5))
    on.exit(par(oldpar))
    plot(c(0,13),c(0,13),type="n",xlab="",ylab="",
         axes=F)
    eps <- 0.1
    vines<-function(x=1,y=1,subp=0){
      lines(c(x,x+1,x+1,x,x),c(y,y,y+1,y+1,y))
      points(c(x+.2,x+.8,x+.8,x+.2),c(y+.2,y+.2,y+.8,y+.8),pch=3)
      text(x+.5,y+.5,paste(subp))
    }
    k<-0
    for(i in c(1,3,5,7)){k<-k+1; vines(1,i,c(3,1,0,2)[k])}
    k<-0
    for(i in c(1,3,5,7)){k<-k+1; vines(4,i,c(2,1,0,3)[k])}
    k <- 0
    for(i in c(1,4,4,1)){k<-k+1
                         j<-c(9,9,11,11)[k]
                         vines(i,j,c(3,2,1,0)[k])
                       }
    lines(c(3,3,NA,3,3),c(0,2.85,NA,10.15,13),lty=2)
    lines(c(0,0,NA,0,0),c(0,2.85,NA,10.15,13),lty=2)
    lines(c(8,8,NA,8,8),c(0,4.5,NA,8.5,13),lty=2)
    lines(c(0,1.25,NA,6.75,8),rep(0,5),lty=2)
    lines(c(0,1.25,NA,6.75,8),rep(13,5),lty=2)
    lines(c(1,5,5,1,1)+c(-eps,eps,eps,-eps,-eps),
          c(9,9,12,12,9)+c(-eps,-eps,eps,eps,-eps),lwd=2)
    lines(c(1,2,2,1,1)+c(-eps,eps,eps,-eps,-eps),
          c(1,1,8,8,1)+c(-eps,-eps,eps,eps,-eps),lwd=2)
    lines(c(1,2,2,1,1)+3+c(-eps,eps,eps,-eps,-eps),
          c(1,1,8,8,1)+c(-eps,-eps,eps,eps,-eps),lwd=2)
    text(0,6.5,"6 meters height artifical shelter belt", srt=90)
    text(4,0,"9 meters height shelter belt")
    text(4,13,"19 meters height shelter belt")
    text(8,6.5,"Willow shelter belt",srt=90)
    text(8.5,10.5,"0 Unshaded   \n1 Shaded Aug-Dec   \n2 Dec-Feb   \n3 Feb-May",
         adj=0)
    text(3,6.5,"16 meters height willow shelter belt", srt=90)
    lines(c(8.25,8.75),c(13,13-sqrt(3)*.5))

    lines(rep(8.25,2),c(12.6,13))
    lines(c(8.25,8.25+sqrt(3)/5),c(13,12.8))
    text(8.85,12.65,"N")
    if(device!="")dev.off()
  }

`g10.5` <-
function(device="")
{
  if(device!="")hardcopy(width=3.75, height=2.25, device=device)
  oldpar<-par(mar=c(4.5,6.1,1.1,1.1), mfrow=c(1,1))
  on.exit(par(oldpar))
  attach(kiwishade)
  kiwimeans <- aggregate(yield,by=list(block,shade),mean)
  names(kiwimeans) <- c("block","shade","meanyield")
  detach(kiwishade)
  plotmeans.lm <- lm(meanyield~block+shade, data=kiwimeans)
  effects <- predict(plotmeans.lm, type="terms")
  kiwishade.lm <- lm(yield ~ block*shade, data=kiwishade)
  y <- c(effects[,"block"]/sqrt(2) * sqrt(16),
         effects[,"shade"]/sqrt(3) * sqrt(12), 
         residuals(plotmeans.lm)/sqrt(6) * sqrt(4),
         residuals(kiwishade.lm)/
         sqrt(12))
  n <- rep(4:1, c(12, 12, 12, 48))
  gps <- rep(c("block effect\n(ms=86.2)", "shade\n(464.8)", 
               "plot\n(20.9)", "vine\n(12.2)"), c(12, 12, 12, 48))
  gps <- factor(gps, levels = rev(c("block effect\n(ms=86.2)", 
                       "shade\n(464.8)", "plot\n(20.9)",
                       "vine\n(12.2)")))
  gps.sd <- sapply(split(y,gps), sd)
  gps.av <- sapply(split(y,gps), mean)
  plot(range(y), range(n)+c(-0.5, 0.5), xlab="", ylab="", yaxt="n", type="n")
  text(y, n+0.15, "|")
  un <- 1:4
  sapply(un, function(j){lines(gps.av[j]+c(-gps.sd[j], gps.sd[j]),
                              rep(j-0.15,2), col="gray")
                        lines(rep(gps.av[j],2)-gps.sd[j],
                              j-0.15+c(-.06, .06), col="gray")
                        lines(rep(gps.av[j],2)+gps.sd[j],
                              j-0.15+c(-.06, .06), col="gray")
                      })
  mtext(side=1,line=3, 
        text="Variation in Yield (kg)\n(Add to grand mean of yield = 96.53)")
  par(las=2)
  axis(2, at=1:4, labels=levels(gps))
  if(device!="")dev.off()
}

`g10.6` <-
function(device="", path="")
{
  if(device!="")hardcopy(width=4, height=4, path="~/r-book/ed2/Art/",
                         device=device, trellis=TRUE, pointsize=c(8, 5))
  library(lattice)
  library(grid)
  trellis.par.set(layout.heights=list(key.top=0.5, axis.top=1.15,
                    bottom.padding=0.15, main.key.padding=2.5))
  kiwishade$blocks <- factor(kiwishade$blocks,
                             levels=c("west", "north", "east"))
  if (!exists("kiwishade.lmer"))
    kiwishade.lmer <- lmer(yield ~ shade + (1|block) + (1|block:plot),
                           data=kiwishade)  
  pk2 <- xyplot(residuals(kiwishade.lmer) ~ fitted(kiwishade.lmer)|block,
                groups=shade, layout=c(3,1), par.strip.text=list(cex=1.0),
                pch=1:4, data=kiwishade, grid=TRUE,
                xlab="Level 2 fitted values (Treatment + block + plot effects)",
                ylab="Residuals (level 2)",  
                scales=list(x=list(alternating=FALSE)),
                legend=list(top=list(fun=textGrob,
                              args=list(label="A", x=0,
                                just="left"))),
                key=list(x=0.1, y=0.89, points=list(pch=1:4),
                  text=list(labels=levels(kiwishade$shade)),columns=4))
  print(pk2,  position=c(0,.52,1,1))
  kiwimeans <- with(kiwishade, 
                    aggregate(yield, by=list(block=block, shade=shade),
                              mean))
  names(kiwimeans)[3] <- "avyield"
  kiwimeans.lmer <- lmer(avyield ~ shade + (1 | block),
                         data=kiwimeans)
  plotres <- residuals(kiwimeans.lmer)
  plothat <- fitted(kiwimeans.lmer)
  pk1 <- xyplot(plotres ~ plothat|block, layout=c(3,1),
                par.strip.text=list(cex=1.0), pch=1:4, cex=1.2,
                groups=shade, grid=TRUE, ylab="Plot effects",
                data=kiwimeans,
                scales=list(x=list(alternating=FALSE)),
                legend=list(top=list(fun=textGrob,
                              args=list(label="B",
                                x=0, just="left"))),
                key=list(x=0.1, y=0.89, points=list(pch=1:4),
                  text=list(labels=levels(kiwishade$shade)),columns=4),  
                xlab="Level 1 fitted values (Treatment + block effects)")
  print(pk1,  newpage=FALSE, position=c(0,0,1,.48))
  if(device!="")dev.off()
  invisible()
}

`g10.7` <-
function(device=""){
    library(lattice)
    library(grid)
    library(nlme)
    if(device!="")hardcopy(device=device, width=4.25, height=4,
                        color=TRUE, pointsize=10)
    oldpar <- par(mgp=c(2.25, .5,0), mar=c(4.1,4.1,1.6,1.1),
                  pty="s", cex=1, cex.lab=1)
    on.exit(par(oldpar))
    par(fig=c(0, 0.925, 0, 1))
    plot(o2 ~ wattsPerKg, data=humanpower1,
         pch=(1:5)[unlist(id)],
         col=palette()[unlist(id)],
         xlab="Watts per kilogram",
         ylab=expression("Oxygen intake ("*ml.min^{-1}*.kg^{-1}*")"))
    hp.lmList <- lmList(o2 ~ wattsPerKg|id, data=humanpower1)
    sapply(1:length(hp.lmList), function(i)abline(hp.lmList[[i]], col=i))
    mtext(side=3, line=0.25, "A", adj=-0.165)
    par(fig=c(0.6, 1, 0.025, 0.525), new=TRUE, cex=0.8)
    coefs <- data.frame(t(sapply(hp.lmList, coef)))
    names(coefs) <- c("Intercept", "Slope")
    par(pty="s", tck=-0.025, xpd=TRUE, cex.axis=0.8, cex.lab=0.75,
        mgp=c(1.25,0.25,0))
    plot(Slope ~ Intercept, data=coefs, pch=1:5, type="n")
    xy <- par()$usr
    chw <- par()$cxy[1]
    chh <- par()$cxy[2]
    rect(xy[1]-3.25*chw,xy[3]-2.75*chh,xy[2]+chw,xy[4]+chh, col="gray80")
    axis(1)
    axis(2)
    box()
    with(coefs, points(Slope ~ Intercept, cex=1, pch=1:5))
    par(xpd=F)
    abline(lm(Slope ~ Intercept, data=coefs)$coef)
    par(xpd=TRUE, cex=1)
    text(xy[1]-2.25*chw, xy[4]+0.25*chh, "B")
    mtext(side=1,line=1.5,"Intercept", cex=0.8)
    mtext(side=2,line=1.5,"Slope", cex=0.8)
    par(fig=c(0,1,0,1), cex=1, xpd=FALSE)
    if(device!="")dev.off()
  }

`g10.8` <-
function(device=""){
    library(lattice)
    library(grid)
    if(device!="")hardcopy(device=device, width=4, height=6,
                        trellis=TRUE, color=TRUE)
    trellis.par.set(layout.heights=list(key.top=0.25, axis.top=0.65))
    hp1.lme <- lme(o2 ~ wattsPerKg,
                   random=~ -1 +I(wattsPerKg-2.77) | id,
                   data=humanpower1)
    hat2 <- fitted(hp1.lme)
    hp1.plt1 <- xyplot(o2 ~ wattsPerKg, groups=id, data=humanpower1,
                       panel=function(x,y,subscripts,groups,hat2,...){
                         u <- lm(y ~ groups*x);
                         hat <- fitted(u)
                         panel.superpose(x,hat,subscripts,groups, type="l")
                         panel.superpose(x, y=hat2, subscripts, groups,
                                         type="l", lty=2)
                       },
                       xlab="Watts per kilogram",
                       ylab=expression("Oxygen intake ("*ml.min^{-1}*.kg^{-1}*")"),
                       legend=list(top=list(fun=textGrob, args=list(label="A", x=0))),
                       hat2=hat2, aspect=1)
    print(hp1.plt1, position=c(0,0.42,1,1))
    res <- resid(hp1.lme)
    hp1.plt2 <- xyplot(res ~ wattsPerKg, groups=id,
                       data=humanpower1, xlab="Watts per kilogram",
                       ylab="Residuals from random lines",
                       legend=list(top=list(fun=textGrob, args=list(label="B", x=0))), type="l")
    print(hp1.plt2, position=c(0.025, 0,1,0.42), newpage=FALSE)
    if(device!="")dev.off()
  }

`g10.9` <-
function(device="", log=2){
    library(lattice)
    library(grid)
    if(device!="")hardcopy(device=device, width=5.25, height=3.25,
                           trellis=TRUE, color=FALSE, pointsize=c(7,5))
    plt <- xyplot(distance ~ age | Subject, groups=Sex,
                  data=Orthodont, type=c("p","r"),
                  par.strip.text=list(cex=0.75), scale=list(log=log),
                  layout=c(11,3))
    print(plt)
    if(device!="")dev.off()
  }

`gdump` <-
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)],
                    ".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)
  }

`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])
      }
  }

`gfocus.demo` <-
function(device=""){
        library(lattice)
        library(grid)
        if(device!="")hardcopy(device=device, width=4, height=2.25, trellis=TRUE,
                            color=TRUE)
        trellis.par.set(layout.heights=list(key.top=0.25, axis.top=0.5))
        hp1.plt1 <- xyplot(o2 ~ wattsPerKg, groups=id, data=humanpower1,
               panel=function(x,y,subscripts,groups,...){
                   u <- lm(y~groups*x);
                   hat <- fitted(u)
                   panel.superpose(x,y,subscripts,groups)
                   panel.superpose(x,hat,subscripts,groups, type="l")
               },
##               key=simpleKey(text=rep("",5), lines=TRUE, columns=5),
               xlab="Watts per kilogram",
               ylab=expression("Oxygen intake ("*ml.min^{-1}*.kg^{-1}*")"),
               legend=list(top=list(fun=textGrob, args=list(label="A", x=0))))
        print(hp1.plt1, position=c(0,0,.535,1))
        u <- lme(o2 ~ wattsPerKg, random=~wattsPerKg|id, data=humanpower1)
        hp1.plt2 <- xyplot(o2 ~ wattsPerKg, groups=id, data=humanpower1,
               panel=function(x,y,subscripts,groups,...){
                   u <- lm(y~groups*x);
                   hat <- fitted(u)
                   panel.superpose(x,hat,subscripts,groups, type="l")
               },
               xlab="Watts per kilogram", ylab="",
               legend=list(top=list(fun=textGrob, args=list(label="B", x=0))))
        hat <- fitted(u)
        print(hp1.plt2, position=c(.465, 0,1,1), newpage=FALSE)
        trellis.focus("panel", row=1, column=1)
        arglist <- trellis.panelArgs()
        panel.superpose(x=arglist$x,y=hat,subscripts=arglist$subscripts,
                        groups=arglist$groups, , type="l", lty=2)
        trellis.unfocus()        
        if(device!="")dev.off()
    }

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

`gtest` <-
function(device=""){
        library(lattice)
        library(grid)
        if(device!="")trellis.device(pdf,width=3, height=3.25, 
                                     color=TRUE, file="test.pdf")
        plt <- xyplot(uptake ~ conc, groups=Plant, data=CO2)
        print(plt)
        trellis.focus("panel", row=1, column=1, highlight=FALSE)
        arglist=trellis.panelArgs()
        arglist$type <- "l"
        do.call("panel.superpose", args=arglist) 
        trellis.unfocus()        
        if(device!="")dev.off()
    }

`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,
           splitchars="/ch", doit=F){
    path <- getwd()
    pathtag <- strsplit(path, splitchars, fixed=TRUE)[[1]]
    if(length(pathtag)==1)endbit <- "" else
    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/second/Art/", to.prefix="~/r-book/second/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)
    }
  }