RDX2 X  g7.1 source function(device="") { ? if(device!="")hardcopy(width=3.0, height=1.75, device=device) C 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)) A 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() }ў§ device ў { if !=џ ў hardcopy width@ height?ќџџўў <- oldpar par mar c@ffffff@ffffff?ё™™™™™š?ё™™™™™šў mgpџ@?шў las@ўў on.exit џ џўў stripchart ~ $ sugar weightўџџ trtўў pch xlab Weight (mg) ylimџ?р@ўў џ figtxt paste &Weights of sugar extracted from plantsўў catџ  ўџџџ ў dev.offўў invisibleўў g7.10џ "function(df=fruitohms, device=""){  library(monoProc) B if(device!="")hardcopy(width=2.25, height=2.25, device=device) 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)) C u <- monoproc(loess(ohms~juice, data=fruitohms), bandwidth=0.1, 2 mono1="decreasing", gridsize=30) B plot(ohms ~ juice, data=df, xlab="Apparent juice content (%)", " ylab="Resistance (ohms)") lines(u)  if(device!="")dev.off()  }ў§ df fruitohmsџ ў srcref  srcfileђ encoding native.enc timestampAбрЧЩ€ class POSIXt POSIXctў filename /tmp/johnm.g7.10.R wd /Users/johnm/r/ch7ўў(џ srcfileў(џ srcrefў B$џ%џ(џ srcrefў G$џ%џ(џ srcrefў $џ%џ(џ srcrefў 2$џ%џ(џ srcrefў   "$џ%џ(џ srcrefў   $џ%џ(џ srcrefў   $џ%џ(џ srcrefў$џ%џўџ library monoProcўџџџ ўџџ@ џ@џџўў џ џ џ џџ@ffffff@ffffff?ё™™™™™š?ё™™™™™šўџџ@?шў pty sўўџ џ џўў џ u monoproc loessџ ohms juiceў data"џў bandwidth?Й™™™™™š mono1 decreasing gridsize@>ўў plotџ1џ2џў3џ!џџ Apparent juice content (%) ylab Resistance (ohms)ў lines.џўџџџ ўџўўў g7.11џ! $function(dset = dewpoint, device="") {  require(splines) : if(device!="")hardcopy(width=4, height=2, device=device) I figtxt <- paste("Representation of dew point (dewpoint) as the sum of", J "\nan effect due to maximum temperature, and an effect", K "\ndue to minimum temperature. The dashed lines are 95%", 3 "\nconfidence bounds.", sep = "") 5 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) 9 plot(x,u.fit$fit[,1],xlab="Maximum temperature" , 1 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) 2 plot(z,u.fit$fit[,2],xlab="Minimum temperature", 1 ylab="Change from dewpoint mean",type="n")  cat(figtxt,"\n")  ord<-order(z) lines(z[ord],u.fit$fit[ord,2]) 8 lines(z[ord],u.fit$fit[ord,2]-2*u.fit$se[ord,2],lty=2) 8 lines(z[ord],u.fit$fit[ord,2]+2*u.fit$se[ord,2],lty=2)  if(device!="")dev.off() invisible() }ў§ dset dewpointџ ўџ require splinesўџџџ ўџџ@ џ@џџўў џџџ 4Representation of dew point (dewpoint) as the sum of 4 an effect due to maximum temperature, and an effect 5 due to minimum temperature. The dashed lines are 95%  confidence bounds. sep ўў џ џ џ mfrowџ?№@ў џџ@ffffff@ffffff@ЬЬЬЬЬЭ?љ™™™™™šўџџ@?шў-џ sўў џ mex?№ cex?№ўџ џ џўў џ yџ<џ dewptўў џ xџ<џ maxtempўў џ zџ<џ mintempўў џ.џ lmџCџ + bsDџ@ўHџEџ@ўўў3џ;џўў џ u.fit predict.џ type terms se Tўў7џDџ [џIџ fitўћ?№ўџ Maximum temperature8џ Change from dewpoint meanKџ nў9џDџNџџIџ fitўћ?№ўў9џDџ -NџџIџ fitўћ?№ў *@NџџIџ seўћ?№ўўў lty@ў9џDџGџNџџIџ fitўћ?№ўPџ@NџџIџ seўћ?№ўўўQџ@ў7џEџNџџIџ fitўћ@ўџ Minimum temperature8џ Change from dewpoint meanKџ nўџџ  ў џ ord orderEџўў9џNџEџRџўNџџIџ fitўRџ@ўў9џNџEџRџўOџNџџIџ fitўRџ@ўPџ@NџџIџ seўRџ@ўўўQџ@ў9џNџEџRџўGџNџџIџ fitўRџ@ўPџ@NџџIџ seўRџ@ўўўQџ@ўџџџ ўџўўџўў g7.12џ $function(dset = dewpoint, device="") { G if(device!="")hardcopy(trellis=T, width=5, height=2.5, device=device, * pointsize=c(8,6)) J figtxt <- paste("Given plots of residuals against maximum temperature,", M "\nfor different ranges of minimum temperature.", sep = "")  library(splines)  library(lattice) C ds.lm <- lm(dewpt ~ bs(maxtemp,5) + bs(mintemp,5), data=dewpoint) 9 mintempRange <- equal.count(dewpoint$mintemp, number=3) : ds.xy <- xyplot(residuals(ds.lm) ~ maxtemp|mintempRange, 9 data=dewpoint, aspect=1, layout=c(3,1), C type=c("p","smooth"), xlab="Maximum temperature", K ylab="Residual", par.strip.text=list(cex=0.75), cex=0.65)  print(ds.xy)  cat(figtxt,"\n")  if(device!="")dev.off() invisible() }ў§;џ<џџ ўџџџџ ўџ trellisMџџ@ џ@џџ pointsizeџ@ @ўўў џџџ 5Given plots of residuals against maximum temperature, - for different ranges of minimum temperature.?џ ўў+џ>џў+џ latticeў џ ds.lmFџџ dewptGџHџ maxtemp@ўHџ mintemp@ўўў3џ<џўў џ mintempRange equal.countџ<џ mintempў number@ўў џ ds.xy xyplotџ residualsXџў |Zџ\џўў3џ<џ aspect?№ layoutџ@?№ўKџџ p smoothўџ Maximum temperature8џ Residual par.strip.text listBџ?шўBџ?фЬЬЬЬЬЭўў print_џўџџ  ўџџџ ўџўўџўў g7.13џ function(device=""){ B if(device!="")hardcopy(width=2.25, height=2.25, device=device) G 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)) 1 dewpt.bdry <- default.bdry(mintemp, maxtemp)  plot(fit, bdry=dewpt.bdry) box() ) title(sub="Fitted Thin-Plate Spline")  detach(dewpoint)  if(device!="")dev.off()  }ў§џ ўџџџџ ўџџ@ џ@џџўў џ џ џ џџ@ffffff@ffffff?ё™™™™™š?ё™™™™™šўџџ@?шў-џ sўў+џ>џў+џ SemiParў attach<џў џ fit spmџYџ f[џZџўўўў џ dewpt.bdry default.bdry[џZџўў7џkџ bdrynџў boxў title sub Fitted Thin-Plate Splineў detach<џўџџџ ўџўўў g7.2џ function(device="") { 9 appletaste.aov <- aov(aftertaste ~ panelist + product, ( data=appletaste) < if(device!="")hardcopy(width=4, height=2.1, device=device) E 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)) 9 termplot(appletaste.aov, partial=TRUE, col.res="black")  if(device!="")dev.off() invisible() }ў§$џ ўџ џ appletaste.aov aovџ aftertasteGџ panelist productўў3џ appletasteўўџџџ ўџџ@ џ@ЬЬЬЬЬЭџџўў џ џ џ џџ@ffffff@ffffff?ё™™™™™š@ЬЬЬЬЬЭўџџ@?шў-џ s@џџ?№@ўўўџ џ џўў termplotvџ partial  col.res blackўџџџ ўџўўџўў g7.3џ[ 1function(dset = leaftemp, device="", cex.eq=0.65) { @ if(device!="")hardcopy(width=5.25, height=2.65, device=device) E oldpar <- par(mar = c(4.1,3.6,3.6,0.1), mgp=c(2.5,0.75,0), pty="s") H figtxt <- paste("A sequence of models fitted to the plot of tempDiff", J "\nvs vapPress, for low, medium and high levels of CO2")  on.exit(par(oldpar)) 9 options(contrasts = c("contr.treatment", "contr.poly"))  ## Needed for S-PLUS  attach(dset)  yran <- range(tempDiff) ( yran[2] <- yran[2] + diff(yran) * 0.08 2 leaf.lm1 <- lm(tempDiff ~ vapPress, data = dset) = leaf.lm2 <- lm(tempDiff ~ CO2level + vapPress, data = dset) I leaf.lm3 <- lm(tempDiff ~ CO2level + vapPress + vapPress:CO2level, data  = dset)  par(fig=c(0, 0.35, 0, 0.9)) 5 plot(vapPress, tempDiff, xlab = "Vapour Pressure", 4 ylab = "Temperature difference", ylim = yran, F pch = as.numeric(CO2level), cex=0.7, cex.axis=0.8, col="black") 9 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), G " 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) 4 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) C 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 0 lines(r1, y1, lty = 2, lwd = 1, col = "black")  y2 <- a2 + b1 * r2 0 lines(r2, y2, lty = 4, lwd = 1, col = "black")  y3 <- a3 + b1 * r3 0 lines(r3, y3, lty = 5, lwd = 1, col = "black") ' par(fig=c(0.64, 0.99, 0, 0.9), new=T) 4 plot(vapPress, tempDiff, xlab = "Vapour Pressure",  ylab = "", 0 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, 6 paste("Slopes are", round(b1, 2), round(b2,2), 7 round(b3,2), sep=", "),adj=0, cex=cex.eq)  y1 <- a1 + b1 * r1 0 lines(r1, y1, lty = 2, lwd = 1, col = "black")  y2 <- a2 + b2 * r2 0 lines(r2, y2, lty = 4, lwd = 1, col = "black")  y3 <- a3 + b3 * r3 0 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") O legend(0.5, 0.98, legend=c("low","medium","high"), lty=c(4,5,7), col="black", D 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() }ў§;џ leaftemp$џ  cex.eq?фЬЬЬЬЬЭўџџџџ ўџџ@ џ@333333џџўў џ џ џ џџ@ffffff@ ЬЬЬЬЬЭ@ ЬЬЬЬЬЭ?Й™™™™™šўџџ@?шў-џ sўў џџџ 3A sequence of models fitted to the plot of tempDiff 4 vs vapPress, for low, medium and high levels of CO2ўўџ џ џўў options contrastsџ contr.treatment contr.polyўўjџ;џў џ yran range tempDiffўў џNџ„џ@ўGџNџ„џ@ўPџ diff„џў?ДzсGЎ{ўўў џ leaf.lm1Fџџ†џ vapPressў3џ;џўў џ leaf.lm2Fџџ†џGџ CO2level‰џўў3џ;џўў џ leaf.lm3Fџџ†џGџGџ‹џ‰џў :‰џ‹џўўў3џ;џўў џ figџ?жffffff?ьЬЬЬЬЬЭўў7џ‰џ†џџ Vapour Pressure8џ Temperature differenceџ„џџ as.numeric‹џўBџ?цffffff cex.axis?щ™™™™™š col blackў mtext side@ line?њffffff A: Single line adjў џ topleftGџNџџ џў usrўџ?№@ўўPџџџOџџўўџ џў cxyўўўў џ chhPџNџџ џў cxyў@ў?рўў џ ab1џˆџ coefўў’џ“џ@”џ?шџ tempDiff = roundNџ˜џ?№ў@ў™џNџ˜џ@ў@ў x vapPress?џ ў•џ‘џ blackBџџў ablineNџ˜џ?№ўNџ˜џ@ўў џŽџџ?дzсGЎ{?хpЃз =q?ьЬЬЬЬЬЭў newMџў7џ‰џ†џџ Vapour Pressure8џ џ„џџџ‹џўBџ?цffffffџ?щ™™™™™šў’џ“џ@”џ?њffffff B: Parallel lines•џў џ a1NџџŠџ coefў?№ўў џ a2 sumNџџŠџ coefўџ?№@ўўўў џ a3žџNџџŠџ coefўџ?№@ўўўў џ b1NџџŠџ coefў@ўў’џ“џ@”џ?шџ Intercepts are:™џœџ@ў™џџ@ў™џŸџ@ў?џ , ў•џ‘џ blackBџџў’џ“џ@”џџ Slope is™џ џ@ў?џ  ў•џ‘џ blackBџџў џ r1…џ‰џ ==‹џ lowўўў џ r2…џ‰џЂџ‹џ mediumўўў џ r3…џ‰џЂџ‹џ highўўў џ y1GџœџPџ џЁџўўў9џЁџЅџQџ@ lwd?№‘џ blackў џ y2GџџPџ џЃџўўў9џЃџЇџQџ@Іџ?№‘џ blackў џ y3GџŸџPџ џЄџўўў9џЄџЈџQџ@Іџ?№‘џ blackў џŽџџ?фzсGЎ{?яЎzсGЎ?ьЬЬЬЬЬЭў›џMџў7џ‰џ†џџ Vapour Pressure8џ џ„џџџ‹џўBџ?цffffffџ?щ™™™™™šў’џ“џ@”џ?њffffff C: Separate lines•џўgџ summaryŒџўў џœџNџџŒџ coefў?№ўў џџžџNџџŒџ coefўџ?№@ўўўў џŸџžџNџџŒџ coefўџ?№@ўўўў џ џNџџŒџ coefў@ўў џ b2žџNџџŒџ coefўџ@@ўўўў џ b3žџNџџŒџ coefўџ@@ўўўў’џ“џ@”џ?шџ Intercepts are:™џœџ@ў™џџ@ў™џŸџ@ў?џ , ў•џ‘џ blackBџџў’џ“џ@”џџ Slopes are™џ џ@ў™џЊџ@ў™џЋџ@ў?џ , ў•џBџџў џЅџGџœџPџ џЁџўўў9џЁџЅџQџ@Іџ?№‘џ blackў џЇџGџџPџЊџЃџўўў9џЃџЇџQџ@Іџ?№‘џ blackў џЈџGџŸџPџЋџЄџўўў9џЄџЈџQџ@Іџ?№‘џ blackў џŽџџ?№?№ў›џMџ џ rep@ўў7џџ?№ўџ?№ў bty n axes Fџ 8џ Kџ nў legend?р?я\(ѕТ\Аџџ low medium highўQџџ@@@ў‘џ blackџџ?№@ў xjust?мЬЬЬЬЬЭ yjust?№­џ n pt.cex?ђffffff ncol@ text.width?аBџ?ы333333ўtџ;џўџџ  ў џŽџџ?№?№ўўџџџ ўџўўџўў g7.4џ function(device="") { / if(device!="")hardcopy(width=5.5, height=1.4, ' device=device) N 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)) G if(!exists("leaf.lm2"))leaf.lm2 <- lm(formula = tempDiff ~ CO2level + B vapPress, data = leaftemp) . plot(leaf.lm2,caption=c("Resids vs Fitted", 5 "Normal Q-Q", "Scale-Location", "", I "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() }ў§џ ўџџџџ ўџџ@ џ?іffffffџџўў џ џ џ џџ@ffffff@ffffff@ЬЬЬЬЬЭ?љ™™™™™šў@џџ?№@ўџџ@?рў-џ sўўџ џ џўўџ ! exists leaf.lm2ўў џŠџFџ formulaџ†џGџ‹џ‰џўў3џ€џўўў7џŠџ captionџ Resids vs Fitted Normal Q-Q Scale-Location  Resid vs Leverageў whichџџ?№@ў@ў cook.levels?ОИQы…Иў џџџ -Diagnostic plots for the parallel line model.ўўgџџўџџџ ўџўўџўў g7.5џ function(device="") { : if(device!="")hardcopy(width=2, height=2, device=device) E 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) E plot(grain ~ rate, data = seedrates, pch = 16, xlab="Seeding rate", B xlim = c(50, 160), axes=F, cex=1.4, ylab="Grains per head") J figtxt <- paste("Plot of number of grain per head versus seeding rate,", D "\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() A seedrates.lm2 <- lm(grain ~ rate + I(rate^2), data = seedrates) G 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() }ў§џ ўџџџџ ўџџ@ џ@џџўў џ џ џ џџ@ffffff@ffffff?ё™™™™™š?ё™™™™™šўџџ@?шў-џ sўўџ џ џўў=џ DAAGў3џ seedratesў7џџ grain rateў3џПџџ@0џ Seeding rate xlimџ@I@dўЎџЏџBџ?іffffff8џ Grains per headў џџџ 5Plot of number of grain per head versus seeding rate, . for the barley seeding rate data, with fitted  quadratic curve.ўў џ new.df data.frameСџPџ (џ?№@,ўў@)ўўў џ atxџПџСџўў axis?№ atЦџўЧџ@ўqџў џ seedrates.lm2FџџРџGџСџ I ^Сџ@ўўўў3џПџўў џ hat2JџЩџ newdataУџ interval predict coverage?юffffffўў9џџУџСџўNџЬџћ fitўQџ@ўџџ  ўџџџ ўџўўџўў g7.6џ! function(device="") { @ if(device!="")hardcopy(width=2.25, height=2.25, device=device) E 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)) H plot(grain ~ rate, data = seedrates, pch = 16, xlim = c(50, 175), ylim @ = c(15.5, 22),xlab="Seeding rate",ylab="Grains per head") J figtxt <- paste("Plot of number of grain per head versus seeding rate,", D "\nfor the barley seeding rate data, with fitted", $ "quadratic curve."  ) / new.df <- data.frame(rate = c((4:14) * 12.5)) 5 seedrates.lm1 <- lm(grain ~ rate, data = seedrates) A seedrates.lm2 <- lm(grain ~ rate + I(rate^2), data = seedrates) 3 pred1 <- predict(seedrates.lm1, newdata = new.df, ) interval="confidence") : hat1<-data.frame(fit=pred1[,"fit"], lower=pred1[,"lwr"], ' upper=pred1[,"upr"]) 3 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 2 lines(lowess(rate,hat1$lower),lty=1, col="gray") 3 lines(lowess(rate, hat1$upper),lty=1, col="gray") 2 lines(lowess(rate,hat2$lower),lty=2, col="gray") 3 lines(lowess(rate, hat2$upper),lty=2, col="gray")  cat("\n", figtxt, "\n")  if(device!="")dev.off() }ў§џ ўџџџџ ўџџ@ џ@џџўў џ џ џ џџ@ffffff@ffffff?ё™™™™™š?ё™™™™™šўџџ@?шў-џ sўўџ џ џўў7џџРџСџў3џПџџ@0Тџџ@I@eрўџџ@/@6ўџ Seeding rate8џ Grains per headў џџџ 5Plot of number of grain per head versus seeding rate, . for the barley seeding rate data, with fitted quadratic curve.ўў џУџФџСџџPџХџџ@@,ўў@)ўўўў џ seedrates.lm1FџџРџСџў3џПџўў џЩџFџџРџGџСџЪџЫџСџ@ўўўў3џПџўў џ pred1JџбџЭџУџЮџ confidenceўў џ hat1ФџkџNџвџћ fitў lowerNџвџћ lwrў upperNџвџћ uprўўў џ pred2JџЩџЭџУџЮџ confidenceўў џЬџФџkџNџжџћ fitўдџNџжџћ lwrўеџNџжџћ uprўўў9џџУџ rateўџгџ fitўQџ?№ў9џџУџ rateўџЬџ fitўQџ@Іџ@ў џСџџУџ rateўў9џ lowessСџџгџ lowerўўQџ?№‘џ grayў9џзџСџџгџ upperўўQџ?№‘џ grayў9џзџСџџЬџ lowerўўQџ@‘џ grayў9џзџСџџЬџ upperўўQџ@‘џ grayўџ  џ  ўџџџ ўџўўў g7.7џ9 -function(df=fruitohms, lt=c(1,2), device=""){ A if(device!="")hardcopy(width=3.5, height=3.25, device=device) H 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") 9 points(ohms ~ juice, data=df, cex=0.65, col="grey40") H mtext(side=3,line=0.5,"A: Noraml spline, 2 internal knots (df = 3)",  adj=0,at=0, cex=.75) 4 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) 0 lines(df$juice[ord],fitted(fruit.lmb1)[ord]) 1 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") 9 points(ohms ~ juice, data=df, cex=0.65, col="grey40") 4 knots <- attributes(with(df, ns(juice,4)))$knots  abline(v=knots, col="gray") H 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) 0 lines(df$juice[ord],fitted(fruit.lmb2)[ord]) 1 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") F plot(ohms~juice,data=df,cex=0.8,xlab="Apparent juice content (%)", , ylab="Resistance (ohms)", type="n") 9 points(ohms ~ juice, data=df, cex=0.65, col="grey40") J mtext(side=3,line=0.5,"C: Polynomial, degree 3", adj=0, at=0, cex=.75) 1 fruit.lmp3 <- lm(ohms~poly(juice,3), data=df) 1 fruit.lmp4 <- lm(ohms~poly(juice,4), data=df) 0 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") I 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") L mtext(side=3, line=0.5, "D: Polynomial, degree 4", at=0, adj=0, cex=.75) 1 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()  }ў§!џ"џ ltџ?№@ў$џ ў#џ0 A$џђ&џ native.enc'џAбрЧњР(џ POSIXt POSIXctў)џ /tmp/johnm.g7.7.R*џ /Users/johnm/r/ch7ўў(џ srcfileў(џ srcrefў  $џкџ(џ srcrefў $џкџ(џ srcrefў $џкџ(џ srcrefў  ,$џкџ(џ srcrefў   9$џкџ(џ srcrefў   $џкџ(џ srcrefў   4$џкџ(џ srcrefў $џкџ(џ srcrefў ,$џкџ(џ srcrefў $џкџ(џ srcrefў 0$џкџ(џ srcrefў 1$џкџ(џ srcrefў >$џкџ(џ srcrefў >$џкџ(џ srcrefў $џкџ(џ srcrefў 9$џкџ(џ srcrefў 4$џкџ(џ srcrefў $џкџ(џ srcrefў $џкџ(џ srcrefў ,$џкџ(џ srcrefў 0$џкџ(џ srcrefў 1$џкџ(џ srcrefў >$џкџ(џ srcrefў   >$џкџ(џ srcrefў !",$џкџ(џ srcrefў ##9$џкџ(џ srcrefў $$J$џкџ(џ srcrefў %%1$џкџ(џ srcrefў &&1$џкџ(џ srcrefў ''0$џкџ(џ srcrefў (($$џкџ(џ srcrefў ))$џкџ(џ srcrefў **#$џкџ(џ srcrefў ++#$џкџ(џ srcrefў ,,>$џкџ(џ srcrefў -->$џкџ(џ srcrefў ./$џкџ(џ srcrefў 009$џкџ(џ srcrefў 11L$џкџ(џ srcrefў 221$џкџ(џ srcrefў 33$$џкџ(џ srcrefў 44$џкџ(џ srcrefў 55#$џкџ(џ srcrefў 66#$џкџ(џ srcrefў 77>$џкџ(џ srcrefў 88>$џкџ(џ srcrefў 99$џкџ(џ srcrefў$џкџўџџџџ ўџџ@  џ@ џџўў џ џ џ@џџ@@ў џџ@ffffff@ffffff?љ™™™™™š?у333333ў omaџ?у333333?у333333ўџџ@?рўўўџ џ џўў=џ>џў7џџ1џ2џў3џ!џBџ?щ™™™™™šџ 8џ Resistance (ohms)Kџ nў pointsџ1џ2џў3џ!џBџ?фЬЬЬЬЬЭ‘џ grey40ў’џ“џ@”џ?р +A: Noraml spline, 2 internal knots (df = 3)•џШџBџ?шў џ knotsџ attributes with!џ ns2џ@ўўўнџўўšџ vнџ‘џ grayў џ fruit.lmb1Fџџ1џрџ2џ@ўў3џ!џўў џRџSџџ!џ2џўўў9џNџџ!џ2џўRџўNџ fittedтџўRџўў џ ciJџтџЮџ confidenceўў9џNџџ!џ2џўRџўNџфџRџ lwrўQџNџйџ@ў‘џ gray20ў9џNџџ!џ2џўRџўNџфџRџ uprўQџNџйџ@ў‘џ gray20ў7џџ1џ2џў3џ!џBџ?щ™™™™™šџ 8џ Kџ nўмџџ1џ2џў3џ!џBџ?фЬЬЬЬЬЭ‘џ grey40ў џнџџоџпџ!џрџ2џ@ўўўнџўўšџсџнџ‘џ grayў’џ“џ@”џ?р +B: Normal spline, 3 internal knots (df = 4)•џШџBџ?шў џ fruit.lmb2Fџџ1џрџ2џ@ўў3џ!џўў9џNџџ!џ2џўRџўNџуџхџўRџўў џфџJџхџЮџ confidenceўў9џNџџ!џ2џўRџўNџфџRџ lwrўQџNџйџ@ў‘џ gray20ў9џNџџ!џ2џўRџўNџфџRџ uprўQџNџйџ@ў‘џ gray20ў7џџ1џ2џў3џ!џBџ?щ™™™™™šџ Apparent juice content (%)8џ Resistance (ohms)Kџ nўмџџ1џ2џў3џ!џBџ?фЬЬЬЬЬЭ‘џ grey40ў’џ“џ@”џ?р C: Polynomial, degree 3•џШџBџ?шў џ fruit.lmp3Fџџ1џ poly2џ@ўў3џ!џўў џ fruit.lmp4Fџџ1џчџ2џ@ўў3џ!џўў9џNџџ!џ2џўRџўNџуџцџўRџўў џфџJџцџLџ ўў џ tval qt?™™™™™™šџфџ!џўўў џџфџ lwrўOџџфџkџўPџщџџфџ se.fitўўўў џџфџ uprўGџџфџkџўPџщџџфџьџўўўў9џNџџ!џ2џўRџўNџџфџыџўRџўQџNџйџ@ў‘џ gray20ў9џNџџ!џ2џўRџўNџџфџэџўRџўQџNџйџ@ў‘џ gray20ў7џџ1џ2џў3џ!џBџ?щ™™™™™šџ Apparent juice content (%)8џ Kџ nўмџџ1џ2џў3џ!џBџ?фЬЬЬЬЬЭ‘џ gray40ў’џ“џ@”џ?р D: Polynomial, degree 4Шџ•џBџ?шў9џNџџ!џ2џўRџўNџуџшџўRџўў џфџJџшџLџ ўў џщџъџ?™™™™™™šџфџ!џўўў џџфџыџўOџџфџkџўPџщџџфџьџўўўў џџфџэџўGџџфџkџўPџщџџфџьџўўўў9џNџџ!џ2џўRџўNџџфџыџўRџўQџNџйџ@ў‘џ gray20ў9џNџџ!џ2џўRџўNџџфџэџўRџўQџNџйџ@ў‘џ gray20ўџџџ ўџўўў g7.8џ "function(df=fruitohms, device=""){  require(splines) @ if(device!="")hardcopy(width=5.2, height=1.4, device=device) 7 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)) 3 plot(fruit.lmb1, caption=c("Resids vs Fitted", : "Normal Q-Q", "Scale-Location", "", O "Resids vs Leverage"), which=c(1:3,5), cook.levels=0.12) cat("\nDiagnostic plots.\n")  if(device!="")dev.off()  }ў§!џ"џџ ўџ=џ>џўџџџ ўџџ@ЬЬЬЬЬЭ џ?іffffffџџўў џ џ џ@џџ?№@ў џџ@ffffff@ffffff@ЬЬЬЬЬЭ?ё™™™™™šўџџ@?шўлџџ?№ў-џ sўўџ џ џўў џтџFџџ1џрџ2џ@ўў3џ!џўў‚џ digits@ўgџЉџтџўў7џтџКџџ Resids vs Fitted Normal Q-Q Scale-Location  Resids vs LeverageўЛџџџ?№@ў@ўМџ?ОИQы…Иўџ  Diagnostic plots. ўџџџ ўџўўў g7.9џ$ 2function(dset = fruitohms, device="", cex.eq=0.25) {  require(splines) ? if(device!="")hardcopy(width=3.25, height=2.8, device=device) 7 oldpar <- par(mfrow=c(2,2), mar=c(3.6,4.6,1.6,2.1), 9 mgp=c(2.25,.75,0),oma=c(1.1,0,1.1,0.6))  figtxt <- paste( G "Spline basis curves for the B-spline (1 knot) fit.", K "\nColumns of the X-matrix, after the first, are formed", E "\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]) K 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", E xlab="Apparent juice content (%)",ylab="Column 4 of X-matrix") > lines(fruitohms$juice[ord], model.matrix(fruit.lmb4)[ord,4]) C 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", E 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() }ў§;џ"џџ џ?аўџ=џ>џўџџџ ўџџ@  џ@ffffffџџўў џ џ џ@џџ@@ў џџ@ ЬЬЬЬЬЭ@ffffff?љ™™™™™š@ЬЬЬЬЬЭўџџ@?шўлџџ?ё™™™™™š?ё™™™™™š?у333333ўўў џџџ 2Spline basis curves for the B-spline (1 knot) fit. 5 Columns of the X-matrix, after the first, are formed / from the points shown on the respective curve.ўўџ џ џўў џ fruit.lmb4Fџџ1џHџ2џ@ўў3џ;џўў7џџ"џ juiceўNџ model.matrixёџўћ@ўKџ nџ 8џ Column 2 of X-matrixў џRџSџџ"џ juiceўўў9џNџџ"џ juiceўRџўNџђџёџўRџ@ўў’џ“џ@”џ?р A: Basis curve 1 (col. 2)•џBџ?шў7џџ"џ juiceўNџђџёџўћ@ўKџ nџ 8џ Column 3 of X-matrixў9џNџџ"џ juiceўRџўNџђџёџўRџ@ўў’џ“џ@”џ?р B: Basis curve 2 (col. 3)•џBџ?шў7џџ"џ juiceўNџђџёџўћ@ўKџ nџ Apparent juice content (%)8џ Column 4 of X-matrixў9џNџџ"џ juiceўRџўNџђџёџўRџ@ўў’џ“џ@”џ?р C: Basis curve 3 (col. 4)•џBџ?шў7џџ"џ juiceўNџђџёџўћ@ўKџ nџ Apparent juice content (%)8џ Column 5 of X-matrixў9џNџџ"џ juiceўRџўNџђџёџўRџ@ўў’џ“џ@”џ?р D: Basis curve 4 (col. 5)•џBџ?шўџџ  ўџџџ ўџўўџўў gdumpџ 7function(fnam=NULL, prefix="~/r-book/ed2/figures/figs", K xtras=c("hardcopy","renum.fun","renum.files"), 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="/") C objnames <- c(objects(pattern="^g", envir=sys.frame(0)), xtras) & cat("\nDump to file:", fnam, "\n")  print(objnames)  dump(objnames, fnam)  }ў§ fnamў prefix ~/r-book/ed2/figures/figs xtrasџ hardcopy renum.fun renum.filesў splitchar /chўџџ is.nullєџўџ џ path getwdўў џ pathtag [[ strsplitљџ /ch fixed ў?№ўў џєџџѕџNџћџ lengthћџўў .R?џ ўўў џєџџѕџєџ?џ /ўўў џ objnamesџ objects pattern ^g envir sys.frameўўіџўўџ  Dump to file:єџ  ўgџџў dumpџєџўў 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])  }  }ў§$џ@$ џ@ colorЏџUџЏџ$џџ  pdf psўљџ Vџџ@ @ў horizЏџўџџЗџUџў џVџNџVџ?№ўўў џ funtxt sys.call?№ўў џєџNџќџ§џ as.character џў (ўџMџў?№ў?№ўў џ dotsplitќџ§џєџ \.ў?№ўў џNџ џ?№ў substringNџ џ?№ў@ўў џ prefix1џџЂџ ncharNџ џ?№ўў?№ў 0 ўNџ џ?№ў?џ ўў џ prefix2џџЂџџNџ џ@ўў?№ў 0 ўNџ џ@ў?џ ўўџЂџџ ў stop No device has been specifiedўў џ suffix switchџ ps .eps pdf .pdfўў џєџџ ~/r-book/second/Art/џ -џџ?џ ўўgџєџў џ dev.outNџџ?№ўў џ dev.funџџџџџ postscriptўўџUџџ+џWџў trellis.device fileєџџџџџџџ џ џџџў trellis.par.set fontsizefџ textNџVџ?№ўмџNџVџ@ўўўўџџџ ўџgџџџ џўўџџєџ paper special enc MacRomanџџџџ џ џVџNџVџ?№ўўўўўў gsaveџ 7function(fnam=NULL, prefix="~/r-book/ed2/figures/figs", K splitchar="/ch", xtras=c("hardcopy","renum.fun","renum.files")){  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)  }ў§єџўѕџ ~/r-book/ed2/figures/figsїџ /chіџџ hardcopy renum.fun renum.filesўўџџјџєџўџ џљџњџўў џћџќџ§џљџ /chўџ ў?№ўў џєџџѕџNџћџџџћџўў .RData?џ ўўў џєџџѕџєџ?џ /ўўў џџџџџ ^gџџўўіџўўџ  Dump to file:єџ  ўgџџў savefџџџєџўўџџ4 =function(width=3.75, height=3.75, color=FALSE, trellis=FALSE, H device=c("","pdf","ps"), path="~/r-book/ed2/Art/", 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])))  }ў§$џ@$ џ@џ Uџ $џџ  pdf psўљџ ~/r-book/ed2/Art/џў formatџ nn-nn nameў split \.Vџџ@ @ў fontsўџ  ...ћў#џ  )$џђ&џ native.enc'џAбрЧзР(џ POSIXt POSIXctў)џ /tmp/johnm.hardcopy.R*џ /Users/johnm/r/ch7ўў(џ srcfileў(џ srcrefў $џ&џ(џ srcrefў   B$џ&џ(џ srcrefў   3$џ&џ(џ srcrefў   &$џ&џ(џ srcrefў  $џ&џ(џ srcrefў $џ&џ(џ srcrefў -$џ&џ(џ srcrefў :$џ&џ(џ srcrefў $џ&џ(џ srcrefў 6$џ&џ(џ srcrefў  2$џ&џ(џ srcrefў 34<$џ&џ(џ srcrefў$џ&џўџџЗџUџў џVџNџVџ?№ўўў џ џ џ?№ўў џ namNџќџ§џ џ џў (ўџ ў?№ў?№ўў џџџџџ .epsџ .pdfўўџ &(џ is.characterљџў >џљџў?№ўўџ џљџџљџўў /ўў џљџџљџ /?џ ўўўџјџџўџЂџNџ"џ?№ў nn-nnў#џ $џ&џ(џ srcrefў 8$џ&џ(џ srcrefў $џ&џ(џ srcrefў $џ&џ(џ srcrefў %$џ&џ(џ srcrefў$џ&џўџџЗџјџ#џўў џ џќџ§џ'џ#џў?№ўў џ џ'џўўџЂџџџ џў?№ў џ џџ  џўўў џ nn2џџЂџџNџ џ@ўў?№ў 0 ўNџ џ@ў?џ ўўџ*џџNџ џ?№ўўў#џ  O$џ&џ(џ srcrefў  /$џ&џ(џ srcrefў  G$џ&џ(џ srcrefў$џ&џўџ џ numstartNџЛџ %in% unlist§џNџ џ?№ў ўўџџ@"ўўўў?№ўў џ nn1 џNџ џ?№ў,џўў џ/џџџЂџџ/џў?№ў 0 ў/џ -?џ ўўў џ/џ ўў џџџ/џ+џ?џ ўўў џџ'џўўўџ(џ*џџџў@ўЂџ џџGџOџџџўџџўў?№ўўџўў џџ ўў џџџљџџџ?џ ўўgџџ Output will be directed to file:џўў џџNџџ?№ўў џџџџџџџџўўџUџ#џ !!$џ&џ(џ srcrefў "'D$џ&џ(џ srcrefў ))R$џ&џ(џ srcrefў$џ&џўџ+џWџўџЂџџ psўџџџџџџџџџ$џ$џџџ џ џ%џўџџџџџ$џ$џџџџџ џ џ%џўўџfџџfџџNџVџ?№ўмџNџVџ@ўўўўўџџџ ў#џ ,,$џ&џ(џ srcrefў -1F$џ&џ(џ srcrefў$џ&џўџgџџџ џўўџЂџџ psўџџџџ specialџџ$џ$џџџ џ џVџNџVџ?№ў%џўџџџџ special$џ$џџџ џ џVџNџVџ?№ў%џўўўўўџUџџfџџfџџNџVџ?№ўмџNџVџ@ўўўўўў 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 g fromџ@4@ў toџ@5@ ў doitЏџўџ џљџњџўў џћџќџ§џљџ /chўџ ў?№ўў џ endbitNџћџџџћџўўў џ1џџ1џ6џ?џ ўў џ2џџ2џ6џ?џ ўў for iџ?№џџ4џўўџ џ txtџ2џ .Nџ4џ8џў  <- 1џ .Nџ3џ8џў?џ ўўџ5џ eval parseџ9џўџџўўўgџ9џўўўў 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)  }  }ў§1џ ~/r-book/ed2/Art/2џ ~/r-book/ed2/Art/3џџ@4@ў4џџ@5@ ў5џЏџўџ џљџњџўў џћџќџ§џљџ /chўџ ў?№ўў џ6џNџћџџџћџўўўџЂџџ6џў@ў џ chapџ6џўў џ=џџ 06џ?џ ўўў џ1џџ1џ=џ -?џ ўў џ2џџ2џ=џ -?џ ўў7џ8џџ?№џџ3џўўџџ <=Nџ3џ8џў@"ў џ ltextџ 0Nџ3џ8џў?џ ўў џ?џџNџ3џ8џўўўўџ>џNџ4џ8џў@"ў џ rtextџ 0Nџ4џ8џў?џ ўў џ@џџNџ4џ8џўўўў џ9џџ mv 1џ?џ .eps  2џ@џ .eps?џ ўў џ backupџ cp 1џ?џ .eps   archive?џ ўўџ5џ systemAџўўџ5џBџ9џўўgџAџўgџ9џўўўўў