RDX2 X  g2.1 source+ -function(device="", path="~/r-book/ed2/Art/") { 8 if(device!="")hardcopy(width=5.5, height=2, path=path, ' device=device) ' oldpar <- par(mar=c(4.1,3.6,3.1,0.4), " mgp=c(2.5,0.75,0))  on.exit(par(oldpar))  library(DAAG)  data(possum)  attach(possum)  here <- sex == "f" ! dens <- density(totlngth[here])  xlim <- range(dens$x)  ylim <- range(dens$y)  par(fig=c(0,0.26,0,1)) < hist(totlngth[here], breaks = 72.5 + (0:5) * 5, xlim=xlim, : ylim = c(0, 22), xlab="Total length (cm)", main="") 1 mtext(side=3, line=2.1, "A", at=67.5, cex=1.15) < mtext(side=3, line=0.8, text ="Breaks at 72.5, 77.5, ...") % par(fig=c(0.22,0.48,0,1), new=TRUE) C hist(totlngth[here], breaks = 75 + (0:5) * 5, xlim=xlim, ylab="", D ylim = c(0, 22), xlab="Total length (cm)", yaxt="n", main="") 1 mtext(side=3, line=2.1, "B", at=67.5, cex=1.15) 7 mtext(side=3, line=0.8, text="Breaks at 75, 80, ...") & par(fig=c(0.52, 0.78,0,1), new=TRUE) 9 hist(totlngth[here], breaks = 72.5 + (0:5) * 5, freq=F,  probability = T, xlim > = xlim, ylim = ylim, xlab="Total length (cm)", main="") 1 mtext(side=3, line=2.1, "C", at=67.5, cex=1.15) 7 mtext(side=3, line=0.8, text="Breaks as in A", at=81) lines(dens) " par(fig=c(0.74,1,0,1), new=TRUE) 7 hist(totlngth[here], breaks = 75 + (0:5) * 5, freq=F, ; probability = T, xlim = xlim, ylim = ylim, yaxt="n", 2 xlab="Total length (cm)", ylab="", main="") 1 mtext(side=3, line=2.1, "D", at=67.5, cex=1.15) 7 mtext(side=3, line=0.8, text="Breaks as in B", at=81) lines(dens)   detach("possum")  if(device!="")dev.off() invisible() }ў§ device  path ~/r-book/ed2/Art/ў { if !=џ ў hardcopy width@ height@џџџџўў <- oldpar par mar c@ffffff@ ЬЬЬЬЬЭ@ЬЬЬЬЬЭ?й™™™™™šў mgpџ@?шўўў on.exit џ џўў library DAAGў data possumў attachџў џ here == sex fўў џ dens density [ totlngthџўўў џ xlim range $џ xўўў џ ylimџ џџ yўўў џ figџ?аЃз =pЄ?№ўў histџџџў breaks +@R  * ( :@ўў@ўўџџ!џџ@6ў xlab Total length (cm) main ў mtext side@ line@ЬЬЬЬЬЭ A at@Pр cex?ђffffffў+џ,џ@-џ?щ™™™™™š text Breaks at 72.5, 77.5, ...ў џ"џџ?Ь(ѕТ\)?оИQы…И?№ў new ў#џџџџў$џ%џ@RР&џ'џ(џ@ўў@ўўџџ ylab !џџ@6ў)џ Total length (cm) yaxt n*џ ў+џ,џ@-џ@ЬЬЬЬЬЭ B.џ@Pр/џ?ђffffffў+џ,џ@-џ?щ™™™™™š0џ Breaks at 75, 80, ...ў џ"џџ?рЃз =pЄ?шѕТ\(і?№ў1џ ў#џџџџў$џ%џ@R &џ'џ(џ@ўў@ўў freq F probability Tџџ!џ!џ)џ Total length (cm)*џ ў+џ,џ@-џ@ЬЬЬЬЬЭ C.џ@Pр/џ?ђffffffў+џ,џ@-џ?щ™™™™™š0џ Breaks as in A.џ@T@ў linesџў џ"џџ?чЎzсGЎ?№?№ў1џ ў#џџџџў$џ%џ@RР&џ'џ(џ@ўў@ўў4џ5џ6џ7џџџ!џ!џ3џ n)џ Total length (cm)2џ *џ ў+џ,џ@-џ@ЬЬЬЬЬЭ D.џ@Pр/џ?ђffffffў+џ,џ@-џ?щ™™™™™š0џ Breaks as in B.џ@T@ў8џџў detach possumўџџџ ў dev.offўў invisibleўў g2.10џ &function(device="", pointsize=c(8,4)){  library(DAAG) 2 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() 6 mtext(side=3, line=2.5, "A", adj=-0.225, cex=0.75) ( par(fig=c(0.455, 1, 0, 1), new=TRUE) 6 mtext(side=3, line=2.5, "B", adj=-0.225, cex=0.75)  colr <- c("gray40","black")  plotchar <- c(1, 16) H targplot <- xyplot(csoa ~ it|sex*agegp, data=tinting, groups=target, / col=colr, pch=plotchar, 7 key=list(space="top", columns=2, = points=list(pch=plotchar, col=colr), < text=list(levels(tinting$target))), 9 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)] 2 plotchar <- c(1,16,16) # open, filled, filled > u <- xyplot(csoa~it|sex*agegp, data=tinting, groups=tint, ( col=colr, pch=plotchar, 0 type=c("p","smooth"), span=1.25, 0 key=list(space="top", columns=3, 8 points=list(pch=c(1,16,16), col=colr), = text=list(levels(tinting$tint), col=colr)), ; scale=list(y=list(alternating=2)), ylab="") 7 print(u, position=c(0.475, 0, 1, 1), newpage=FALSE)  if(device!="")dev.off()  }ў§$џ  pointsizeџ@ @ўўџџџўџџџ ўџ џ@ џ@ =џ=џџџ trellis7џ color7џўў џ"џџ?рЬЬЬЬЬЭ?№ўў plot.newў+џ,џ@-џ@ A adj -?ЬЬЬЬЬЬЭў/џ?шў џ"џџ?нИQы…?№?№ў1џ ў+џ,џ@-џ@ BAџBџ?ЬЬЬЬЬЬЭў/џ?шў џ colrџ gray40 blackўў џ plotcharџ?№@0ўў џ targplot xyplot ~ csoa | it&џџ agegpўўўџ tinting groups target colCџ pchDџ key list space top columns@ pointsRџPџDџOџCџў0џRџ levels џLџ targetўўўў scaleRџ yRџ alternating?№ўўўў printEџ positionџ?рЬЬЬЬЬЭ?№ў newpage ў џCџџџ skyblue1 skyblue4ўџ@?№@ўўў џDџџ?№@0@0ўў џ uFџGџHџIџJџ&џџKџўўўџLџMџ tintOџCџPџDџ typeџ p smoothў span?єQџRџSџ topTџ@UџRџPџџ?№@0@0ўOџCџў0џRџVџ џLџ tintўўOџCџўўWџRџXџRџYџ@ўў2џ ўўZџ]џ[џџ?оffffff?№?№ў\џ ўџџџ ў:џўўў g2.11џ function(device=""){ @ if(device!="")hardcopy(width=2.25, height=2.25, pointsize=8, ) device=device) 5 oldpar <- par(mar=c(2.1,2.1, 1.1, 1.1), xpd=TRUE)  on.exit(par(oldpar)) > stones <- array(c(81,6,234,36,192,71,55,25), dim=c(2,2,2), 8 dimnames=list(Sucess=c("yes","no"), 4 Method=c("open","ultrasound"), 3 Size=c("<2cm\n", ">=2cm\n"))) 0 library(vcd) # vcd must be installed H mosaicplot(aperm(stones, 3:1), cex.axis=0.65, main="", off=c(4,5,6))  if(device!="")dev.off()  }ў§џ ўџџџџ ўџ џ@ џ@=џ@ џџўў џ џ џџџ@ЬЬЬЬЬЭ@ЬЬЬЬЬЭ?ё™™™™™š?ё™™™™™šў xpd ўўџ џ џўў џ stones arrayџ@T@@@m@@B@h@QР@K€@9ў dimџ@@@ў dimnamesRџ Sucessџ yes noў Methodџ open ultrasoundў Sizeџ <2cm  >=2cm ўўўўџ vcdў mosaicplot apermcџ(џ@?№ўў cex.axis?фЬЬЬЬЬЭ*џ  offџ@@@ўўџџџ ў:џўўў g2.12џ %function(device="", pointsize=c(9,6)) { : if(device!=""){hardcopy(width=5, height=2.25, trellis=T, F color=F, pointsize=pointsize, device=device)  } 3 oldpar <- par(mar = par()$mar + c(0, 3, -2.5, 0))  on.exit(par(oldpar))  library(DAAG) M kiwishade$block <- factor(kiwishade$block, levels=c("west","north","east")) I gph <- dotplot(shade~yield | block, data=kiwishade, pch=1, col="black", A panel=function(x,y,...){panel.dotplot(x, y, ...) H av <- sapply(split(x,y), mean); : ypos <- unique(y) L lpoints(ypos ~ av, pch=3, cex=1.25, = col="black") ) }, 1 key=list(space="top", columns=2, 8 text=list(c("Individual vine yields", 5 "Plot means (4 vines)"), cex=1), < points=list(pch=c(1, 3), cex=c(1,1.25))), + layout=c(3,1), aspect=1)  print(gph)  if(device!="")dev.off() invisible() }ў§џ =џџ@"@ўўџџџџ ўџџ џ@ џ@>џ7џ?џ5џ=џ=џџџўўў џ џ џџ%џ џ џў marўџ@Bџ@ўўўўўџ џ џўўџџў џ џ kiwishade blockў factor џpџ blockўVџџ west north eastўўў џ gph dotplotGџ shadeIџ yieldqџўўџpџPџ?№Oџ black panel function$ xћ$Xџћ ...ћўџ panel.dotplotyџXџzџў џ av sapply splityџXџў meanўў џ ypos uniqueXџўў lpointsGџ€џ|џўPџ@/џ?єOџ blackўў *function(x,y,...){panel.dotplot(x, y, ...) H av <- sapply(split(x,y), mean); : ypos <- unique(y) L lpoints(ypos ~ av, pch=3, cex=1.25, = col="black") ( }ўQџRџSџ topTџ@0џRџџ Individual vine yields Plot means (4 vines)ў/џ?№ўUџRџPџџ?№@ў/џџ?№?єўўў layoutџ@?№ў aspect?№ўўZџsџўџџџ ў:џўў;џўў g2.13џ. function(device="", seed=21) { " if(!is.null(seed))set.seed(seed) 0 if(device!="")hardcopy(width=4.5, height=1.25, ' device=device) E titl <- paste("Different relationships between y and x.", sep = "")  x1 <- x2 <- x3 <- (11:30)/5  y1 <- x1 + rnorm(20)/2 @ y2 <- 2 - 0.05 * x1 + 0.1 * ((x1 - 1.75))^4 + 1.25 * rnorm(20)  r <- round(cor(x1, y2), 3) * rho <- round(cor(rank(x1), rank(y2)), 3)  print(c(r, rho)) + y3 <- (x1 - 3.85)^2 + 0.015 + rnorm(20)/4 ! theta <- ((2 * pi) * (1:20))/20  x4 <- 10 + 4 * cos(theta) / y4 <- 10 + 4 * sin(theta) + (0.5 * rnorm(20))  r1 <- cor(x1, y1) @ xy <- data.frame(x = c(rep(x1, 3), x4), y = c(y1, y2, y3, y4), - gp = rep(1:4, rep(20, 4)))  xy<-split(xy,xy$gp) ) xlimdf<-lapply(list(x1,x2,x3,x4),range) ) ylimdf<-lapply(list(y1,y2,y3,y4),range) A xy<-lapply(1:4,function(i,u,v,w){list(xlim=v[[i]], ylim=w[[i]], A x=u[[i]]$x, y=u[[i]]$y)}, $ u=xy,v=xlimdf,w=ylimdf) ! panel.corr<-function(data,...){ x<-data$x y<-data$y  points(x, y, pch = 16)  chh <- par()$cxy[2]  x1 <- min(x)  y1 <- max(y) - chh/8  r1 <- cor(x, y) 9 text(x1, y1, paste(round(r1, 3)), cex = 1.0, adj = 0)  } 4 panelplot(xy,panel=panel.corr,totrows=1,totcols=4,  oma=rep(1,4)) ; titl <- paste(titl, " In the lower right \npanel, the ", - "Pearson correlation is ", r, > ", while the Spearman rank \ncorrelation is ", # rho, ".", sep = "")  if(device!="")dev.off()  par(mfrow=c(1,1)) invisible() }ў§џ  seed@5ўџџ ! is.null†џўў set.seed†џўўџџџ ўџ џ@ џ?єџџўў џ titl paste (Different relationships between y and x. sep ўў џ x1 џ x2 џ x3 /'џ(џ@&@>ўў@ўўўў џ y1%џџџ rnorm@4ў@ўўў џ y2%џ%џBџ@&џ?Љ™™™™™šџўў&џ?Й™™™™™š ^'џ'џBџџ?ќўўў@ўўў&џ?є’џ@4ўўўў џ r round corџ“џў@ўў џ rho–џ—џ rankџў™џ“џўў@ўўZџџ•џ˜џўў џ y3%џ%џ”џ'џBџџ@ЬЬЬЬЬЭўў@ў?ŽИQы…Иўџ’џ@4ў@ўўў џ thetaџ'џ&џ'џ&џ@ piўў'џ(џ?№@4ўўўў@4ўў џ x4%џ@$&џ@ cos›џўўўў џ y4%џ%џ@$&џ@ sin›џўўў'џ&џ?р’џ@4ўўўўў џ r1—џџ‘џўў џ xy data.frameyџџ repџ@ўџўXџџ‘џ“џšџŸџў gpЄџ(џ?№@ўЄџ@4@ўўўў џЂџ~џЂџ џЂџ gpўўў џ xlimdf lapplyRџџŽџџџўџўў џ ylimdfЇџRџ‘џ“џšџŸџўџўў џЂџЇџ(џ?№@ўxџ iћ$]џћ$ vћ$ wћўџRџџ [[ЊџЉџў!џЌџЋџЉџўyџ џЌџ]џЉџў xўXџ џЌџ]џЉџў yўўў 0function(i,u,v,w){list(xlim=v[[i]], ylim=w[[i]], @ x=u[[i]]$x, y=u[[i]]$y)}ў]џЂџЊџІџЋџЈџўў џ panel.corrxџџћzџћўџ џyџ џџ xўў џXџ џџ yўўUџyџXџPџ@0ў џ chhџ џ џў cxyў@ўў џџ minyџўў џ‘џBџ maxXџўџЎџ@ ўўў џЁџ—џyџXџўў0џџ‘џ‹џ–џЁџ@ўў/џ?№Aџўў function(data,...){ x<-data$x y<-data$y  points(x, y, pch = 16)  chh <- par()$cxy[2]  x1 <- min(x)  y1 <- max(y) - chh/8  r1 <- cor(x, y) 9 text(x1, y1, paste(round(r1, 3)), cex = 1.0, adj = 0)  }ўў panelplotЂџwџ­џ totrows?№ totcols@ omaЄџ?№@ўў џŠџ‹џŠџ ! In the lower right panel, the  Pearson correlation is •џ *, while the Spearman rank correlation is ˜џ .Œџ ўўџџџ ў:џўў џ mfrowџ?№?№ўў;џўў g2.2џ ?function(width=4.25, height=2.25, pointsize=c(7,4), device=""){ F if(device!="") hardcopy(width=width, height=height, trellis=T, I color=F, pointsize=pointsize, device=device)  library(DAAG)  data(possum) D gph <- densityplot(~earconch | Pop, groups=sex, data=possum, > auto.key=list(columns=2), aspect=1)  print(gph)  if(device!="")dev.off()  }ў§ џ@ џ@=џџ@@ўџ ўџџџџ ўџ џ џ џ џ>џ7џ?џ5џ=џ=џџџўўџџўџџў џsџ densityplotGџIџ earconch PopўўMџџџџ auto.keyRџTџ@ў„џ?№ўўZџsџўџџџ ў:џўўў g2.3џG :function(dset = possum, x = totlngth, here = possum$sex == 0 "f", device="", ytex=0.8, cex.jm=0.9) {  yglim <- c(0,1) = if(device!="")hardcopy(device=device, width=4.25, height=2)  else yglim <- c(0.265,0.735) ) dname <- as.character(substitute(dset)) % xnam <- as.character(substitute(x))  x <- dset[here, xnam]  n <- length(x)  if(dname == "possum") {  xlab <- switch(xnam, 2 totlngth = "Total length (cm)", / pes = "Length of foot (cm)")  }  else xlab <- xnam , oldpar <- par(mar = c(4.1, 0.6, 0.6, 0.6))  on.exit(par(oldpar)) ' z <- boxplot(list(val = x), plot = F) " xlim <- range(c(z$stats, z$out)) , xlim <- xlim + c(-0.025,0.05) * diff(xlim)  ylim <- c(.55,1.5) * par(fig=c(0, 0.665, yglim[1], yglim[2])) plot.new()  plot.window(xlim, ylim) top <- 0.7 L bxp(z, at=top, boxwex = 0.15, xlab = "", xlim=xlim, ylim=ylim, horiz=TRUE,  add=TRUE)  chh <- par()$cxy[2]  chw <- par()$cxy[1] text(z$stats[5], top+0.35*chh, : "Largest value \n(there are no outliers)", adj = 0,  cex = cex.jm, srt=90) Q text(z$stats[4], top+0.65*chh, "upper quartile", adj = 0, srt=90, cex = cex.jm) I text(z$stats[3], top+0.65*chh, "median", adj = 0, srt=90, cex = cex.jm) Q text(z$stats[2], top+0.65*chh, "lower quartile", adj = 0, srt=90, cex = cex.jm) Y text(z$stats[1], top+0.35*chh, "Smallest value \n(outliers excepted)", adj = 0, srt=90,  cex = cex.jm) N if(!is.null(z$out)) text(z$out[1], top+0.35*chh, "Outlier", adj = 0, srt=90, ( cex = cex.jm) N # lines(c(90, 90), z$stats[c(2, 4)])  av <- mean(z$stats[c(2, 4)])  q1 <- z$stats[2]  q3 <- z$stats[4] 1 axis(1, at = c(q1, q3), tck = 0.02, labels = F)  botm<-par()$usr[3] ! text(c(q1, q3), rep(top-chh,2), I c(format(round(q1, 2)), format(round(q3, 1))),adj=0.5, cex=cex.jm)  qtop <- q3 + 0.5 * chh  mtext(side=1,line=2.5,xlab) 1 par(fig=c(0.675, 1, yglim[1], yglim[2]), new=T) = plot(0:1, 0:1, bty="n", axes=F, xlab="", ylab="", type="n") > text(0, ytex, "Inter-quartile range", adj = 0, cex = cex.jm) F text(0.15, ytex - 1.15 * chh, paste("= ", format(round(q3, 2)), "-", C format(round(q1, 2)), "\n= ", A format(round(q3 - q1, 2))),  adj = 0, cex = cex.jm)  here <- !is.na(x)  sd <- sqrt(var(x[here])) K text(0, ytex - 5 * chh, paste("Compare\n", "0.75 x Inter-quartile range", O "\n =", format(round(0.75 * (q3 - q1), 1)), G "\nwith", "standard deviation\n =", M format(round(sd, 1))), adj = 0, cex = cex.jm)  n <- sum(here)  if(device!="")dev.off()  par(fig=c(0,1,0,1)) par(oldpar) invisible() }ў§ dsetџyџџџџ џџџў fўџ  ytex?щ™™™™™š cex.jm?ьЬЬЬЬЬЭў srcref.  srcfileђ encoding native.enc timestampAбрУ> class POSIXt POSIXctў filename /tmp/johnm.g2.3.R wd /Users/johnm/r/ch2ўўФџ srcfileўФџ srcrefў РџСџФџ srcrefў )РџСџФџ srcrefў   %РџСџФџ srcrefў   РџСџФџ srcrefў   РџСџФџ srcrefў  РџСџФџ srcrefў ,РџСџФџ srcrefў РџСџФџ srcrefў 'РџСџФџ srcrefў "РџСџФџ srcrefў ,РџСџФџ srcrefў РџСџФџ srcrefў *РџСџФџ srcrefў  РџСџФџ srcrefў РџСџФџ srcrefў  РџСџФџ srcrefў РџСџФџ srcrefў РџСџФџ srcrefў   РџСџФџ srcrefў !#РџСџФџ srcrefў $$QРџСџФџ srcrefў %%IРџСџФџ srcrefў &&QРџСџФџ srcrefў '(РџСџФџ srcrefў )*(РџСџФџ srcrefў ,,РџСџФџ srcrefў --РџСџФџ srcrefў ..РџСџФџ srcrefў //1РџСџФџ srcrefў 00РџСџФџ srcrefў 12IРџСџФџ srcrefў 33РџСџФџ srcrefў 44РџСџФџ srcrefў 551РџСџФџ srcrefў 66=РџСџФџ srcrefў 77>РџСџФџ srcrefў 8;РџСџФџ srcrefў <<РџСџФџ srcrefў ==РџСџФџ srcrefў >AMРџСџФџ srcrefў CCРџСџФџ srcrefў DDРџСџФџ srcrefў EEРџСџФџ srcrefў FF РџСџФџ srcrefў GG РџСџФџ srcrefўРџСџўџ џ yglimџ?№ўўџџџ ўџџџ џ@ џ@ў џЧџџ?аѕТ\(і?ч…ИQы…ўўў џ dname as.character substituteМџўўў џ xnamЩџЪџyџўўў џyџџМџџЫџўў џ n lengthyџўўџџШџ possumўПџ  /РџСџФџ srcrefўРџСџўџ џ)џ switchЫџџ Total length (cm) pes Length of foot (cm)ўўў џ)џЫџўў џ џ џџџ@ffffff?у333333?у333333?у333333ўўўџ џ џўў џ z boxplotRџ valyџў plot5џўў џџџџ џаџ statsў џаџ outўўўў џџ%џџ&џџBџ?™™™™™™šў?Љ™™™™™šў diffџўўўў џ!џџ?с™™™™™š?јўў џ"џџ?хGЎzсHџЧџ?№ўџЧџ@ўўў@џў plot.windowџ!џў џ top?цffffffў bxpаџ.џиџ boxwex?У333333)џ џџ!џ!џ horiz  add ў џЎџџ џ џў cxyў@ўў џ chwџ џ џўнџў?№ўў0џџ џаџдџў@ў%џиџ&џ?жffffffЎџўў &Largest value (there are no outliers)Aџ/џОџ srt@V€ў0џџ џаџдџў@ў%џиџ&џ?фЬЬЬЬЬЭЎџўў upper quartileAџпџ@V€/џОџў0џџ џаџдџў@ў%џиџ&џ?фЬЬЬЬЬЭЎџўў medianAџпџ@V€/џОџў0џџ џаџдџў@ў%џиџ&џ?фЬЬЬЬЬЭЎџўў lower quartileAџпџ@V€/џОџў0џџ џаџдџў?№ў%џиџ&џ?жffffffЎџўў #Smallest value (outliers excepted)Aџпџ@V€/џОџўџ‡џˆџ џаџеџўўў0џџ џаџеџў?№ў%џиџ&џ?жffffffЎџўў OutlierAџпџ@V€/џОџўў џ|џџџ џаџдџўџ@@ўўўў џ q1џ џаџдџў@ўў џ q3џ џаџдџў@ўў axis?№.џџрџсџў tck?”zсGЎ{ labels5џў џ botmџ џ џў usrў@ўў0џџрџсџўЄџBџиџЎџў@ўџ format–џрџ@ўўчџ–џсџ?№ўўўAџ?р/џОџў џ qtop%џсџ&џ?рЎџўўў+џ,џ?№-џ@)џў џ"џџ?х™™™™™š?№џЧџ?№ўџЧџ@ўў1џ7џўгџ(џ?№ў(џ?№ў bty n axes5џ)џ 2џ _џ nў0џНџ Inter-quartile rangeAџ/џОџў0џ?У333333BџНџ&џ?ђffffffЎџўў‹џ = чџ–џсџ@ўў -чџ–џрџ@ўў  = чџ–џBџсџрџў@ўўўAџ/џОџў џџ‡џ is.nayџўўў џ sd sqrt varџyџџўўўў0џBџНџ&џ@Ўџўў‹џ Compare  0.75 x Inter-quartile range  =чџ–џ&џ?ш'џBџсџрџўўў?№ўў  with standard deviation =чџ–џьџ?№ўўўAџ/џОџў џЬџ sumџўўџџџ ў:џўў џ"џџ?№?№ўў џ џў;џўў g2.4џ function(device="") { > if(device!="")hardcopy(device=device, width=4.8, height=3.8) 9 oldpar <- par(mar=c(3.6,5.1,2.1,1.1), oma=c(0.5,0,0,0), " mgp=c(3.5,0.75,0)) & on.exit(par(oldpar))  par(fig=c(0, 1, .4, 1)) > plot(log(measles,10), xlab="", ylim=c(0,log(5000*1000, 10)), 8 ylab=" Deaths; Population (log scale)", yaxt="n") 4 ytikpoints <- c(1, 10, 100,1000, 1000000, 5000000) I axis(2, at=log10(ytikpoints), labels=paste(ytikpoints), cex=.75, las=2) F londonpop <- ts(c(1088,1258,1504,1778,2073,2491,2921,3336,3881,4266, I 4563,4541,4498,4408), start=1801, end=1931, deltat=10) 0 points(log(londonpop*1000,10), pch=16, cex=.5) 1 mtext(side=3, line=0.5, "A (1629-1939)", adj=0) < par(fig=c(0, 1, 0, .45), mar=c(2.1,5.1,3.1,1.1), new=TRUE) D plot(window(measles, start=1840, end=1882), xlab="Year", yaxt="n", : ylim=c(0,4600), ylab="Deaths; Population in 1000s") # points(londonpop, pch=16, cex=.5) ) axis(2, at=(1:4)*1000, cex=.75, las=2) 1 mtext(side=3, line=0.5, "B (1841-1881)", adj=0)  if(device!="")dev.off() invisible() }ў§џ ўџџџџ ўџџџ џ@333333 џ@ffffffўў џ џ џџџ@ ЬЬЬЬЬЭ@ffffff@ЬЬЬЬЬЭ?ё™™™™™šўДџџ?рўџџ@ ?шўўўџ џ џўў џ"џџ?№?й™™™™™š?№ўўгџ log measles@$ў)џ !џџёџ&џ@Гˆ@@ў@$ўў2џ  Deaths; Population (log scale)3џ nў џ ytikpointsџ?№@$@Y@@A.„€ASаўўтџ@.џ log10ѓџўфџ‹џѓџў/џ?ш las@ў џ londonpop tsџ@‘@“Ј@—€@›Ш@ 2@Ѓv@Ів@Њ@ЎR@АЊ@Бг@БН@Б’@Б8ў start@œ$ end@ž, deltat@$ўўUџёџ&џіџ@@ў@$ўPџ@0/џ?рў+џ,џ@-џ?р A (1629-1939)Aџў џ"џџ?№?мЬЬЬЬЬЭўџџ@ЬЬЬЬЬЭ@ffffff@ЬЬЬЬЬЭ?ё™™™™™šў1џ ўгџ windowђџјџ@œРљџ@hў)џ Year3џ n!џџ@Бјў2џ Deaths; Population in 1000sўUџіџPџ@0/џ?рўтџ@.џ&џ'џ(џ?№@ўў@@ў/џ?шѕџ@ў+џ,џ@-џ?р B (1841-1881)Aџўџџџ ў:џўў;џўў g2.4aџ ?function(width=3.25, height=3.25, pointsize=c(8,4), device=""){ ; if(device!="") hardcopy(width=width, height=height, : color=F, pointsize=pointsize, 9 trellis=TRUE, device=device) # lset(list(superpose.symbol= < list(col=c("gray","black"), pch=c(16,16)), ! superpose.line= 8 list(col=c("gray","black"), lty=1:2))) 8 ## Specify after opening any new graphics device C here <- ais$sport %in% c("Field","Swim","T_400m","T_Sprnt") I gph <- xyplot(ht ~ wt | sport, groups=sex, subset=here, data=ais, E auto.key=list(columns=2), type=c("p","smooth"),  span=1.0) / print(gph) A ## The parameter "span" controls the extent of smoothing.  if(device!="")dev.off()  }ў§ џ@  џ@ =џџ@ @ўџ ўџџџџ ўџ џ џ џ џ?џ5џ=џ=џ>џ џџўў lsetRџ superpose.symbolRџOџџ gray blackўPџџ@0@0ўў superpose.lineRџOџџ gray blackў lty(џ?№@ўўўў џџ %in% џ ais sportўџ Field Swim T_400m T_Sprntўўў џsџFџGџ htIџ wtџўўMџџ subsetџџџКџRџTџ@ў_џџ p smoothў`џ?№ўўZџsџўџџџ ў:џўўў g2.5џ function(device=""){ < if(device!="")hardcopy(device=device, width=2, height=2) G 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)) xyrange <- range(milk) S plot(four ~ one, data = milk, xlim = xyrange, ylim = xyrange, pch = 16, cex=.6) rug(milk$one, ticksize=0.04) + rug(milk$four, side = 2, ticksize=0.04)  abline(0, 1)  if(device!="")dev.off()  }ў§џ ўџџџџ ўџџџ џ@ џ@ўў џ џ џџџ@ffffff@ffffff?ё™™™™™š?ё™™™™™šўџџ@?шў pty sўўџ џ џўў џ xyrangeџ milkўўгџGџ four oneўџ џџ џ!џ џPџ@0/џ?у333333ў rug џ џ џў ticksize?ЄzсGЎ{ў џ џ џ џў,џ@џ?ЄzсGЎ{ў abline?№ўџџџ ў:џўўў g2.6џ "function(df=fruitohms, device=""){ - if(device!="")hardcopy(width=4, height=2, ) device=device) F oldpar<-par(mar=c(4.1,3.6, 1.6, 0.6), mgp=c(2.5, 0.75,0), pty="s", " oma=c(0,1.1,0,1.1)  )  on.exit(par(oldpar))  par(mgp=c(2.75,1,0))  par(mfrow=c(1,2)) I plot(ohms~juice, data=df, cex=0.8, xlab="Apparent juice content (%)", , ylab="Resistance (kOhm)", yaxt="n") ( mtext(side=3, line=0.25, "A", adj=0) 1 axis(2, at=(1:5)*2000, labels=paste((1:5)*2)) F plot(ohms~juice,data=df,cex=0.8,xlab="Apparent juice content (%)",  ylab="",yaxt="n") ( mtext(side=3, line=0.25, "B", adj=0) 1 axis(2, at=(1:5)*2000, labels=paste((1:5)*2)) F lines(lowess(fruitohms$juice,fruitohms$ohms), lwd=2, col="gray40")  if(device!="")dev.off()  }ў§ df fruitohmsџ ўџџџџ ўџ џ@ џ@џџўў џ џ џџџ@ffffff@ ЬЬЬЬЬЭ?љ™™™™™š?у333333ўџџ@?шўџ sДџџ?ё™™™™™š?ё™™™™™šўўўџ џ џўў џџџ@?№ўў џЕџџ?№@ўўгџGџ ohms juiceўџџ/џ?щ™™™™™š)џ Apparent juice content (%)2џ Resistance (kOhm)3џ nў+џ,џ@-џ?а AAџўтџ@.џ&џ'џ(џ?№@ўў@Ÿ@ўфџ‹џ&џ'џ(џ?№@ўў@ўўўгџGџџџўџџ/џ?щ™™™™™š)џ Apparent juice content (%)2џ 3џ nў+џ,џ@-џ?а BAџўтџ@.џ&џ'џ(џ?№@ўў@Ÿ@ўфџ‹џ&џ'џ(џ?№@ўў@ўўў8џ lowess џџџў џџџўў lwd@Oџ gray40ўџџџ ў:џўўў g2.7џ# >function(dset = Animals, show = "lines", device="", color = F) {  library(MASS)  data(Animals) + if(device!="")hardcopy(width=4, height=2, ' device=device) : oldpar <- par(mfcol = c(1, 2), mar = c(3.1,3.1,2.1,3.1), # oma=c(0,1.1,0,1.1), 0 mgp = c(2.25, 0.65, 0), pty="s")  on.exit(par(oldpar)) - fig1txt <- paste("(a) Untransformed scale") 6 fig2txt <- paste("(b) Logarithmic scale, both axes") " xlab <- "Body weight (kg x 100)"  ylab <- "Brain weight (g)"  dset$body <- dset$body/100 C plot(dset$body, dset$brain, xlab = xlab, ylab = ylab, type = "n")  points(dset$body, dset$brain) & mtext(side=3, line=1, "A", adj=-0.1) I eqscplot(log10(dset$body), log10(dset$brain), pch = 1, axes = F, xlab =  xlab, ylab = ylab) & mtext(side=3, line=1, "B", adj=-0.1) / xpos <- sort(unique(round(log10(dset$body)))) 7 ypos <- sort(unique(round(log10(c(0.1,dset$brain)))))  lab <- paste(10^xpos)  par(cex=0.85) ) axis(1, at = xpos, label = lab,cex=.75)  axis(3, at = xpos)  axis(4, at = ypos)  par(mgp = c(2.5, 0.75, 0)) @ axis(2, at = ypos, label = paste(10^ypos, sep = ""), srt = 90) 1 mtext(side = 3, line = 2, "log10(Body weight)") 2 mtext(side = 4, line = 2, "log10(Brain weight)")  box()  if(device!="")dev.off() }ў§Мџ Animals show linesџ ?џ5џўџџ MASSўџџўџџџ ўџ џ@ џ@џџўў џ џ џ mfcolџ?№@ўџџ@ЬЬЬЬЬЭ@ЬЬЬЬЬЭ@ЬЬЬЬЬЭ@ЬЬЬЬЬЭўДџџ?ё™™™™™š?ё™™™™™šўџџ@?фЬЬЬЬЬЭўџ sўўџ џ џўў џ fig1txt‹џ (a) Untransformed scaleўў џ fig2txt‹џ (b) Logarithmic scale, both axesўў џ)џ Body weight (kg x 100)ў џ2џ Brain weight (g)ў џ џМџ bodyўџ џМџџў@Yўўгџ џМџџў џМџ brainў)џ)џ2џ2џ_џ nўUџ џМџџў џМџџўў+џ,џ@-џ?№ AAџBџ?Й™™™™™šўў eqscplotєџ џМџџўўєџ џМџџўўPџ?№ъџ5џ)џ)џ2џ2џў+џ,џ@-џ?№ BAџBџ?Й™™™™™šўў џ xpos sortџ–џєџ џМџџўўўўўў џ€џ"џџ–џєџџ?Й™™™™™š џМџџўўўўўўў џ lab‹џ”џ@$!џўўў џ/џ?ы333333ўтџ?№.џ!џ label#џ/џ?шўтџ@.џ!џўтџ@.џ€џў џџџ@?шўўтџ@.џ€џ$џ‹џ”џ@$€џўŒџ ўпџ@V€ў+џ,џ@-џ@ log10(Body weight)ў+џ,џ@-џ@ log10(Brain weight)ў boxўџџџ ў:џўўў g2.8џ #function(dset = cuckoos, device="") { 1 if(device!="")hardcopy(width=3.75, height=3.75, I device=device, trellis=TRUE, pointsize=c(10, 7)) > ## Two lattice graphs on one page: data frame cuckoos (DAAG)  library(lattice)  library(grid) @ trellis.par.set(layout.heights=list(key.top=0.5, axis.top=0.6, ) bottom.padding=0.25))  attach(cuckoos) nam <- levels(cuckoos$species) ! splitnam <- strsplit(nam,"\\.") > newnam <- sapply(splitnam, function(x)if(length(x)==1)x else ) paste(x,collapse=" ")) E cuckoos.strip <- stripplot(species ~ length, xlab="", data=cuckoos, ? legend=list(top=list(fun=textGrob, T args=list(label="A", x=0, just="left")))) , print(cuckoos.strip, position=c(0,.5,1,1)) A cuckoos.bw <- bwplot(species~length, xlab="Length of egg (mm)", $ data=cuckoos, : legend=list(top=list(fun=textGrob, O args=list(label="B", x=0, just="left")))) : print(cuckoos.bw, newpage=FALSE, position=c(0,0,1,.5))  detach(cuckoos)  if(device!="")dev.off() invisible() }ў§Мџ cuckoosџ ўПџ IРџђТџ native.encУџAбрУРФџ POSIXt POSIXctўХџ /tmp/johnm.g2.8.RЦџ /Users/johnm/r/ch2ўўФџ srcfileўФџ srcrefў Рџ(џФџ srcrefў Рџ(џФџ srcrefў   )Рџ(џФџ srcrefў   Рџ(џФџ srcrefў   Рџ(џФџ srcrefў   !Рџ(џФџ srcrefў )Рџ(џФџ srcrefў TРџ(џФџ srcrefў ,Рџ(џФџ srcrefў NРџ(џФџ srcrefў 8Рџ(џФџ srcrefў Рџ(џФџ srcrefў Рџ(џФџ srcrefў  Рџ(џФџ srcrefўРџ(џўџџџџ ўџ џ@ џ@џџ>џ =џџ@$@ўўўџ latticeўџ gridў trellis.par.set layout.heightsRџ key.top?р axis.top?у333333 bottom.padding?аўўџ'џў џ namVџ џ'џ speciesўўў џ splitnam strsplit0џ \.ўў џ newnam}џ2џxџyџћўџџЭџyџў?№ўyџ‹џyџ collapse  ўў !function(x)if(length(x)==1)x else ( paste(x,collapse=" ")ўўў џ cuckoos.strip stripplotGџ1џЭџў)џ џ'џ legendRџиџRџ fun textGrob argsRџ$џ Ayџ just leftўўўўўZџ6џ[џџ?р?№?№ўў џ cuckoos.bw bwplotGџ1џЭџў)џ Length of egg (mm)џ'џ8џRџиџRџ9џ:џ;џRџ$џ Byџ<џ leftўўўўўZџ=џ\џ [џџ?№?рўў9џ'џўџџџ ў:џўў;џўў g2.9џ: function(device=""){ K if(device!="")hardcopy(width=5, height=4.5, color=FALSE, device=device, 5 trellis=TRUE, pointsize=8) E Jobs <- stack(jobs, select = 1:6) # Column 1 first, then 2, ... 6 # The stack() function was discussed in Chapter 1 # Jobs$Year <- rep(jobs[, 7], 6) 8 names(Jobs) <- c("Number", "Province", "Year")  plot.new() M oldpar <- par(mar=c(2.6,3.6,2.6,1.6), fig=c(0,1,0.6,1), mgp=c(2.0,0.5,0))  if(device!="")par(cex=0.65)  on.exit(par(oldpar)) / mtext(side=3, line=1, "A", adj=0, cex=0.75) N par(fig=c(0,1,0,0.58), mar=c(2.6,3.6,2.6,1.6), mgp=c(2.0,0.5,0), new=TRUE) / mtext(side=3, line=1, "B", adj=0, cex=0.75)  library(DAAG) 5 jobts <- ts(jobs[,1:6], start=1995, frequency=12)  ylim <- range(jobts) ) ylim <- ylim+diff(ylim)*c(-0.02,0.05) A par(fig=c(0.21,0.79,0.58,1),new=TRUE, mar=c(2.6,3.6,2.6,1.6),  mgp=c(2.0,0.5,0)) J plot(jobts, plot.type="single", xlim=c(1995,1997.4), lty=1:5, log="y", F xaxt="n", xlab="", ylab="Number of Jobs", ylim=ylim, bty="l") O ylast <- bounce(window(jobts, 1996+11/12), d=1.25*strheight("O"), log=TRUE) K text(rep(1996+11/12,6), ylast, colnames(ylast), pos=4, xpd=T, cex=0.85) D datlab <- format(seq(from=as.Date("1Jan1995", format="%d%b%Y"), 9 by="3 month", length=8), "%b%Y") 9 axis(1, at=seq(from=1995, by=0.25, length=8), datlab)  par(oldpar) par(mar=rep(0,4), tcl=-0.25, ' mgp=c(1.5,0.5,0), cex.axis=0.6) ' par(fig=c(0.775,1,0,.55), new=TRUE)  nums <- Jobs$Number  lognums <- log(nums)  ylim <- range(lognums) ) ylim <- ylim+diff(ylim)*c(-0.05,0.05) 7 # plot.new() ! plot.window(c(0,1),ylim=ylim)  popval <- (1:5)*1000  logval <- log(popval)  chw <- par()$cxy[1]  chh <- par()$cxy[2]  xmid <- 0.575 I axis(2, at=logval, pos=xmid-0.01, labels=round(log(popval),2), las=2) ; axis(4, at=logval, pos=xmid+0.01, labels=popval, las=2)  par(xpd=TRUE) D text(xmid+0.5*chw, logval[5]+0.75*chh, "Number", adj=0, cex=0.6) I text(xmid-0.5*chw, logval[5]+0.75*chh, "log(Number)", adj=1, cex=0.6) % Jobs <- stack(jobs, select = 1:6) " Jobs$Year <- rep(jobs[, 7], 6) 2 names(Jobs) <- c("Number", "Province", "Year") : xy <- xyplot(log(Number) ~ Year|Province, data = Jobs, < scales = list(y = list(relation = "sliced", ; tick.number=4, cex=0.75)), 5 type = "l", layout=c(3,2), cex=0.45, 2 par.strip.text = list(cex = 0.7)) 8 print(xy, position=c(0,0,0.775,0.55), newpage=FALSE)  if(device!="")dev.off()  }ў§џ ўПџ- 5РџђТџ native.encУџAбрӘ€Фџ POSIXt POSIXctўХџ /tmp/johnm.g2.9.RЦџ /Users/johnm/r/ch2ўўФџ srcfileўФџ srcrefў %Рџ@џФџ srcrefў "Рџ@џФџ srcrefў 2Рџ@џФџ srcrefў   Рџ@џФџ srcrefў   MРџ@џФџ srcrefў   Рџ@џФџ srcrefў   Рџ@џФџ srcrefў   /Рџ@џФџ srcrefў NРџ@џФџ srcrefў /Рџ@џФџ srcrefў Рџ@џФџ srcrefў 5Рџ@џФџ srcrefў Рџ@џФџ srcrefў )Рџ@џФџ srcrefў Рџ@џФџ srcrefў FРџ@џФџ srcrefў OРџ@џФџ srcrefў KРџ@џФџ srcrefў 9Рџ@џФџ srcrefў 9Рџ@џФџ srcrefў Рџ@џФџ srcrefў 'Рџ@џФџ srcrefў   'Рџ@џФџ srcrefў !!Рџ@џФџ srcrefў ""Рџ@џФџ srcrefў ##Рџ@џФџ srcrefў $$)Рџ@џФџ srcrefў &&!Рџ@џФџ srcrefў ''Рџ@џФџ srcrefў ((Рџ@џФџ srcrefў ))Рџ@џФџ srcrefў **Рџ@џФџ srcrefў ++Рџ@џФџ srcrefў ,,IРџ@џФџ srcrefў --;Рџ@џФџ srcrefў ..Рџ@џФџ srcrefў //DРџ@џФџ srcrefў 00IРџ@џФџ srcrefў 11%Рџ@џФџ srcrefў 22"Рџ@џФџ srcrefў 332Рџ@џФџ srcrefў 482Рџ@џФџ srcrefў 998Рџ@џФџ srcrefў ::Рџ@џФџ srcrefўРџ@џўџџџџ ўџ џ@ џ@?џ џџ>џ =џ@ ўў џ Jobs stack jobs select(џ?№@ўўў џ џAџ YearўЄџџCџћ@ў@ўў џ namesAџўџ Number Province Yearўў@џў џ џ џџџ@ЬЬЬЬЬЭ@ ЬЬЬЬЬЭ@ЬЬЬЬЬЭ?љ™™™™™šў"џџ?№?у333333?№ўџџ@?рўўўџџџ ў џ/џ?фЬЬЬЬЬЭўўџ џ џўў+џ,џ@-џ?№ AAџ/џ?шў џ"џџ?№?т\(ѕТўџџ@ЬЬЬЬЬЭ@ ЬЬЬЬЬЭ@ЬЬЬЬЬЭ?љ™™™™™šўџџ@?рў1џ ў+џ,џ@-џ?№ BAџ/џ?шўџџў џ jobtsїџџCџћ(џ?№@ўўјџ@Ÿ, frequency@(ўў џ!џџGџўў џ!џ%џ!џ&џжџ!џўџBџ?”zсGЎ{ў?Љ™™™™™šўўўў џ"џџ?ЪсGЎzс?щGЎzсH?т\(ѕТ?№ў1џ џџ@ЬЬЬЬЬЭ@ ЬЬЬЬЬЭ@ЬЬЬЬЬЭ?љ™™™™™šўџџ@?рўўгџGџ plot.type singleџџ@Ÿ,@Ÿ5™™™™šўџ(џ?№@ўёџ y xaxt n)џ 2џ Number of Jobs!џ!џщџ lў џ ylast bounceћџGџ%џ@Ÿ0џ@&@(ўўў d&џ?є strheight Oўўёџ ўў0џЄџ%џ@Ÿ0џ@&@(ўў@ўKџ colnamesKџў pos@bџ7џ/џ?ы333333ў џ datlabчџ seq from as.Date 1Jan1995чџ %d%b%Yў by 3 monthЭџ@ ў %b%Yўўтџ?№.џRџSџ@Ÿ,Uџ?аЭџ@ ўQџў џ џў џџЄџ@ў tclBџ?аўџџ?ј?рўmџ?у333333ў џ"џџ?шЬЬЬЬЬЭ?№?с™™™™™šў1џ ў џ nums џAџ Numberўў џ lognumsёџWџўў џ!џџYџўў џ!џ%џ!џ&џжџ!џўџBџ?Љ™™™™™šў?Љ™™™™™šўўўўзџџ?№ў!џ!џў џ popval&џ'џ(џ?№@ўў@@ўў џ logvalёџZџўў џоџџ џ џўнџў?№ўў џЎџџ џ џўнџў@ўў џ xmid?тffffffўтџ@.џ[џPџBџ\џ?„zсGЎ{ўфџ–џёџZџў@ўѕџ@ўтџ@.џ[џPџ%џ\џ?„zсGЎ{ўфџZџѕџ@ў џbџ ў0џ%џ\џ&џ?роџўў%џџ[џ@ў&џ?шЎџўў NumberAџ/џ?у333333ў0џBџ\џ&џ?роџўў%џџ[џ@ў&џ?шЎџўў log(Number)Aџ?№/џ?у333333ў џAџBџCџDџ(џ?№@ўўў џ џAџEџўЄџџCџћ@ў@ўў џFџAџўџ Number Province Yearўў џЂџFџGџёџXџўIџEџ ProvinceўўџAџ scalesRџXџRџ relation sliced tick.number@/џ?шўў_џ lƒџџ@@ў/џ?мЬЬЬЬЬЭ par.strip.textRџ/џ?цffffffўўўZџЂџ[џџ?шЬЬЬЬЬЭ?с™™™™™šў\џ ўџџџ ў:џўўў gdumpџ 7function(fnam=NULL, prefix="~/r-book/ed2/figures/figs",  splitchar="/ch"){  if(is.null(fnam)){  path <- getwd() 7 pathtag <- strsplit(path, "/ch", fixed=TRUE)[[1]] 5 fnam <- paste(prefix, pathtag[length(pathtag)], ! ".R", sep="")  } - else fnam <- paste(prefix, fnam, sep="/") H objnames <- c(objects(pattern="^g", envir=sys.frame(0)), "hardcopy") & cat("\nDump to file:", fnam, "\n")  print(objnames)  dump(objnames, fnam)  }ў§ fnamў prefix ~/r-book/ed2/figures/figs splitchar /chўџџˆџcџўџ џџ getwdўў џ pathtagЌџ3џџ /ch fixed ў?№ўў џcџ‹џdџџgџЭџgџўў .RŒџ ўўў џcџ‹џdџcџŒџ /ўўў џ objnamesџ objects pattern ^g envir sys.frameўў hardcopyўў cat  Dump to file:cџ  ўZџiџў dumpiџcџўў gfileџ& 5function(width=3.75, height=3.75, color=F, trellis=F, H 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" D ## 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) G prefix1 <- paste(if(nchar(dotsplit[1])==1)"0" else "", dotsplit[1],  sep="") G prefix2 <- paste(if(nchar(dotsplit[2])==1)"0" else "", dotsplit[2],  sep="") 6 if(device=="")stop("No device has been specified") 3 suffix <- switch(device, ps=".eps", pdf=".pdf") = fnam <- paste("~/r-book/second/Art/",prefix1,"-",prefix2, ! suffix, sep="")  print(fnam)  dev.out <- device[1] 6 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) L 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, C width=width, height=height, pointsize=pointsize[1])  }  }ў§ џ@ џ@?џ5џ>џ5џџџ  pdf psўџ =џџ@ @ўлџ5џўџџ‡џ>џў џ=џџ=џ?№ўўў џ funtxt sys.call?№ўў џcџџЌџ3џЩџqџў (hџ7џў?№ў?№ўў џ dotsplitЌџ3џcџ \.ў?№ўў џџsџ?№ў substringџsџ?№ў@ўў џ prefix1‹џџџ ncharџsџ?№ўў?№ў 0 ўџsџ?№ўŒџ ўў џ prefix2‹џџџvџџsџ@ўў?№ў 0 ўџsџ@ўŒџ ўўџџџ ў stop No device has been specifiedўў џ suffixЮџџ ps .eps pdf .pdfўў џcџ‹џ ~/r-book/second/Art/uџ -wџyџŒџ ўўZџcџў џ dev.outџџ?№ўў џ dev.funЮџ|џ{џ{џzџ postscriptўўџ>џџџ)џў trellis.device filecџџ}џ?џ?џ џ џ џ џлџлџў+џ fontsizeRџ0џџ=џ?№ўUџџ=џ@ўўўўџџ|џ ўџZџџ џ џўў}џ€џcџ paper special enc MacRomanлџлџ џ џ џ џ=џџ=џ?№ўўўўўў gfocus.demoџ$ function(device=""){  library(lattice)  library(grid) Q if(device!="")hardcopy(device=device, width=4, height=2.25, trellis=TRUE, ' color=TRUE) H trellis.par.set(layout.heights=list(key.top=0.25, axis.top=0.5)) H hp1.plt1 <- xyplot(o2 ~ wattsPerKg, groups=id, data=humanpower1, 9 panel=function(x,y,subscripts,groups,...){ ' u <- lm(y~groups*x); # hat <- fitted(u) 9 panel.superpose(x,y,subscripts,groups) E panel.superpose(x,hat,subscripts,groups, type="l")  }, F## key=simpleKey(text=rep("",5), lines=TRUE, columns=5), ) xlab="Watts per kilogram", K ylab=expression("Oxygen intake ("*ml.min^{-1}*.kg^{-1}*")"), N legend=list(top=list(fun=textGrob, args=list(label="A", x=0)))) / print(hp1.plt1, position=c(0,0,.535,1)) J u <- lme(o2 ~ wattsPerKg, random=~wattsPerKg|id, data=humanpower1) H hp1.plt2 <- xyplot(o2 ~ wattsPerKg, groups=id, data=humanpower1, 9 panel=function(x,y,subscripts,groups,...){ ' u <- lm(y~groups*x); # hat <- fitted(u) E panel.superpose(x,hat,subscripts,groups, type="l")  }, 2 xlab="Watts per kilogram", ylab="", N 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() H panel.superpose(x=arglist$x,y=hat,subscripts=arglist$subscripts, A groups=arglist$groups, , type="l", lty=2) ! trellis.unfocus()  if(device!="")dev.off()  }ў§џ ўџџ)џўџ*џўџџџ ўџџџ џ@ џ@>џ ?џ ўў+џ,џRџ-џ?а.џ?рўў џ hp1.plt1FџGџ o2 wattsPerKgўMџ idџ humanpower1wџxџyџћXџћ subscriptsћMџћzџћўџ џ]џ lmGџXџ&џMџyџўўўў џ hat fitted]џўў panel.superposeyџXџŠџMџўŽџyџŒџŠџMџ_џ lўў $function(x,y,subscripts,groups,...){ ' u <- lm(y~groups*x); # hat <- fitted(u) 9 panel.superpose(x,y,subscripts,groups) E panel.superpose(x,hat,subscripts,groups, type="l")  }ў)џ Watts per kilogram2џ expression&џ&џ&џ Oxygen intake (”џ ml.minџBџ?№ўўўў”џ .kgџBџ?№ўўўў )ўў8џRџиџRџ9џ:џ;џRџ$џ AyџўўўўўZџ…џ[џџ?сИQы…?№ўў џ]џ lmeGџ†џ‡џў randomGџIџ‡џˆџўўџ‰џўў џ hp1.plt2FџGџ†џ‡џўMџˆџџ‰џwџxџyџћXџћŠџћMџћzџћўџ џ]џ‹џGџXџ&џMџyџўўўў џŒџџ]џўўŽџyџŒџŠџMџ_џ lўў $function(x,y,subscripts,groups,...){ ' u <- lm(y~groups*x); # hat <- fitted(u) E panel.superpose(x,hat,subscripts,groups, type="l")  }ў)џ Watts per kilogram2џ 8џRџиџRџ9џ:џ;џRџ$џ Byџўўўўў џŒџџ]џўўZџ”џ[џџ?нТ\(ѕУ?№?№ў\џ ў trellis.focus panel row?№ column?№ў џ arglist trellis.panelArgsўўŽџyџ џ˜џyџўXџŒџŠџ џ˜џŠџўMџ џ˜џMџўћ_џ lџ@ў trellis.unfocusўџџџ ў:џўўў gsaveџ 7function(fnam=NULL, prefix="~/r-book/ed2/figures/figs", K splitchar="/ch", xtras=c("renum.fun","renum.files","hardcopy")){  if(is.null(fnam)){  path <- getwd() 7 pathtag <- strsplit(path, "/ch", fixed=TRUE)[[1]] 5 fnam <- paste(prefix, pathtag[length(pathtag)], % ".RData", sep="")  } - else fnam <- paste(prefix, fnam, sep="/") C objnames <- c(objects(pattern="^g", envir=sys.frame(0)), xtras) & cat("\nDump to file:", fnam, "\n")  print(objnames) " save(list=objnames, file=fnam)  }ў§cџўdџ ~/r-book/ed2/figures/figseџ /ch xtrasџ renum.fun renum.files hardcopyўўџџˆџcџўџ џџfџўў џgџЌџ3џџ /chhџ ў?№ўў џcџ‹џdџџgџЭџgџўў .RDataŒџ ўўў џcџ‹џdџcџŒџ /ўўў џiџџjџkџ ^glџmџўўœџўўnџ  Dump to file:cџ  ўZџiџў saveRџiџ€џcџўў gtestџ function(){ / trellis.device(postscript, file="test.eps") 5 trellis.par.set(layout.heights=list(key.top=0.5)) 6 zz.d <- dotplot(variety ~ yield, data = barley, B legend=list(top=list(fun=grid.text, I args=list(label="ABC", x=0)))) 4 pushViewport(viewport(layout=grid.layout(2, 1))) , pushViewport(viewport(layout.pos.row=1))  print(zz.d,newpage=FALSE)  upViewport() , pushViewport(viewport(layout.pos.row=2))  print(zz.d, newpage=FALSE)  popViewport(2) dev.off()  }ў§ўџџ~џ€џ test.epsў+џ,џRџ-џ?рўў џ zz.dtџGџ varietyvџўџ barley8џRџиџRџ9џ grid.text;џRџ$џ ABCyџўўўўў pushViewport viewportƒџ grid.layout@?№ўўўЃџЄџ layout.pos.row?№ўўZџŸџ\џ ў upViewportўЃџЄџІџ@ўўZџŸџ\џ ў popViewport@ў:џўў renum.funџ Dfunction(from.prefix="g", to.prefix="g",from=20:7, to=21:8, doit=F){  path <- getwd() 5 pathtag <- strsplit(path, "/ch", fixed=TRUE)[[1]] & endbit <- pathtag[length(pathtag)] 5 from.prefix <- paste(from.prefix, endbit, sep="") 1 to.prefix <- paste(to.prefix, endbit, sep="")  for(i in 1:length(to)) M {txt<-paste(to.prefix,".",to[i]," <- ", from.prefix,".",from[i],sep="") 7 if(doit)eval(parse(text=txt),envir=sys.frame(0))  print(txt)  }  }ў§ from.prefix g to.prefix gSџ(џ@4@ў to(џ@5@ ў doit5џўџ џџfџўў џgџЌџ3џџ /chhџ ў?№ўў џ endbitџgџЭџgџўўў џЊџ‹џЊџЎџŒџ ўў џЋџ‹џЋџЎџŒџ ўў forЉџ(џ?№ЭџЌџўўџ џ txt‹џЋџ .џЌџЉџў  <- Њџ .џSџЉџўŒџ ўўџ­џ eval parse0џАџўlџmџўўўZџАџўўўў renum.filesџ Hfunction(from.prefix="~/r-book/ed2/Art/", to.prefix="~/r-book/ed2/Art/", ' from=20:7, to=21:8, doit=F){  path <- getwd() 5 pathtag <- strsplit(path, "/ch", fixed=TRUE)[[1]] & endbit <- pathtag[length(pathtag)] 2 if(nchar(endbit)==2)chap <- paste(endbit) else $ chap <- paste("0",endbit,sep="") 8 from.prefix <- paste(from.prefix, chap, "-", sep="") 4 to.prefix <- paste(to.prefix, chap, "-", sep="")  for(i in 1:length(from)){ 8 if (from[i]<=9) ltext <- paste("0",from[i],sep="") " else ltext <- paste(from[i]) 4 if (to[i]<=9) rtext <- paste("0",to[i],sep="") , else rtext <- paste(to[i]) 8 txt<-paste("mv ", from.prefix, ltext, ".eps", " ", 2 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)  }  }ў§Њџ ~/r-book/ed2/Art/Ћџ ~/r-book/ed2/Art/$Sџ(џ@4@ў$Ќџ(џ@5@ ў$­џ5џўџ џџfџўў џgџЌџ3џџ /chhџ ў?№ўў џЎџџgџЭџgџўўўџџvџЎџў@ў џ chap‹џЎџўў џДџ‹џ 0ЎџŒџ ўўў џЊџ‹џЊџДџ -Œџ ўў џЋџ‹џЋџДџ -Œџ ўўЏџЉџ(џ?№ЭџSџўўџџ <=џSџЉџў@"ў џ ltext‹џ 0џSџЉџўŒџ ўў џЖџ‹џџSџЉџўўўўџЕџџЌџЉџў@"ў џ rtext‹џ 0џЌџЉџўŒџ ўў џЗџ‹џџЌџЉџўўўў џАџ‹џ mv ЊџЖџ .eps  ЋџЗџ .epsŒџ ўў џ backup‹џ cp ЊџЖџ .eps   archiveŒџ ўўџ­џ systemИџўўџ­џЙџАџўўZџИџўZџАџўўўўџџ4 =function(width=3.75, height=3.75, color=FALSE, trellis=FALSE, < device=c("","pdf","ps"), path=getwd(), file=NULL, D format=c("nn-nn", "name"), split="\\.", pointsize=c(8,4),  fonts=NULL,  horiz=FALSE, ...){ ) if(!trellis)pointsize <- pointsize[1]  funtxt <- sys.call(1) B nam <- strsplit(as.character(funtxt), "(", fixed=TRUE)[[1]][1] 3 suffix <- switch(device, ps=".eps", pdf=".pdf") N if(is.character(path) & nchar(path)>1 & substring(path, nchar(path))!="/") & path <- paste(path, "/", sep="") - if(is.null(file)) if(format[1]=="nn-nn"){ C if(!is.null(split))dotsplit <- strsplit(nam, split)[[1]] else  dotsplit <- nam 8 if(length(dotsplit)==1)dotsplit <- c("", dotsplit) E nn2 <- paste(if(nchar(dotsplit[2])==1)"0" else "", dotsplit[2],  sep="")  if(nchar(dotsplit[1])>0){ O numstart <- which(unlist(strsplit(dotsplit[1], "")) %in% paste(0:9))[1] / nn1 <- substring(dotsplit[1], numstart) G nn1 <- paste(if(nchar(nn1) == 1) "0" else "", nn1, "-", sep="")  } else nn1 <- "" % file <- paste(nn1, nn2, sep="")  } else file <- nam L 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] 6 dev.fun <- switch(dev.out, pdf=pdf, ps=postscript)  if(trellis){  library(lattice)  if(device=="ps") 1 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, D color = color, width=width, height=height, ...) R trellis.par.set(list(fontsize=list(text=pointsize[1], points=pointsize[2]))) } else  if (dev.out!=""){  print(c(width, height))  if(device=="ps") F dev.fun(file=file, paper="special", horiz=horiz, fonts=fonts, M width=width, height=height, pointsize=pointsize[1], ...) else 6 dev.fun(file=file, paper="special", fonts=fonts, L width=width, height=height, pointsize=pointsize[1], ...)  } D if(trellis)trellis.par.set(list(fontsize=list(text=pointsize[1], < points=pointsize[2])))  }ў§ џ@ џ@?џ >џ џџ  pdf psўџfџў€џўчџџ nn-nn nameў~џ \.=џџ@ @ў fontsўлџ zџћўПџ  )РџђТџ native.encУџAбрТŽФџ POSIXt POSIXctўХџ /tmp/johnm.hardcopy.RЦџ /Users/johnm/r/ch2ўўФџ srcfileўФџ srcrefў РџЛџФџ srcrefў   BРџЛџФџ srcrefў   3РџЛџФџ srcrefў   &РџЛџФџ srcrefў  РџЛџФџ srcrefў РџЛџФџ srcrefў -РџЛџФџ srcrefў :РџЛџФџ srcrefў РџЛџФџ srcrefў 6РџЛџФџ srcrefў  2РџЛџФџ srcrefў 34<РџЛџФџ srcrefўРџЛџўџџ‡џ>џў џ=џџ=џ?№ўўў џqџrџ?№ўў џ0џџЌџ3џЩџqџў (hџ ў?№ў?№ўў џyџЮџџzџ .eps{џ .pdfўўџ &Мџ is.characterџў >vџџў?№ўўџtџџvџџўў /ўў џџ‹џџ /Œџ ўўўџˆџ€џўџџџчџ?№ў nn-nnўПџ РџЛџФџ srcrefў 8РџЛџФџ srcrefў РџЛџФџ srcrefў РџЛџФџ srcrefў %РџЛџФџ srcrefўРџЛџўџџ‡џˆџ~џўў џsџЌџ3џ0џ~џў?№ўў џsџ0џўўџџЭџsџў?№ў џsџџ sџўўў џ nn2‹џџџvџџsџ@ўў?№ў 0 ўџsџ@ўŒџ ўўџОџvџџsџ?№ўўўПџ  OРџЛџФџ srcrefў  /РџЛџФџ srcrefў  GРџЛџФџ srcrefўРџЛџўџ џ numstartџ whichџ unlist3џџsџ?№ў ўў‹џ(џ@"ўўўў?№ўў џ nn1tџџsџ?№ўРџўў џУџ‹џџџvџУџў?№ў 0 ўУџ -Œџ ўўў џУџ ўў џ€џ‹џУџПџŒџ ўўў џ€џ0џўўўџМџОџvџ€џў@ўџtџ€џ%џBџvџ€џўvџyџўў?№ўўyџўў џyџ ўў џ€џ‹џџ€џyџŒџ ўўZџ‹џ Output will be directed to file:€џўў џ|џџџ?№ўў џ}џЮџ|џ{џ{џzџ~џўўџ>џПџ !!РџЛџФџ srcrefў "'DРџЛџФџ srcrefў ))RРџЛџФџ srcrefўРџЛџўџџ)џўџџџ psўџ€џ€џџ}џ?џ?џлџлџКџКџ џ џ џ џzџўџ€џ€џџ}џКџКџ?џ?џ џ џ џ џzџўў+џRџџRџ0џџ=џ?№ўUџџ=џ@ўўўўўџџ|џ ўПџ ,,РџЛџФџ srcrefў -1FРџЛџФџ srcrefўРџЛџўџZџџ џ џўўџџџ psў}џ€џ€џ‚џ specialлџлџКџКџ џ џ џ џ=џџ=џ?№ўzџў}џ€џ€џ‚џ specialКџКџ џ џ џ џ=џџ=џ?№ўzџўўўўўџ>џ+џRџџRџ0џџ=џ?№ўUџџ=џ@ўўўўўўў