`g7.1` <-
function(device="")
{
  if(device!="")hardcopy(width=3.0, height=1.75, device=device)
  oldpar <- par(mar = c(4.1,4.1,1.1,1.1), mgp=c(2.5,0.75,0), las=2)
  on.exit(par(oldpar))
  stripchart(sugar$weight ~ sugar$trt, pch=0, xlab="Weight (mg)",
             ylim=c(0.5,4.5))
  figtxt <- paste("Weights of sugar extracted from plants"
                  )
  cat(figtxt,"\n")
  if(device!="")dev.off()
  invisible()
}

`g7.10` <-
function(df=fruitohms, device=""){
    library(monoProc)
    if(device!="")hardcopy(width=2.25, height=2.25, device=device)
    oldpar <- par(mar = c(4.1,4.1,1.1,1.1), mgp=c(2.5,0.75,0), pty="s")
    on.exit(par(oldpar))
    u <- monoproc(loess(ohms~juice, data=fruitohms), bandwidth=0.1,
                  mono1="decreasing", gridsize=30)
    plot(ohms ~ juice, data=df, xlab="Apparent juice content (%)",
         ylab="Resistance (ohms)")
    lines(u)
    if(device!="")dev.off()
  }

`g7.11` <-
function(dset = dewpoint, device="")
{
  require(splines)
  if(device!="")hardcopy(width=4, height=2, device=device)
  figtxt <- paste("Representation of dew point (dewpoint) as the sum of",
                  "\nan effect due to maximum temperature, and an effect",
                  "\ndue to minimum temperature. The dashed lines are 95%",
                  "\nconfidence bounds.", sep = "")
  oldpar <- par(mfrow=c(1,2), mar=c(4.1,4.6,2.1,1.6),
                  mgp=c(2.5,.75,0), pty="s")
  par(mex = 1, cex = 1)
  on.exit(par(oldpar))
  y<-dewpoint$dewpt
  x<-dewpoint$maxtemp
  z<-dewpoint$mintemp
  
  u <- lm(y ~ bs(x,5) + bs(z,5),data=dset)
  u.fit<-predict(u,type="terms",se=T)
  plot(x,u.fit$fit[,1],xlab="Maximum temperature"       ,
       ylab="Change from dewpoint mean",type="n")
  lines(x,u.fit$fit[,1])
  lines(x,u.fit$fit[,1]-2*u.fit$se[,1],lty=2)
  lines(x,u.fit$fit[,1]+2*u.fit$se[,1],lty=2)
  plot(z,u.fit$fit[,2],xlab="Minimum temperature",
       ylab="Change from dewpoint mean",type="n")
  cat(figtxt,"\n")
  ord<-order(z)
  lines(z[ord],u.fit$fit[ord,2])
  lines(z[ord],u.fit$fit[ord,2]-2*u.fit$se[ord,2],lty=2)
  lines(z[ord],u.fit$fit[ord,2]+2*u.fit$se[ord,2],lty=2)
  if(device!="")dev.off()
  invisible()
}

`g7.12` <-
function(dset = dewpoint, device="")
{
  if(device!="")hardcopy(trellis=T, width=5, height=2.5, device=device,
                         pointsize=c(8,6))
  figtxt <- paste("Given plots of residuals against maximum temperature,",
                  "\nfor different ranges of minimum temperature.", sep = "")
  library(splines)
  library(lattice)
  ds.lm <- lm(dewpt ~ bs(maxtemp,5) + bs(mintemp,5), data=dewpoint)
  mintempRange <- equal.count(dewpoint$mintemp, number=3)
  ds.xy <- xyplot(residuals(ds.lm) ~ maxtemp|mintempRange,
                  data=dewpoint, aspect=1, layout=c(3,1),
                  type=c("p","smooth"), xlab="Maximum temperature",
                  ylab="Residual", par.strip.text=list(cex=0.75), cex=0.65)
  print(ds.xy)
  cat(figtxt,"\n")
  if(device!="")dev.off()
  invisible()
}

`g7.13` <-
function(device=""){
    if(device!="")hardcopy(width=2.25, height=2.25, device=device)
    oldpar <- par(mar = c(4.1,4.1,1.1,1.1), mgp=c(2.5,0.75,0), pty="s")
    library(splines)
    library(SemiPar)
    attach(dewpoint)
     fit <- spm(dewpt ~ f(mintemp, maxtemp))
     dewpt.bdry <- default.bdry(mintemp, maxtemp)
    plot(fit, bdry=dewpt.bdry)
    box()
    title(sub="Fitted Thin-Plate Spline")
    detach(dewpoint)
    if(device!="")dev.off()
  }

`g7.2` <-
function(device="")
{
  appletaste.aov <- aov(aftertaste ~ panelist + product, 
                        data=appletaste)
  if(device!="")hardcopy(width=4, height=2.1, device=device)
  oldpar <- par(mar = c(4.1,4.1,1.1,2.1), mgp=c(2.5,0.75,0), pty="s",
                mfrow=c(1,2))
  on.exit(par(oldpar))
  termplot(appletaste.aov, partial=TRUE, col.res="black")
  if(device!="")dev.off()
  invisible()
}

`g7.3` <-
function(dset = leaftemp, device="", cex.eq=0.65)
{
  if(device!="")hardcopy(width=5.25, height=2.65, device=device)

  oldpar <- par(mar = c(4.1,3.6,3.6,0.1), mgp=c(2.5,0.75,0), pty="s")
  figtxt <- paste("A sequence of models fitted to the plot of tempDiff",
                  "\nvs vapPress, for low, medium and high levels of CO2")
  on.exit(par(oldpar))
  options(contrasts = c("contr.treatment", "contr.poly"))
  ## Needed for S-PLUS
  attach(dset)
  yran <- range(tempDiff)
  yran[2] <- yran[2] + diff(yran) * 0.08
  leaf.lm1 <- lm(tempDiff ~ vapPress, data = dset)
  leaf.lm2 <- lm(tempDiff ~ CO2level + vapPress, data = dset)
  leaf.lm3 <- lm(tempDiff ~ CO2level + vapPress + vapPress:CO2level, data
                 = dset)
  par(fig=c(0, 0.35, 0, 0.9))
  plot(vapPress, tempDiff, xlab = "Vapour Pressure", 
       ylab = "Temperature difference", ylim = yran,
       pch = as.numeric(CO2level), cex=0.7, cex.axis=0.8, col="black")
  mtext(side = 3, line = 1.65, "A: Single line", adj = 0)
  topleft <- par()$usr[c(1, 4)] + c(cex.eq, -cex.eq) * par()$cxy
  chh <- par()$cxy[2]*0.5
  ab1 <- leaf.lm1$coef
  mtext(side=3,line=0.75,
        paste("tempDiff =", round(ab1[1], 2), round(ab1[2], 2),
              " x vapPress",sep = ""), adj=0, col="black", cex=cex.eq) 
  abline(ab1[1], ab1[2])
  par(fig=c(0.32, 0.67, 0, 0.9), new=T)
  plot(vapPress, tempDiff, xlab = "Vapour Pressure",
       ylab = "", 
       ylim = yran, pch = as.numeric(CO2level),
       cex=0.7, cex.axis=0.8)
  mtext(side = 3, line = 1.65, "B: Parallel lines", adj = 0)
  a1 <- leaf.lm2$coef[1]
  a2 <- sum(leaf.lm2$coef[1:2])
  a3 <- sum(leaf.lm2$coef[c(1,3)])
  b1 <- leaf.lm2$coef[4]
  mtext(side=3,line=.75,
        paste("Intercepts are:", round(a1, 2), round(a2,2),
              round(a3,2),sep=", ")
        , adj = 0, col = "black", cex = cex.eq)
  mtext(side=3,line=0, paste("Slope is", round(b1, 2), sep = " "), 
        adj = 0, col = "black", cex = cex.eq)
  r1 <- range(vapPress, CO2level=="low")
  r2 <- range(vapPress, CO2level=="medium")
  r3 <- range(vapPress, CO2level=="high")
  y1 <- a1 + b1 * r1
  lines(r1, y1, lty = 2, lwd = 1, col = "black")
  y2 <- a2 + b1 * r2
  lines(r2, y2, lty = 4, lwd = 1, col = "black")
  y3 <- a3 + b1 * r3
  lines(r3, y3, lty = 5, lwd = 1, col = "black")
  par(fig=c(0.64, 0.99, 0, 0.9), new=T)
  plot(vapPress, tempDiff, xlab = "Vapour Pressure",
       ylab = "", 
       ylim = yran,  pch = as.numeric(CO2level),
       cex=0.7, cex.axis=0.8)
  mtext(side = 3, line = 1.65, "C: Separate lines", adj = 0)
  print(summary(leaf.lm3))
  a1 <- leaf.lm3$coef[1]
  a2 <- sum(leaf.lm3$coef[1:2])
  a3 <- sum(leaf.lm3$coef[c(1,3)])   
  b1 <- leaf.lm3$coef[4]
  b2 <- sum(leaf.lm3$coef[4:5])
  b3 <- sum(leaf.lm3$coef[c(4,6)])
  mtext(side=3,line=.75,
        paste("Intercepts are:", round(a1, 2), round(a2,2),
              round(a3,2), sep=", ")
        , adj = 0, col = "black", cex = cex.eq)
  mtext(side=3,line=0,
        paste("Slopes are", round(b1, 2), round(b2,2),
              round(b3,2), sep=", "),adj=0, cex=cex.eq)
  y1 <- a1 + b1 * r1
  lines(r1, y1, lty = 2, lwd = 1, col = "black")
  y2 <- a2 + b2 * r2
  lines(r2, y2, lty = 4, lwd = 1, col = "black")
  y3 <- a3 + b3 * r3
  lines(r3, y3, lty = 5, lwd = 1, col = "black")
  par(fig=c(0, 1, 0, 1),new=T, mar=rep(0,4))
  plot(0:1, 0:1, bty="n", axes=F, xlab="", ylab="", type="n")
  legend(0.5, 0.98, legend=c("low","medium","high"), lty=c(4,5,7), col="black",
         pch=1:3, xjust=0.45, yjust=1, bty="n", pt.cex=1.15, ncol=3,
         text.width=0.25, cex=0.85)
  detach(dset)
  cat(figtxt, "\n")
  par(fig=c(0,1,0,1))
  if(device!="")dev.off()
  invisible()
}

`g7.4` <-
function(device="")
{
  if(device!="")hardcopy(width=5.5, height=1.4,
                         device=device)
  oldpar<-par(mar=c(4.1,4.1,2.1,1.6), mfrow=c(1,4), mgp=c(2.25,.5,0), pty="s")
  on.exit(par(oldpar))
  if(!exists("leaf.lm2"))leaf.lm2 <- lm(formula = tempDiff ~ CO2level +
                                        vapPress, data = leaftemp)
  plot(leaf.lm2,caption=c("Resids vs Fitted", 
                  "Normal Q-Q", "Scale-Location", "",
                  "Resid vs Leverage"), which=c(1:3,5), cook.levels=0.12)
  figtxt<-paste("Diagnostic plots for the parallel line model.")
  print(figtxt)   
  if(device!="")dev.off()
  invisible()
}

`g7.5` <-
function(device="")
{
  if(device!="")hardcopy(width=2, height=2, device=device)
  oldpar <- par(mar = c(4.1,4.1,1.1,1.1), mgp=c(2.5,0.75,0), pty="s")
  on.exit(par(oldpar))
  require(DAAG); data(seedrates)
  plot(grain ~ rate, data = seedrates, pch = 16, xlab="Seeding rate",
       xlim = c(50, 160), axes=F, cex=1.4, ylab="Grains per head")
  figtxt <- paste("Plot of number of grain per head versus seeding rate,",
                  "\nfor the barley seeding rate data, with fitted",
                  "\nquadratic curve.")
  new.df <- data.frame(rate = (1:14) * 12.5)
  atx <- seedrates$rate
  axis(1,at=atx)
  axis(2)
  box()
  seedrates.lm2 <- lm(grain ~ rate + I(rate^2), data = seedrates)
  hat2 <- predict(seedrates.lm2, newdata = new.df, interval="predict", 
                  coverage = 0.95)
  lines(new.df$rate, hat2[,"fit"], lty = 2)
  cat(figtxt,"\n")
  if(device!="")dev.off()
  invisible()
}

`g7.6` <-
function(device="")
{
  if(device!="")hardcopy(width=2.25, height=2.25, device=device)
  oldpar <- par(mar = c(4.1,4.1,1.1,1.1), mgp=c(2.5,0.75,0), pty="s")
  on.exit(par(oldpar))
  plot(grain ~ rate, data = seedrates, pch = 16, xlim = c(50, 175), ylim
       = c(15.5, 22),xlab="Seeding rate",ylab="Grains per head")
  figtxt <- paste("Plot of number of grain per head versus seeding rate,",
                  "\nfor the barley seeding rate data, with fitted",
                  "quadratic curve."
                  )
  new.df <- data.frame(rate = c((4:14) * 12.5))
  seedrates.lm1 <- lm(grain ~ rate, data = seedrates)
  seedrates.lm2 <- lm(grain ~ rate + I(rate^2), data = seedrates)
  pred1 <- predict(seedrates.lm1, newdata = new.df,
                   interval="confidence")
  hat1<-data.frame(fit=pred1[,"fit"], lower=pred1[,"lwr"],
                   upper=pred1[,"upr"])
  pred2 <- predict(seedrates.lm2, newdata = new.df,
                   interval="confidence")
  hat2<-data.frame(fit=pred2[,"fit"], lower=pred2[,"lwr"],
                   upper=pred2[,"upr"])
  lines(new.df$rate, hat1$fit, lty=1)
  lines(new.df$rate, hat2$fit, lty=2, lwd=2)
  rate <- new.df$rate

  lines(lowess(rate,hat1$lower),lty=1, col="gray")
  lines(lowess(rate, hat1$upper),lty=1, col="gray")
  lines(lowess(rate,hat2$lower),lty=2, col="gray")
  lines(lowess(rate, hat2$upper),lty=2, col="gray")
  cat("\n", figtxt, "\n")
  if(device!="")dev.off()
}

`g7.7` <-
function(df=fruitohms, lt=c(1,2), device=""){
    if(device!="")hardcopy(width=3.5, height=3.25, device=device)
    oldpar<-par(mfrow=c(2,2),mar=c(4.1,4.1,1.6,0.6), oma=c(0.6,0,0,0.6),
                mgp=c(2.5,.5,0))
    on.exit(par(oldpar))
    require(splines)
    plot(ohms~juice,data=df,cex=0.8,xlab="",
         ylab="Resistance (ohms)", type="n")
    points(ohms ~ juice, data=df, cex=0.65, col="grey40")
    mtext(side=3,line=0.5,"A: Noraml spline, 2 internal knots (df = 3)",
          adj=0,at=0, cex=.75)
    knots <- attributes(with(df, ns(juice,3)))$knots
    abline(v=knots, col="gray")
    fruit.lmb1<-lm(ohms~ns(juice,3),data=df)
    ord<-order(df$juice)
    lines(df$juice[ord],fitted(fruit.lmb1)[ord])
    ci<-predict(fruit.lmb1,interval="confidence")
    lines(df$juice[ord],ci[ord,"lwr"],lty=lt[2], col="gray20")
    lines(df$juice[ord],ci[ord,"upr"],lty=lt[2], col="gray20")
    plot(ohms~juice,data=df,cex=0.8,xlab="",
         ylab="", type="n")
    points(ohms ~ juice, data=df, cex=0.65, col="grey40")
    knots <- attributes(with(df, ns(juice,4)))$knots
    abline(v=knots, col="gray")
    mtext(side=3,line=0.5,"B: Normal spline, 3 internal knots (df = 4)",
          adj=0,at=0,cex=.75)
    fruit.lmb2<-lm(ohms~ns(juice,4),data=df)
    lines(df$juice[ord],fitted(fruit.lmb2)[ord])
    ci<-predict(fruit.lmb2,interval="confidence")
    lines(df$juice[ord],ci[ord,"lwr"],lty=lt[2], col="gray20")
    lines(df$juice[ord],ci[ord,"upr"],lty=lt[2], col="gray20")
    plot(ohms~juice,data=df,cex=0.8,xlab="Apparent juice content (%)",
         ylab="Resistance (ohms)", type="n")
    points(ohms ~ juice, data=df, cex=0.65, col="grey40")
    mtext(side=3,line=0.5,"C: Polynomial, degree 3", adj=0, at=0, cex=.75)
    fruit.lmp3 <- lm(ohms~poly(juice,3), data=df)
    fruit.lmp4 <- lm(ohms~poly(juice,4), data=df)
    lines(df$juice[ord],fitted(fruit.lmp3)[ord])
    ci<-predict(fruit.lmp3, se=TRUE)
    tval <- qt(0.025, ci$df)
    ci$lwr <- ci$fit-tval*ci$se.fit
    ci$upr <- ci$fit+tval*ci$se.fit
    lines(df$juice[ord], ci$lwr[ord], lty=lt[2], col="gray20")
    lines(df$juice[ord], ci$upr[ord], lty=lt[2], col="gray20")
    plot(ohms~juice, data=df, cex=0.8, xlab="Apparent juice content (%)",
         ylab="", type="n")
    points(ohms ~ juice, data=df, cex=0.65, col="gray40")  
    mtext(side=3, line=0.5, "D: Polynomial, degree 4", at=0, adj=0, cex=.75)
    lines(df$juice[ord], fitted(fruit.lmp4)[ord])
    ci<-predict(fruit.lmp4, se=TRUE)
    tval <- qt(0.025, ci$df)
    ci$lwr <- ci$fit-tval*ci$se.fit
    ci$upr <- ci$fit+tval*ci$se.fit
    lines(df$juice[ord], ci$lwr[ord], lty=lt[2], col="gray20")
    lines(df$juice[ord], ci$upr[ord], lty=lt[2], col="gray20")
    if(device!="")dev.off()
  }

`g7.8` <-
function(df=fruitohms, device=""){
    require(splines)
    if(device!="")hardcopy(width=5.2, height=1.4, device=device)
    oldpar <- par(mfrow=c(1,4), mar=c(4.1,4.1,2.1,1.1),
                  mgp=c(2.25,.75,0),oma=c(0,0,0,1), pty="s")
    on.exit(par(oldpar))
    fruit.lmb1<-lm(ohms~ns(juice,4), data=df)
    options(digits=4)
    print(summary(fruit.lmb1))
    plot(fruit.lmb1, caption=c("Resids vs Fitted", 
                       "Normal Q-Q", "Scale-Location", "",
                       "Resids vs Leverage"), which=c(1:3,5), cook.levels=0.12)
    cat("\nDiagnostic plots.\n")
    if(device!="")dev.off()
  }

`g7.9` <-
function(dset = fruitohms, device="", cex.eq=0.25)
{
  require(splines)
  if(device!="")hardcopy(width=3.25, height=2.8, device=device)
    oldpar <- par(mfrow=c(2,2), mar=c(3.6,4.6,1.6,2.1),
                  mgp=c(2.25,.75,0),oma=c(1.1,0,1.1,0.6))
  figtxt <- paste(
                  "Spline basis curves for the B-spline (1 knot) fit.",
                  "\nColumns of the X-matrix, after the first, are formed",
                  "\nfrom the points shown on the respective curve.")
  on.exit(par(oldpar))
  fruit.lmb4<-lm(ohms~bs(juice,4),data=dset)
  plot(fruitohms$juice, model.matrix(fruit.lmb4)[,2], type="n",
       xlab="",ylab="Column 2 of X-matrix")
  ord<-order(fruitohms$juice)
  lines(fruitohms$juice[ord], model.matrix(fruit.lmb4)[ord,2])
  mtext(side = 3, line = 0.5, "A: Basis curve 1 (col. 2)", adj = 0,cex=.75)
  plot(fruitohms$juice, model.matrix(fruit.lmb4)[,3], type="n",
       xlab="",ylab="Column 3 of X-matrix")
  lines(fruitohms$juice[ord], model.matrix(fruit.lmb4)[ord,3])
  mtext(side = 3, line = 0.5, "B: Basis curve 2 (col. 3)",
        adj = 0, cex=.75)
  plot(fruitohms$juice, model.matrix(fruit.lmb4)[,4], type="n",
       xlab="Apparent juice content (%)",ylab="Column 4 of X-matrix")
  lines(fruitohms$juice[ord], model.matrix(fruit.lmb4)[ord,4])
  mtext(side = 3, line = 0.5, "C: Basis curve 3 (col. 4)", adj = 0,
        cex=0.75)
  plot(fruitohms$juice, model.matrix(fruit.lmb4)[,5], type="n",
       xlab="Apparent juice content (%)",ylab="Column 5 of X-matrix")
  lines(fruitohms$juice[ord], model.matrix(fruit.lmb4)[ord,5])
  mtext(side = 3, line = 0.5, "D: Basis curve 4 (col. 5)",
        adj = 0, cex=.75)
  cat(figtxt,"\n")
  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)
  }

`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("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="g", to.prefix="g",from=20:7, to=21:8, doit=F){
          path <- getwd()
    pathtag <- strsplit(path, "/ch", fixed=TRUE)[[1]]
    endbit <- pathtag[length(pathtag)]
    from.prefix <- paste(from.prefix, endbit, sep="")
    to.prefix <- paste(to.prefix, endbit, sep="")
    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)
     }
  }

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