RDX2 X  g12.10 source5 :function(device="", cv1=tissue.mfB.cv, cv2=rtissue.mfB.cv, I badcv1=tissue.mfB.badcv, badcv2=rtissue.mfB.badcv, nseq=NULL){ ? if(device!="") hardcopy(width=5.25, height=2.75, trellis=F, C color=TRUE, pointsize=8, device=device) L oldpar <- par(mar=c(4.1, 3.1, 2.6, 0.1), mgp=c(2.5,0.5,0), mfrow=c(1,2), % oma=c(0,0.6,0,1.1))  on.exit(par(oldpar))  ## attach(golub.info) G ## subsetB <- cancer=="allB" & tissue.mf%in%c("BM:f","BM:m","PB:m") / ## tissue.mfB <- factor(tissue.mf[subsetB])  ## dsetB <- Golub[,subsetB] @ ## tissue.mfB.badcv <- defectiveCVdisc(dsetB, cl=tissue.mfB, 5 ## nfeatures=1:26) D ## tissue.mfB.cv <- cvdisc(dsetB, cl=tissue.mfB, nfeatures=1:26) 5 ## Accuracy measures are cv: tissue.mfB.cv$acc.cv > ## Resubstitution (red points): tissue.mfB.badcv$acc.resub 7 ## "Select once" (gray): tissue.mfB.badcv$acc.sel1  ## detach(golub.info) D ## rdsetB <- matrix(rnorm(prod(dim(dsetB))), nrow=dim(dsetB)[1]) F ## rtissue.mfB.cv <- cvdisc(rdsetB, cl=tissue.mfB, nfeatures=1:26) B ## rtissue.mfB.badcv <- defectiveCVdisc(rdsetB, cl=tissue.mfB, 5 ## nfeatures=1:26) G plot.acc <- function(cv=cv1, badcv=badcv1, nseq=NULL, badnseq=NULL, ; AB="", ylab="Predictive accuracy", * add.legend=TRUE){ @ maxg <- min(c(length(badcv$acc.resub), length(cv$acc.cv))) % if(is.null(nseq))nseq <- 1:maxg J plot(nseq, badcv$acc.resub[1:maxg], ylim=c(0,1), type="n", yaxs="i", 9 xlab="Number of features selected", ylab=ylab)  par(xpd=T) J points(nseq, badcv$acc.resub[1:maxg], col=2, type="b", lty=2, pch=0,  cex=0.8)  par(xpd=FALSE) H points(nseq, badcv$acc.sel1[1:maxg], col="gray40", pch=3, cex=0.8) O lines(lowess(nseq, badcv$acc.sel1[1:maxg], f=.325, iter=0), col="gray40",  lty=2) A points(nseq, cv$acc.cv[1:maxg], col="blue", pch=1, cex=0.8) N lines(lowess(nseq, cv$acc.cv[1:maxg], f=.325, iter=0), col="blue",lwd=2)  xy <- par()$usr[c(1,3)]  if(add.legend) . legend(xy[1], xy[2], xjust=0, yjust=0, 2 legend=c("Resubstitution accuracy", . "Defective cross-validation", ; "Cross-validation - select at each fold"), 8 lty=c(1,2,1), lwd=c(1,1,2), pch=c(0,3,1), 7 col=c("red","gray40","blue"), cex=0.875) ( mtext(side=3,line=0.35, AB, adj=0)  } B plot.acc(cv1, badcv1, AB="A: Golub data (as for Figure 12.9)") I plot.acc(cv2, badcv2, ylab="", AB="B: Random data", add.legend=FALSE)  if(device!="")dev.off()  }ў§$ device  cv1 tissue.mfB.cv cv2 rtissue.mfB.cv badcv1 tissue.mfB.badcv badcv2 rtissue.mfB.badcv nseqўў { if !=џ ў hardcopy width@ height@ trellis F color  pointsize@ џџўў <- oldpar par mar c@ffffff@ЬЬЬЬЬЭ@ЬЬЬЬЬЭ?Й™™™™™šў mgpџ@?рў mfrowџ?№@ў omaџ?у333333?ё™™™™™šўўў on.exitџџўўџ plot.acc function cvџ badcvџ џў badnseqў$ AB $ ylab Predictive accuracy$ add.legend ў џџ maxg minџ length $#џ acc.resubўў*џ+џ"џ acc.cvўўўўўџ is.null џўџ џ :?№(џўўў plot џ [+џ#џ acc.resubў-џ?№(џўў ylimџ?№ў type n yaxs i xlab Number of features selected&џ&џўџ xpd Tў points џ/џ+џ#џ acc.resubў-џ?№(џўў col@1џ b lty@ pch cex?щ™™™™™šўџ4џ ў6џ џ/џ+џ#џ acc.sel1ў-џ?№(џўў7џ gray409џ@:џ?щ™™™™™šў lines lowess џ/џ+џ#џ acc.sel1ў-џ?№(џўў f?дЬЬЬЬЬЭ iterў7џ gray408џ@ў6џ џ/џ+џ"џ acc.cvў-џ?№(џўў7џ blue9џ?№:џ?щ™™™™™šў;џ<џ џ/џ+џ"џ acc.cvў-џ?№(џўў=џ?дЬЬЬЬЬЭ>џў7џ blue lwd@ўџ xy/џ+џџў usrўџ?№@ўўўџ'џ legend/џ@џ?№ў/џ@џ@ў xjust yjustAџџ Resubstitution accuracy Defective cross-validation &Cross-validation - select at each foldў8џџ?№@?№ў?џџ?№?№@ў9џџ@?№ў7џџ red gray40 blueў:џ?ьўў mtext side@ line?жffffff%џ adjўў 7function(cv=cv1, badcv=badcv1, nseq=NULL, badnseq=NULL, ; AB="", ylab="Predictive accuracy", * add.legend=TRUE){ @ maxg <- min(c(length(badcv$acc.resub), length(cv$acc.cv))) % if(is.null(nseq))nseq <- 1:maxg J plot(nseq, badcv$acc.resub[1:maxg], ylim=c(0,1), type="n", yaxs="i", 9 xlab="Number of features selected", ylab=ylab)  par(xpd=T) J points(nseq, badcv$acc.resub[1:maxg], col=2, type="b", lty=2, pch=0,  cex=0.8)  par(xpd=FALSE) H points(nseq, badcv$acc.sel1[1:maxg], col="gray40", pch=3, cex=0.8) O lines(lowess(nseq, badcv$acc.sel1[1:maxg], f=.325, iter=0), col="gray40",  lty=2) A points(nseq, cv$acc.cv[1:maxg], col="blue", pch=1, cex=0.8) N lines(lowess(nseq, cv$acc.cv[1:maxg], f=.325, iter=0), col="blue",lwd=2)  xy <- par()$usr[c(1,3)]  if(add.legend) . legend(xy[1], xy[2], xjust=0, yjust=0, 2 legend=c("Resubstitution accuracy", . "Defective cross-validation", ; "Cross-validation - select at each fold"), 8 lty=c(1,2,1), lwd=c(1,1,2), pch=c(0,3,1), 7 col=c("red","gray40","blue"), cex=0.875) ( mtext(side=3,line=0.35, AB, adj=0)  }ўў џџџ%џ "A: Golub data (as for Figure 12.9)ў џџ џ&џ %џ B: Random data'џ ўџџџ ў dev.offўўў g12.11џ function(device=""){ ? if(device!="") hardcopy(width=5.25, height=2.75, trellis=F, C color=TRUE, pointsize=8, device=device) I oldpar <- par(mar = c(4.1, 3.6, 2.6, 0.1), mgp = c(2.25, 0.5, F 0), mfrow = c(1, 2), oma = c(0, 0.6, 0, 1.1), pty="s")  on.exit(par(oldpar))  attach(golubInfo) B ## tissue.mfB.cv <- cvdisc(dsetB, cl=tissue.mfB, nf.use=1:27) B ## tissue.mfB.scores <- A ## cvscores(cvlist = tissue.mfB.cv, B ## nfeatures = 3, ndisc = NULL, cl.other = NULL) < scoreplot(scorelist = tissue.mfB.scores, cl.circle=NULL, G prefix="A: B-cell subset -", xlab="Discriminant function 1", * ylab="Discriminant function 2",  adj.title=0)  ## BMonly.scores <- E ## cvscores(cvlist=BMonly.cv, nfeatures=11, cl.other=NULL) = scoreplot(scorelist=BMonly.scores, cl.circle=tissue.mfB, 1 circle=tissue.mfB%in%c("BM:f","BM:m"), B params=list(circle=list(cex=1.3, col=c("pink","cyan")), D points=list(cex=0.65)), xlab="Discriminant function 1",  ylab="", 1 prefix="B: BM samples -", adj.title=0)  detach(golubInfo)  if(device!="")dev.off()  }ў§$џ ў џџџџ ўџџ@џ@џџџ џ@ џџўўџџџџџ@ffffff@ ЬЬЬЬЬЭ@ЬЬЬЬЬЭ?Й™™™™™šўџџ@?рўџџ?№@ўџџ?у333333?ё™™™™™šў pty sўўџџџўў attach golubInfoў scoreplot scorelist tissue.mfB.scores cl.circleў prefix A: B-cell subset -3џ Discriminant function 1&џ Discriminant function 2 adj.titleўMџNџ BMonly.scoresPџ tissue.mfB circle %in%Tџџ BM:f BM:mўў params listUџXџ:џ?єЬЬЬЬЬЭ7џџ pink cyanўў6џXџ:џ?фЬЬЬЬЬЭўў3џ Discriminant function 1&џ Qџ B: BM samples -Rџў detachLџўџџџ ўHџўўў g12.7џ= :function(df.all=Golub, info=golubInfo, test="f", use=NULL, < m=15, device="", seed=57, new=F, offleft = -0.25, F texfrac = 0.225, colr=c("red","blue","gray40", "magenta")){ = if(device!="") hardcopy(width=4.5, height=2.5, trellis=F, @ color=T, pointsize=7, device=device)  library(MASS)  attach(golubInfo) > ## Identify allB samples for that are BM:f or BM:m or PB:m D subsetB <- cancer=="allB" & tissue.mf%in%c("BM:f","BM:m","PB:m") / tissue.mfB <- tissue.mf[subsetB, drop=TRUE]  GolubB <- Golub[, subsetB] ' G.PBf <- Golub[, tissue.mf=="PB:f" A & cancer=="allB", drop=FALSE]  detach(golubInfo)  set.seed(41) D rGolubB <- matrix(rnorm(prod(dim(GolubB))), nrow=dim(GolubB)[1]) ( rownames(rGolubB) <- rownames(Golub) A rG.PBf <- matrix(rnorm(prod(dim(G.PBf))), nrow=dim(G.PBf)[1]) L oldpar <- par(mar=c(4.1, 3.6, 2.6, 0.1), mgp=c(2.5,0.5,0), mfrow=c(1,2), 2 oma=c(0,0.6,0,1.1), pty="s")  on.exit(par(oldpar)) $ if(!is.null(seed))set.seed(seed)  ( plot2 <- function(x = GolubB, cl=cl, ' x.omit=Golub.PBf, 9 cl.omit="PB:f", ncol = length(cl), ; nfeatures=12, device = "", seed = 37, + pretext="", colr=1:3, & levnames = NULL, 8 ylab="2nd discriminant function"){  cl <- factor(cl) 2 if(!is.null(levnames))levels(cl) <- levnames + ord15 <- orderFeatures(x, cl=cl)[1:m]  dfB <- t(x[ord15, ]) ' dfB.lda <- lda(dfB, grouping=cl) + scores <- predict(dfB.lda, dimen=2)$x 8 df.PBf <- data.frame(t(x.omit[ord15, drop=FALSE])) ' colnames(df.PBf) <- colnames(dfB) 8 scores.other <- predict(dfB.lda, newdata=df.PBf)$x > scoreplot(list(scores=scores, cl=cl, other=scores.other, < cl.other=cl.omit, nfeatures=nfeatures), 2 prefix.title=pretext, adj.title=0, 8 params=list(other=list(pch=4, cex=1.5)), < xlab="1st discriminant function", ylab=ylab) ,## mtext(side=3, line=1, paste(pretext, 3## nf.use, "features"), adj=0)   } D plot2(x = GolubB, cl = tissue.mfB, x.omit=G.PBf, cl.omit="PB:f", . nfeatures=m, device = "", seed = 37, + ylab="2nd discriminant function",  colr=colr, # pretext="A: ALL B-cell:") ' plot2(x = rGolubB, cl = tissue.mfB, * x.omit=rG.PBf, cl.omit="Gp 4", . nfeatures=m, device = "", seed = 37,  colr=colr, / levnames = c("Gp 1", "Gp 2", "Gp 3"), - pretext="B: Random data:", ylab="")  if(device!="")dev.off()  }ў§ df.all Golub infoLџ test f useў m@.џ  seed@L€ newџ offleft -?аў texfrac?ЬЬЬЬЬЬЭ colrџ red blue gray40 magentaўў џџџџ ўџџ@џ@џџџ5џџ@џџўў library MASSўKџLџўџ subsetB & == cancer allBўVџ tissue.mfџ BM:f BM:m PB:mўўўўџTџ/џmџiџ drop ўўџ GolubB/џ\џћiџўўџ G.PBf/џ\џћjџkџmџ PB:fўkџlџ allBўўnџ ўўYџLџў set.seed@D€ўџ rGolubB matrix rnorm prod dimoџўўў nrow/џvџoџў?№ўўўџ rownamesrџўxџ\џўўџ rG.PBfsџtџuџvџpџўўўwџ/џvџpџў?№ўўўџџџџџ@ffffff@ ЬЬЬЬЬЭ@ЬЬЬЬЬЭ?Й™™™™™šўџџ@?рўџџ?№@ўџџ?у333333?ё™™™™™šўJџ sўўџџџўўџ !,џaџўўqџaџўўџ plot2!џ$ xoџ$ cl}џ$ x.omit Golub.PBf$ cl.omit PB:f ncol*џ}џў$ nfeatures@($џ $aџ@B€$ pretext $fџ-џ?№@ў$ levnamesў$&џ 2nd discriminant functionў џџ}џ factor}џўўџzџ,џ„џўўџ levels}џў„џўўџ ord15/џ orderFeatures|џ}џ}џў-џ?№`џўўўџ dfB t/џ|џ‡џћўўўџ dfB.lda lda‰џ grouping}џўўџ scores+џ predict‹џ dimen@ў xўўџ df.PBf data.frameŠџ/џ~џ‡џnџ ўўўўџ colnames‘џў“џ‰џўўџ scores.other+џџ‹џ newdata‘џў xўўMџXџŽџŽџ}џ}џ other”џ cl.other€џ‚џ‚џў prefix.titleƒџRџWџXџ–џXџ9џ@:џ?јўў3џ 1st discriminant function&џ&џўў function(x = GolubB, cl=cl, ' x.omit=Golub.PBf, 9 cl.omit="PB:f", ncol = length(cl), ; nfeatures=12, device = "", seed = 37, + pretext="", colr=1:3, & levnames = NULL, 8 ylab="2nd discriminant function"){  cl <- factor(cl) 2 if(!is.null(levnames))levels(cl) <- levnames + ord15 <- orderFeatures(x, cl=cl)[1:m]  dfB <- t(x[ord15, ]) ' dfB.lda <- lda(dfB, grouping=cl) + scores <- predict(dfB.lda, dimen=2)$x 8 df.PBf <- data.frame(t(x.omit[ord15, drop=FALSE])) ' colnames(df.PBf) <- colnames(dfB) 8 scores.other <- predict(dfB.lda, newdata=df.PBf)$x > scoreplot(list(scores=scores, cl=cl, other=scores.other, < cl.other=cl.omit, nfeatures=nfeatures), 2 prefix.title=pretext, adj.title=0, 8 params=list(other=list(pch=4, cex=1.5)), < xlab="1st discriminant function", ylab=ylab) ,## mtext(side=3, line=1, paste(pretext, 3## nf.use, "features"), adj=0)   }ўў{џ|џoџ}џTџ~џpџ€џ PB:f‚џ`џџ aџ@B€&џ 2nd discriminant functionfџfџƒџ A: ALL B-cell:ў{џ|џrџ}џTџ~џyџ€џ Gp 4‚џ`џџ aџ@B€fџfџ„џџ Gp 1 Gp 2 Gp 3ўƒџ B: Random data:&џ ўџџџ ўHџўўў g12.8џ function(device=""){ ? if(device!="") hardcopy(width=4.15, height=2.25, trellis=F, @ color=T, pointsize=8, device=device)  library(MASS)  ## library(multtest) N ## GolubB.maxT <- mt.maxT(GolubB,unclass(tissue.mfB)-1,test="f", B=100000) D ## Compare calculated F-statistics with permutation distribution ; oldpar <- par(mar=c(4.1,4.1,1.6,0.6), mgp=c(2.5,.75,0), ( mfrow=c(1,2), pty="s") = qqthin(qf(1-GolubB.maxT$rawp,2,28), GolubB.maxT$teststat, 4 xlab="Quantiles of permutation F-values", 7 ylab="Observed F-statistics", adj.xlab=0.55) ' mtext(side=3, line=0.5, "A", adj=0)  abline(0, 1, lty=2) F ## Compare calculated F-statistics with theoretical F-distribution 8 qqthin(qf(ppoints(7129),2,28), GolubB.maxT$teststat, > xlab="Quantiles of F - theoretical", adj.xlab=0.55, ( ylab="Observed F-statistics") ' mtext(side=3, line=0.5, "B", adj=0)  abline(0, 1, lty=2)  if(device!="")dev.off()  }ў§џ ў џџџџ ўџџ@™™™™™šџ@џџџ5џџ@ џџўўgџhџўџџџџџ@ffffff@ffffff?љ™™™™™š?у333333ўџџ@?шўџџ?№@ўJџ sўў qqthin qfdџ?№+џ GolubB.maxT rawpўў@@<ў+џœџ teststatў3џ !Quantiles of permutation F-values&џ Observed F-statistics adj.xlab?с™™™™™šўDџEџ@Fџ?р AGџў abline?№8џ@ўšџ›џ ppoints@Лйў@@<ў+џœџžџў3џ Quantiles of F - theoreticalŸџ?с™™™™™š&џ Observed F-statisticsўDџEџ@Fџ?р BGџў џ?№8џ@ўџџџ ўHџўўў g12.9џ 9function(device="", x=Golub.BM, nseq=NULL, cl=cancer.BM, L seed=29, nfeatures=c(14,10), colr = c("red", "blue", "magenta")){ M oldpar <- par(mar=c(3.6, 3.6, 2.6, 0.1), mgp=c(2.25,0.5,0), mfrow=c(1,2), 2 oma=c(0,0.6,0,0.1), pty="s")  on.exit(par(oldpar)) B if(device!="")hardcopy(width = 4.5, height = 2.5, trellis = F, ? color=T, pointsize=7, device=device) , gp.id <- divideUp(cl, nset=2, seed=seed) ; plotTrainTest(x=x, nfeatures=nfeatures, cl=cl, ylab="", $ traintest=gp.id)  if(device!="")dev.off()  }ў§$џ |џ Golub.BM џў}џ cancer.BMaџ@=‚џџ@,@$ўfџџ red blue magentaўў џџџџџџ@ ЬЬЬЬЬЭ@ ЬЬЬЬЬЭ@ЬЬЬЬЬЭ?Й™™™™™šўџџ@?рўџџ?№@ўџџ?у333333?Й™™™™™šўJџ sўўџџџўўџџџ ўџџ@џ@џџџ5џџ@џџўўџ gp.id divideUp}џ nset@aџaџўў plotTrainTest|џ|џ‚џ‚џ}џ}џ&џ  traintestЅџўџџџ ўHџўўў gdumpџ 7function(fnam=NULL, prefix="~/r-book/ed2/figures/figs", / 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)], ! ".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ўQџ ~/r-book/ed2/figures/figs splitchar /ch xtrasџ hardcopy renum.fun renum.filesўў џџ,џЋџў џџ path getwdўўџ pathtag [[ strsplitЎџ /ch fixed ў?№ўўџЋџ pasteQџ/џАџ*џАџўў .R sep ўўўџЋџДџQџЋџЕџ /ўўўџ objnamesџ objects pattern ^g envir sys.frameўў­џўў cat  Dump to file:Ћџ  ў printЖџў dumpЖџЋџўў genelistx M58459_at U91327_at X54870_at M58459_at X54870_at U91327_at M58459_at U91327_at X54870_at M58459_at L08666_at U91327_at M58459_at X00437_s_at X62654_rna1_at U29195_at U49395_at X82494_at S74221_at M58459_at U91327_at M58459_at X54870_at U91327_at M58459_at X54870_at X62654_rna1_at M58459_at X54870_at X53416_at M58459_at U91327_at X54870_at M58459_at U91327_at X54870_at M58459_at X00437_s_at X62654_rna1_at U29195_at U49395_at X82494_at M58459_at X54870_at X53416_at M58459_at L08666_at U91327_at S74221_at M58459_at U91327_at M58459_at X54870_at X62654_rna1_at M58459_at X54870_at U91327_at M58459_at X54870_at U91327_at S74221_at M58459_at U91327_at U29195_at U49395_at X82494_at M58459_at L08666_at U91327_at M58459_at U91327_at X54870_at M58459_at X54870_at U91327_at M58459_at X54870_at X62654_rna1_at M58459_at X54870_at X53416_at M58459_at U91327_at X54870_at M58459_at X54870_at U91327_at M58459_at X00437_s_at X62654_rna1_at M58459_at U91327_at X54870_at U29195_at U49395_at X82494_at M58459_at X54870_at U91327_at M58459_at L08666_at U91327_at M58459_at U91327_at X54870_at M58459_at X54870_at U91327_at M58459_at X54870_at X62654_rna1_at S74221_at M58459_at U91327_at M58459_at X54870_at X53416_at M58459_at X00437_s_at X62654_rna1_atvџ (ўLџ H'(*/01)+,-.FGHDEC78;453269:<=AB?@> "#$%& ! H†џ BM PB class factorў H€€€€€€€€€€€€€€€€€€€€€€€†џ F MПџ factorў H†џ CALGB CCG DFCI St-JudeПџ factorў H†џ BM:NA BM:f BM:m PB:NA PB:f PB:mПџ factorў H†џ allB allT amlПџ factorў names Samples BM.PB Gender Source tissue.mf cancer row.namesH 39 40 42 47 48 49 41 43 44 45 46 70 71 72 68 69 67 55 56 59 52 53 51 50 54 57 58 60 61 65 66 63 64 62 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 34 35 36 37 38 28 29 30 31 32 33Пџ data.frameўЅџ > gsaveџ 7function(fnam=NULL, prefix="~/r-book/ed2/figures/figs", L 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)  }ў§ЋџўQџ ~/r-book/ed2/figures/figsЌџ /ch­џџ hardcopy renum.fun renum.filesўў џџ,џЋџў џџЎџЏџўўџАџБџВџЎџ /chГџ ў?№ўўџЋџДџQџ/џАџ*џАџўў .RDataЕџ ўўўџЋџДџQџЋџЕџ /ўўўџЖџџЗџИџ ^gЙџКџўў­џўўЛџ  Dump to file:Ћџ  ўМџЖџў saveXџЖџ fileЋџўўџџ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])))  }ў§џ@џ@џ џ џџ  pdf psўЎџ ~/r-book/ed2/Art/Фџў formatџ nn-nn nameў split \.џџ@ @ў fontsў horiz  ...ћў srcref  ) srcfileђ encoding native.enc timestampAбрЧзРПџ POSIXt POSIXctў filename /tmp/johnm.hardcopy.R wd /Users/johnm/r/ch12xўўПџ srcfileўПџ srcrefў ЫџЬџПџ srcrefў   BЫџЬџПџ srcrefў   3ЫџЬџПџ srcrefў   &ЫџЬџПџ srcrefў  ЫџЬџПџ srcrefў ЫџЬџПџ srcrefў -ЫџЬџПџ srcrefў :ЫџЬџПџ srcrefў ЫџЬџПџ srcrefў 6ЫџЬџПџ srcrefў  2ЫџЬџПџ srcrefў 34<ЫџЬџПџ srcrefўЫџЬџў џџzџџўџџ/џџ?№ўўўџ funtxt sys.call?№ўўџ nam/џБџВџ as.characterбџў (Гџ ў?№ў?№ўўџ suffix switchџ ps .eps pdf .pdfўўџjџjџ is.characterЎџў > ncharЎџў?№ўўџ substringЎџлџЎџўў /ўўџЎџДџЎџ /Еџ ўўўџ,џФџўџkџ/џХџ?№ў nn-nnўЪџ ЫџЬџПџ srcrefў 8ЫџЬџПџ srcrefў ЫџЬџПџ srcrefў ЫџЬџПџ srcrefў %ЫџЬџПџ srcrefўЫџЬџў џџzџ,џЦџўўџ dotsplitБџВџгџЦџў?№ўўџнџгџўўџkџ*џнџў?№ўџнџџ нџўўўџ nn2Дџџkџлџ/џнџ@ўў?№ў 0 ў/џнџ@ўЕџ ўўџкџлџ/џнџ?№ўўўЪџ  OЫџЬџПџ srcrefў  /ЫџЬџПџ srcrefў  GЫџЬџПџ srcrefўЫџЬџў џџ numstart/џ whichVџ unlistВџ/џнџ?№ў ўўДџ-џ@"ўўўў?№ўўџ nn1мџ/џнџ?№ўпџўўџтџДџџkџлџтџў?№ў 0 ўтџ -Еџ ўўўџтџ ўўџФџДџтџоџЕџ ўўўџФџгџўўўџjџкџлџФџў@ўkџмџФџ +dџлџФџўлџеџўў?№ўўеџўўџеџ ўўџФџДџЎџФџеџЕџ ўўМџДџ Output will be directed to file:Фџўўџ dev.out/џџ?№ўўџ dev.funжџфџиџиџзџ postscriptўўџџЪџ !!ЫџЬџПџ srcrefў "'DЫџЬџПџ srcrefў ))RЫџЬџПџ srcrefўЫџЬџў џgџ latticeўџkџџ psў trellis.deviceФџФџџхџџџШџШџЧџЧџџџџџЩџўшџФџФџџхџЧџЧџџџџџџџЩџўў trellis.par.setXџ fontsizeXџ text/џџ?№ў6џ/џџ@ўўўўўџџфџ ўЪџ ,,ЫџЬџПџ srcrefў -1FЫџЬџПџ srcrefўЫџЬџў џМџџџџўўџkџџ psўхџФџФџ paper specialШџШџЧџЧџџџџџџ/џџ?№ўЩџўхџФџФџьџ specialЧџЧџџџџџџ/џџ?№ўЩџўўўўўџџщџXџъџXџыџ/џџ?№ў6џ/џџ@ўўўўўў 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Гџ ў?№ўўџ endbit/џАџ*џАџўўўџюџДџюџѓџЕџ ўўџяџДџяџѓџЕџ ўў for i-џ?№*џёџўў џџ txtДџяџ ./џёџѕџў  <- юџ ./џ№џѕџўЕџ ўўџђџ eval parseыџіџўЙџКџўўўМџіџўўўў 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/$№џ-џ@4@ў$ёџ-џ@5@ ў$ђџџў џџЎџЏџўўџАџБџВџЎџ /chГџ ў?№ўўџѓџ/џАџ*џАџўўўџkџлџѓџў@ўџ chapДџѓџўўџњџДџ 0ѓџЕџ ўўўџюџДџюџњџ -Еџ ўўџяџДџяџњџ -Еџ ўўєџѕџ-џ?№*џ№џўў џџ <=/џ№џѕџў@"ўџ ltextДџ 0/џ№џѕџўЕџ ўўџќџДџ/џ№џѕџўўўўџћџ/џёџѕџў@"ўџ rtextДџ 0/џёџѕџўЕџ ўўџ§џДџ/џёџѕџўўўўџіџДџ mv юџќџ .eps  яџ§џ .epsЕџ ўўџ backupДџ cp юџќџ .eps   archiveЕџ ўўџђџ systemўџўўџђџџџіџўўМџўџўМџіџўўўўў