RDX2 X   g12.1 source function(device=""){  library(lattice) 4 if(device!="") hardcopy(width=4.25, height=4.25, > device=device, trellis=T, color=T)  library(DAAG); data(possum)  colr <- c("red","blue")  pchr <- c(3,4,0,8,2,10,1) ( ss <- expand.grid(site=1:7, sex=1:2) 1 ss$sexsite <- paste(ss$sex, ss$site, sep="-") 6 sexsite <- paste(possum$sex, possum$site, sep="-") = print(splom(~ possum[, c(9:11)], panel = panel.superpose, J groups = sexsite, col = colr[ss$sex], pch = pchr[ss$site], 9 varnames=c("tail\nlength","foot\nlength", ' "ear conch\nlength"), 3 key = list(points = list(pch=pchr), G text=list(c("Cambarville","Bellbird","Whian Whian ", J "Byrangery", "Conondale ","Allyn River","Bulburin")), 0 columns=4, cex=.75, between=1, 8 between.columns=2), cex=.65, main=""))  if(device!="")dev.off()  } device  srcref  -- srcfile encoding native.enc timestampAҳJ> class POSIXt POSIXct filename ~/r-book/ed2/figures/figs99.R wd /Users/johnm/r/ch99  srcfile  srcref ..  srcref /0>>  srcref 11  srcref 11  srcref 22  srcref 33  srcref 44((  srcref 5511  srcref 6666  srcref 7?88  srcref @@  srcref { library lattice if !=  hardcopy width@ height@ trellis T color  DAAG data possum <- colr c red blue pchr@@@ @@$? ss expand.grid site :?@ sex!?@ $ sexsite paste#"#  sep -$%#"# & - print splom ~ [!@"@& panel panel.superpose groups$ col*#" pch*#  varnames tail length foot length ear conch length key list points2/ text2 Cambarville Bellbird Whian Whian  Byrangery Conondale  Allyn River Bulburin columns@ cex? between? between.columns@6? main   dev.off g12.11 /function(device="",path = "~/r-book/ed2/Art/"){ ? if(device!="") hardcopy(width=5.25, height=2.75, trellis=F, C color=TRUE, pointsize=8, device=device, & path=path) 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()  }  path ~/r-book/ed2/Art/  D/D///  srcref EG&&  srcref HI??  srcref JJ  srcref KK  srcref PS  srcref V[11  srcref \\  srcref ]]  srcref  @@ F  pointsize@ << oldpar par mar@ffffff@ @? mgp@? mfrow?@ oma?333333?񙙙 pty s on.exit@? attach golubInfo scoreplot scorelist tissue.mfB.scores cl.circle prefix A: B-cell subset - xlab Discriminant function 1 ylab Discriminant function 2 adj.titleIJ BMonly.scoresL tissue.mfB circle %in%R BM:f BM:m params2S26?. pink cyan326?N Discriminant function 1O M B: BM samples -P detachH : g12.2 function(device=""){  library(lattice)  library(DAAG) 2 if(device!="") hardcopy(width=4.5, height=4.5, > device=device, trellis=T, color=T)  pchr <- c(3,4,0,8,2,10,1) 2 colr <- trellis.par.get()$superpose.symbol$col B print(cloud(earconch~taill+footlgth, data=possum, groups=site, # pch=pchr, cex=.65, # ## x=0.05, y=0.93, % key = list(columns=4, G cex=.9, between=1, points = list(pch=pchr, col=colr), G text=list(c("Cambarville","Bellbird","Whian Whian ", J "Byrangery", "Conondale ","Allyn River","Bulburin")), & between.columns=2)))  if(device!="")dev.off()  }  aa  srcref bb  srcref cc  srcref de>>  srcref ff  srcref gg22  srcref ho&&  srcref pp  srcref    @@@@@ @@$?## trellis.par.get superpose.symbol.' cloud) earconch + taill footlgth- /6?125@6?7?32/.42 Cambarville Bellbird Whian Whian  Byrangery Conondale  Allyn River Bulburin8@ : g12.3 code5 <- "points((1:13)*0.48, rep(1.5,13), pch=plotchars)" code6 <- J "text((1:13)*0.48, rep(1.75,13), paste(plotchars), pos=1, cex=0.75)" ! text(1, 2.25, code4.5, adj=0)  text(1, 2.0, code5, adj=0)  text(1, 1.75, code6, adj=0)  plotchars <- 13:25 4 points((1:13)*0.48, rep(0.25,13), pch=plotchars) B text((1:13)*0.48, rep(0.25,13), paste(13:25), pos=1, cex=0.75) ! code7 <- "plotchars <- 13:25" : code8 <- "## Now rerun the previous two lines of code"  text(1, 0.75, code7, adj=0)  text(1, 0.5, code8, adj=0)  if(device!="")dev.off()  }   GG  srcref HI00  srcref JJ99  srcref KK  srcref LM99  srcref OP99  srcref QQ  srcref SSCC  srcref TT..  srcref UU**  srcref VV66  srcref XXAA  srcref YYCC  srcref ZZ  srcref [[  srcref ]]  srcref ^^33  srcref __EE  srcref ``""  srcref aa>>  srcref bcJJ  srcref dd!!  srcref ee  srcref ff  srcref gg  srcref hh44  srcref iiBB  srcref jj!!  srcref kk::  srcref ll  srcref mm  srcref nn  srcref  >@@@?@A\#@A -??k@k?F@? plot!?@ rep@@6!?@.!?@/!@ xlim?@ ylim@N O  code1 1plot(1:6, rep(4.5, 6), cex=1:6, col=1:6, pch=0:5,4?@p adj code2 0xlim=c(1, 6.5), ylim=c(0,5.4), xlab="", ylab="")4\? strwidth plot(@rq abc a b c d e f4!?@m@@ labelst6!?@.!?@ code3 &abc <- c("a", "b", "c", "d", "e", "f") code4 4text(1:6,rep(3.25, 6), labels=abc, cex=1:6, col=1:6)4?@vq4?@ wq plotchars!@(3 * (!?@*?޸Qm?@*/x4yz!?@*?޸Qm?@*%x pos?6? code4.5 plotchars <- 0:12 code5 /points((1:13)*0.48, rep(1.5,13), pch=plotchars) code6 Btext((1:13)*0.48, rep(1.75,13), paste(plotchars), pos=1, cex=0.75)4?@|q4?@}q4??~qx!@*@93yz!?@*?޸Qm?@*/x4yz!?@*?޸Qm?@*%!@*@9{?6? code7 plotchars <- 13:25 code8 +## Now rerun the previous two lines of code4??q4??q : g99.2 2function(device="", path="~/r-book/ed2/plateArt/") {  library(limma) : if(device!="")hardcopy(width=5.8, height=7.6, path=path, 9 device=device, pointsize=c(9,5)) 2 xplot(data=sweep(nMA$M,2,c(-1,1,-1,1,-1,1),"*"), ! images=1:6, mfrow=c(3,2), 2 legend = c("1", "1A (dyeswap of 1)", "2", 9 "2A (dyeswap of 2)", "3", "3A (dyeswap of 3)"), C FUN=function(z,layout)imageplot(z,layout,legend=F, xlab="", % low="yellow3", high="blue", mar=c(.3,.6,1.4,.50)))  if(device!="")dev.off() invisible() } < ~/r-book/ed2/plateArt/ ss  srcref tt  srcref uv99  srcref w}    srcref ~~  srcref     srcref   limma @333333@ffffff<<>@"@ xplot sweep# nMA M@k??k??k?? * images!?@C@@ legend 1 1A (dyeswap of 1) 2 2A (dyeswap of 2) 3 3A (dyeswap of 3) FUN function z layout imageplot=N  low yellow3 high blueA?333333?333333?ffffff? 7function(z,layout)imageplot(z,layout,legend=F, xlab="", % low="yellow3", high="blue",  mar=c(.3,.6,1.4,.50)) : invisible g99.3& 5function(device="", las=1, zlim=c(0, 1), nlevels = 9, G levels = pretty(zlim, nlevels), color.palette = rgb.palette, F colpal=rev(rgb.palette(10)), path="~/r-book/ed2/plateArt/") {  library(dichromat) H rgb.palette<-colorRampPalette(c("red","orange","blue"), space="rgb")  fac <- c(0, 0.33, 0.66, 1) I if(device!="")hardcopy(width=4.5, height=2.4, device=device, path=path) & if(!exists("frogs.glm"))frogs.glm <- H glm(formula = pres.abs ~ log(distance) + log(NoOfPools) + meanmin + 1 meanmax, family = binomial, data = frogs)  nlevels <- length(levels) = mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar  on.exit(par(par.orig)) ( w <- (mar.orig[2]) * par("csi") * 2.54 8 layout(matrix(c(2, 1), nc = 2), widths = c(1, lcm(w))) % par(las = las, mgp=c(2.75, .75, 0))  mar <- c(4.6, 0.5, 1.6, 1)  par(mar = mar) plot.new() @ plot.window(xlim = c(0, 1), ylim = range(levels), xaxs = "i",  yaxs = "i") ? rect(0, levels[-length(levels)], 1, levels[-1], col = colpal) ? color.lab <- paste(levels[-nlevels], "-", levels[-1], sep="") C text(0.5, 0.5*(levels[-1]+levels[-nlevels]), color.lab, cex=0.75)  mar[2] <- 4.1  mar[4] <- 0.5  par(mar=mar)  hat <- fitted(frogs.glm) . plot(northing~easting, data=frogs, type="n", A xlab="Meters east of reference point",ylab="Meters north") / points(northing~easting, data=frogs, pch=15, 4 col=colpal[trunc(hat*nlevels)+1], cex=1.25) D points(northing~easting, data=frogs, pch=c(1,3)[frogs$pres.abs+1],  cex=0.65)  if(device!="")dev.off() invisible() }  las? zlim? nlevels@" levels pretty color.palette rgb.palette colpal rev@$< ~/r-book/ed2/plateArt/   srcref   srcref FF  srcref   srcref II  srcref 11  srcref   srcref ==  srcref   srcref ((  srcref 88  srcref %%  srcref   srcref   srcref     srcref   srcref ??  srcref ??  srcref CC  srcref   srcref   srcref   srcref   srcref AA  srcref 44  srcref   srcref   srcref     srcref   dichromat colorRampPalette red orange blue space rgb fac?Q?Q? @@333333<<c exists frogs.glm frogs.glm glm formula) pres.abs\\\ log distance NoOfPools meanmin meanmax family binomial frogs length mar.orig#z par.orig@ mar las mfrowAF@ wyyz*@@ csi@QR matrix@? nc@ widths? lcm@B@?A@ffffff???@AA plot.new plot.windown?o range xaxs i yaxs i rect*k?*k?. color.lab%*k -*k?& 4?y?z\*k?*k6?*A@@ffffff*A@?@AA hat fittedl) northing easting type nN Meters east of reference pointO Meters north3)/@..*\ truncy?6?3)/*?@\#?6? : g99.4 Afunction(df=nsw74psid1, device="",path="~/r-book/ed2/plateArt/"){ J if(device!="")hardcopy(width=4.5, height=4.5, trellis=TRUE, path=path, G device=device, pointsize=c(8,5), color=TRUE) & dsetnam <- deparse(substitute(df))  print(dsetnam) 2 offset <- round(mean(sapply(nsw74psid1[,8:10], @ function(x)unique(sort(x))[2]))) / cols <- c(rgb(0,0.5,0.5), rgb(0.65,0,0.65)) 4 trellis.par.set(superpose.symbol=list(cex=0.25), 9 superpose.line=list(lwd=2, col=cols)) 3 varlist <- c("educ","age","re74","re75","re78")  dfn <- df[, varlist] . dfn[,-(1:2)] <- log(dfn[,-(1:2)] + offset) ? lab <- c(varlist[1:2], paste("log\n", varlist[-(1:2)], "+", ) offset)) : trt <- factor(df$trt, labels=c("Control","Treatment")) E print(splom(~dfn, type=c("p","smooth"), groups=trt, varnames=lab, * auto.key=list(columns=2))) D # print(table(trt[here]))  if(device!="")dev.off()  } df nsw74psid1 < ~/r-book/ed2/plateArt/ AAAA  srcref GG  srcref &&  srcref   srcref @@  srcref //  srcref 99  srcref 33  srcref   srcref ..  srcref ))  srcref ::  srcref **  srcref   srcref  @@ <<>@ @  dsetnam deparse substitute' offset round mean sapply*!@ @$ x* unique sort@ function(x)unique(sort(x))[2] cols rgb???? trellis.par.setY26? superpose.line2 lwd@. varlist educ age re74 re75 re78 dfn**kz!?@\*kz!?@ lab*!?@% log *kz!?@ + trt factor#u Control Treatment'() p smooth-0 auto.key25@ : g99.5G Gfunction(device="",new=F, ycol = 50-(0:23)*2.1-rep(c(0, 0.5), c(8,16)), * path="~/r-book/ed2/plateArt/"){ @ if(device!="")hardcopy(width=5.8, height=6.8, device=device) ( else if(new)x11(width=6.0, height=9)  yline <- 4.2  ypmax <- ycol[1]-1.25  farleft <- -7.0 ( oldpar <- par(mar=c(0,0,0.5,0))  on.exit(par(oldpar))  par(xpd=TRUE)  library(RColorBrewer) E plot(c(-7.5,31), c(0, ypmax), type="n", xlab="", ylab="", axes=F) H plot.palette <- function(y, colr, txt=NULL, x=farleft-0.5, x0=1.75){ 7 if(is.null(txt)) txt <- deparse(substitute(colr))  num <- length(colr)  wid <- (31-x0)/num oset <- (0:(num-1))*wid+x0 + rect(oset,y-1.5,oset+wid,y, col=colr) text(x, y-0.8, txt, adj=0)  } > plot.palette(y=ycol[1], colr=palette(), "Default palette") C ## rect(oset8,ycol[1]-1.6,oset8+3.45,ycol[1], col=palette()) B ## text(farleft-0.5, ycol[1]-0.8, "Default palette", adj=0) 5 plot.palette(y=ycol[2], colr=heat.colors(12)) 8 plot.palette(y=ycol[3], colr=terrain.colors(12)) 1 plot.palette(y=ycol[4], colr=topo.colors(12)) - plot.palette(y=ycol[5], colr=rainbow(12))  chh <- par()$cxy[2] " text(farleft-0.5, ycol[6]-1.5, N "Color schemes generated by hcl(h=seq(from=0, to=360, by=30), c, l)",  adj=0) G plot.palette(y=ycol[7]-0.25, colr=hcl(h=seq(from=0, to=360, by=30), E c=55,l=75), txt= "c = 55, l = 75", $ x=farleft+2.25) G plot.palette(y=ycol[8]-0.25, colr=hcl(h=seq(from=0, to=360, by=30), E c=35,l=85), txt= "c = 35, l = 85", ( x=farleft+2.25) # text(farleft-0.5, ycol[9]-1.75, + expression(italic("RColorBrewer")* A " package, "* 'e.g. brewer.pal(12, "Set3")'), adj=0) A text(farleft+0.5, ycol[10]-1.25, "Qualitative scales", adj=0) ; plot.palette(y=ycol[11], colr=brewer.pal("Set3", n=12), 3 x=farleft+2.25, txt="Set3 (n=12)") = plot.palette(y=ycol[12], colr=brewer.pal("Paired", n=12), 5 txt="Paired (n=12)", x=farleft+2.25) ? plot.palette(y=ycol[13], colr=brewer.pal("Spectral", n=11), 7 x=farleft+2.25, txt="Spectral (n=11)") : plot.palette(y=ycol[14], colr=brewer.pal("Set1", n=9), 2 x=farleft+2.25, txt="Set1 (n=9)") = plot.palette(y=ycol[15], colr=brewer.pal("Pastel1", n=9), 5 x=farleft+2.25, txt="Pastel1 (n=9)") = plot.palette(y=ycol[16], colr=brewer.pal("Pastel2", n=8), 5 x=farleft+2.25, txt="Pastel2 (n=8)") ; plot.palette(y=ycol[17], colr=brewer.pal("Dark2",n=8), D txt="Dark2 (n=8)", x=farleft+2.25) ; plot.palette(y=ycol[18], colr=brewer.pal("Accent",n=8), 4 txt="Accent (n=8)", x=farleft+2.25) M text(farleft+0.5, ycol[19]-1.25, "Divided scales (examples only)", adj=0) ; plot.palette(y=ycol[20], colr=brewer.pal("RdGy", n=11), 3 x=farleft+2.25, txt="RdGy (n=11)") ; plot.palette(y=ycol[21], colr=brewer.pal("BrBG", n=11), 3 x=farleft+2.25, txt="BrBG (n=11)")  K text(farleft+0.5, ycol[22]-1.25, "Quantitative scales (examples only)",  adj=0) < plot.palette(y=ycol[23], colr=brewer.pal("PuBuGn", n=9), 4 x=farleft+2.25, txt="PuBuGn (n=9)") : plot.palette(y=ycol[24], colr=brewer.pal("OrRd", n=9), 2 x=farleft+2.25, txt="OrRd (n=9)")  if(device!="")dev.off()  }  new= ycolkk@Iyz!@7@m?@ @0< ~/r-book/ed2/plateArt/% ****  srcref ((  srcref   srcref   srcref   srcref ##  srcref   srcref   srcref   srcref EE  srcref   srcref >>  srcref 11  srcref 44  srcref 11  srcref --  srcref   srcref   srcref     srcref     srcref AA  srcref AA  srcref 33  srcref 55  srcref 77  srcref 22  srcref 55  srcref 55  srcref 33  srcref 44  srcref MM  srcref 33  srcref 33  srcref   srcref 44  srcref 22  srcref   srcref  @333333@333333 x11@@" yline@ ypmaxk*?? farleftk@?@A?F@?@ xpd   RColorBrewerlk@@? nN O  axes= plot.palette y txtk? x0? HHHH  srcref 77  srcref   srcref   srcref     srcref ++  srcref     srcref  is.null num wid /zk@? oset\yz!zk?k?\.4k?陙q 4function(y, colr, txt=NULL, x=farleft-0.5, x0=1.75){ 7 if(is.null(txt)) txt <- deparse(substitute(colr))  num <- length(colr)  wid <- (31-x0)/num oset <- (0:(num-1))*wid+x0 + rect(oset,y-1.5,oset+wid,y, col=colr) text(x, y-0.8, txt, adj=0)  }*? palette Default palette*@ heat.colors@(*@ terrain.colors@(*@ topo.colors@(*@ rainbow@( chh*#@ cxy@4k?k*@? BColor schemes generated by hcl(h=seq(from=0, to=360, by=30), c, l)qk*@? hcl h seq from to@v by@>@K l@R c = 55, l = 75\@k*@ ?@v@>@A@U@ c = 35, l = 85\@4k?k*@"? expressionyy italic RColorBrewer package,  e.g. brewer.pal(12, "Set3")q4\?k*@$? Qualitative scalesq*@& brewer.pal Set3 n@(\@ Set3 (n=12)*@( Paired@( Paired (n=12)\@*@* Spectral@&\@ Spectral (n=11)*@, Set1@"\@ Set1 (n=9)*@. Pastel1@"\@ Pastel1 (n=9)*@0 Pastel2@ \@ Pastel2 (n=8)*@1 Dark2@  Dark2 (n=8)\@*@2 Accent@  Accent (n=8)\@4\?k*@3? Divided scales (examples only)q*@4 RdGy@&\@ RdGy (n=11)*@5 BrBG@&\@ BrBG (n=11)4\?k*@6? #Quantitative scales (examples only)q*@7 PuBuGn@"\@ PuBuGn (n=9)*@8 OrRd@"\@ OrRd (n=9) : g99.6U 2function(device="", new=F, ycol = 47.5-(0:19)*2.1, E inc=c(3,5,10,12,13:14,18), path="~/r-book/ed2/plateArt/"){ < if(device!="")hardcopy(width=5.8, height=6.8, path=path, ) device=device) ( else if(new)x11(width=6.0, height=9) eps <- numeric(length(ycol))  eps[inc] <- 0.35  ycol <- ycol-cumsum(eps)  yline <- 4.2  ypmax <- ycol[1]-1.75  ypmin <- min(ycol)-1.25  farleft <- -6 ( oldpar <- par(mar=c(0,0,0.5,0))  on.exit(par(oldpar))  par(xpd=TRUE)  library(dichromat) G plot(c(-7,31), c(ypmin, ypmax), type="n", xlab="", ylab="", axes=F) > plot.palette <- function(y, colr, txt=NULL, x=farleft-0.5, J simulate=NULL, x0=3.5, dichrom=F, xtra=NULL){  if(is.null(txt)){ . if(is.character(colr))txt <- colr else ( txt <- deparse(substitute(colr))  } - if(dichrom)colr <- colorschemes[[colr]]  num <- length(colr)  wid <- (31-x0)/num 1 if(!is.null(xtra))wid <- (31-x0)/(num+1.25) oset <- (0:(num-1))*wid+x0  if(!is.null(simulate)){ ) colr <- dichromat(colr, simulate) : addtxt <- switch(simulate, deutan="D", protan="P") - txt <- paste(txt,": ",addtxt, sep="") < if(!is.null(xtra)) xtra <- dichromat(xtra, simulate)  } + rect(oset,y-1.5,oset+wid,y, col=colr) < if(!is.null(xtra))rect(31-wid, y-1.5, 31, y, col=xtra) text(x, y-0.8, txt, adj=0)  } # text(farleft-0.75, ycol[1]-1.0, E expression("Selected schemes from the "*italic("dichromat")* H " package, "* "e.g. colorshemes$GreentoMagenta.16"), adj=0) C plot.palette(y=ycol[2], colr="GreentoMagenta.16", dichrom=TRUE, x=farleft+0.25) @ plot.palette(y=ycol[3], colr="BluetoGreen.14", dichrom=TRUE, x=farleft+0.25) D plot.palette(y=ycol[4], colr="BluetoOrangeRed.14", dichrom=TRUE, x=farleft+0.25) ? plot.palette(y=ycol[5], colr="DarkRedtoBlue.12", dichrom=T, x=farleft+0.25) > plot.palette(y=ycol[6], colr="BluetoOrange.12", dichrom=T, x=farleft+0.25) ? plot.palette(y=ycol[7], colr="DarkRedtoBlue.12", dichrom=T, x=farleft+0.25) B plot.palette(y=ycol[8], colr="BluetoDarkOrange.12", dichrom=T, x=farleft+0.25) @ plot.palette(y=ycol[9], colr="BrowntoBlue.12", dichrom=TRUE, 6 txt="BrowntoBlue.12", x=farleft+0.25) < plot.palette(y=ycol[10], colr="BluetoGray.8", dichrom=T, x=farleft+0.25) > plot.palette(y=ycol[11], colr="BluetoOrange.8", dichrom=T, x=farleft+0.25) E plot.palette(y=ycol[12], colr="LightBluetoDarkBlue.7", dichrom=T, ! x=farleft+0.25) C plot.palette(y=ycol[13], colr="SteppedSequential.5", dichrom=T, x=farleft+0.25) $ text(farleft-0.75, ycol[14]-1.0, R "Simulation of Effects of Two Common types of Red-Green Color Blindness",  adj=0) H plot.palette(y=ycol[15], colr=c(palette()), x=farleft+0.25, x0=4.65, = xtra="green", txt="Default palette + green") H plot.palette(y=ycol[16], colr=c(palette()), x=farleft+0.25, x0=4.65, P xtra="green", txt="Default palette + green", simulate="deutan") H plot.palette(y=ycol[17], colr=c(palette()), x=farleft+0.25, x0=4.65, P txt="Default palette + green", xtra="green", simulate="protan") H plot.palette(y=ycol[18], colr="Categorical.12", dichrom=T, x0=4.65, I txt=expression("Categorical.12 "*italic("(dichromat)")), x=farleft+0.25) H plot.palette(y=ycol[19], colr="Categorical.12", dichrom=T, x0=4.65, I txt="Categorical.12", x=farleft+0.25, simulate="deutan") G plot.palette(y=ycol[20], colr="Categorical.12", dichrom=T, x0=4.65, 6 txt="Categorical.12", x=farleft+0.25, ' simulate="protan")  if(device!="")dev.off()  } =k@Gyz!@3@ inc@@@$@(!@*@,@2< ~/r-book/ed2/plateArt/$  E EEE  srcref  ((  srcref     srcref   srcref   srcref   srcref   srcref   srcref   srcref ##  srcref   srcref   srcref   srcref GG  srcref 0  srcref 13HH  srcref 45    srcref 67    srcref 89    srcref :;    srcref <=    srcref >?    srcref @A    srcref BC66  srcref DE    srcref FG    srcref HI    srcref JK    srcref LN  srcref OP==  srcref QRPP  srcref STPP  srcref VX    srcref YZII  srcref []##  srcref ^^  srcref  @333333@333333<<@@" eps numeric*?ffffffk cumsum@k*?? ypmink min?k@?@A?F@?@  lk@@? nN O =k? simulate@  dichrom= xtra  JJJJ  srcref !  srcref ""--  srcref ##  srcref $$  srcref %%11  srcref &&    srcref ',  srcref --++  srcref ..<<  srcref //    srcref    srcref   ( (  srcref  is.character [[ colorschemeszk@?czk@?z\?\yz!zk?c ''  srcref ( () )  srcref ) ): :  srcref * *- -  srcref + +< <  srcref  addtxt switch deutan D protan P% :  & ck?\.ck@?k?@?.4k?陙q *function(y, colr, txt=NULL, x=farleft-0.5, J simulate=NULL, x0=3.5, dichrom=F, xtra=NULL){  if(is.null(txt)){ . if(is.character(colr))txt <- colr else ( txt <- deparse(substitute(colr))  } - if(dichrom)colr <- colorschemes[[colr]]  num <- length(colr)  wid <- (31-x0)/num 1 if(!is.null(xtra))wid <- (31-x0)/(num+1.25) oset <- (0:(num-1))*wid+x0  if(!is.null(simulate)){ ) colr <- dichromat(colr, simulate) : addtxt <- switch(simulate, deutan="D", protan="P") - txt <- paste(txt,": ",addtxt, sep="") < if(!is.null(xtra)) xtra <- dichromat(xtra, simulate)  } + rect(oset,y-1.5,oset+wid,y, col=colr) < if(!is.null(xtra))rect(31-wid, y-1.5, 31, y, col=xtra) text(x, y-0.8, txt, adj=0)  }4k?k*??yyy Selected schemes from the  dichromat package,  "e.g. colorshemes$GreentoMagenta.16q*@ GreentoMagenta.16 \?*@ BluetoGreen.14 \?*@ BluetoOrangeRed.14 \?*@ DarkRedtoBlue.12\?*@ BluetoOrange.12\?*@ DarkRedtoBlue.12\?*@  BluetoDarkOrange.12\?*@" BrowntoBlue.12  BrowntoBlue.12\?*@$ BluetoGray.8\?*@& BluetoOrange.8\?*@( LightBluetoDarkBlue.7\?*@* SteppedSequential.5\?4k?k*@,? FSimulation of Effects of Two Common types of Red-Green Color Blindnessq*@.\?@ green Default palette + green*@0\?@ green Default palette + green deutan*@1\?@ Default palette + green green protan*@2 Categorical.12@y Categorical.12  (dichromat)\?*@3 Categorical.12@ Categorical.12\? deutan*@4 Categorical.12@ Categorical.12\? protan : g99.7U 2function(device="", new=F, ycol = 47.5-(0:19)*2.1, E inc=c(3,5,10,12,13:14,18), path="~/r-book/ed2/plateArt/"){ < if(device!="")hardcopy(width=5.8, height=6.8, path=path, ) device=device) ( else if(new)x11(width=6.0, height=9) eps <- numeric(length(ycol))  eps[inc] <- 0.35  ycol <- ycol-cumsum(eps)  yline <- 4.2  ypmax <- ycol[1]-1.75  ypmin <- min(ycol)-1.25  farleft <- -6 ( oldpar <- par(mar=c(0,0,0.5,0))  on.exit(par(oldpar))  par(xpd=TRUE)  library(dichromat) G plot(c(-7,31), c(ypmin, ypmax), type="n", xlab="", ylab="", axes=F) > plot.palette <- function(y, colr, txt=NULL, x=farleft-0.5, J simulate=NULL, x0=3.5, dichrom=F, xtra=NULL){  if(is.null(txt)){ . if(is.character(colr))txt <- colr else ( txt <- deparse(substitute(colr))  } - if(dichrom)colr <- colorschemes[[colr]]  num <- length(colr)  wid <- (31-x0)/num 1 if(!is.null(xtra))wid <- (31-x0)/(num+1.25) oset <- (0:(num-1))*wid+x0  if(!is.null(simulate)){ ) colr <- dichromat(colr, simulate) : addtxt <- switch(simulate, deutan="D", protan="P") - txt <- paste(txt,": ",addtxt, sep="") < if(!is.null(xtra)) xtra <- dichromat(xtra, simulate)  } + rect(oset,y-1.5,oset+wid,y, col=colr) < if(!is.null(xtra))rect(31-wid, y-1.5, 31, y, col=xtra) text(x, y-0.8, txt, adj=0)  } # text(farleft-0.75, ycol[1]-1.0, E expression("Selected schemes from the "*italic("dichromat")* H " package, "* "e.g. colorshemes$GreentoMagenta.16"), adj=0) C plot.palette(y=ycol[2], colr="GreentoMagenta.16", dichrom=TRUE, x=farleft+0.25) @ plot.palette(y=ycol[3], colr="BluetoGreen.14", dichrom=TRUE, x=farleft+0.25) D plot.palette(y=ycol[4], colr="BluetoOrangeRed.14", dichrom=TRUE, x=farleft+0.25) ? plot.palette(y=ycol[5], colr="DarkRedtoBlue.12", dichrom=T, x=farleft+0.25) > plot.palette(y=ycol[6], colr="BluetoOrange.12", dichrom=T, x=farleft+0.25) ? plot.palette(y=ycol[7], colr="DarkRedtoBlue.12", dichrom=T, x=farleft+0.25) B plot.palette(y=ycol[8], colr="BluetoDarkOrange.12", dichrom=T, x=farleft+0.25) @ plot.palette(y=ycol[9], colr="BrowntoBlue.12", dichrom=TRUE, 6 txt="BrowntoBlue.12", x=farleft+0.25) < plot.palette(y=ycol[10], colr="BluetoGray.8", dichrom=T, x=farleft+0.25) > plot.palette(y=ycol[11], colr="BluetoOrange.8", dichrom=T, x=farleft+0.25) E plot.palette(y=ycol[12], colr="LightBluetoDarkBlue.7", dichrom=T, ! x=farleft+0.25) C plot.palette(y=ycol[13], colr="SteppedSequential.5", dichrom=T, x=farleft+0.25) $ text(farleft-0.75, ycol[14]-1.0, R "Simulation of Effects of Two Common types of Red-Green Color Blindness",  adj=0) H plot.palette(y=ycol[15], colr=c(palette()), x=farleft+0.25, x0=4.65, = xtra="green", txt="Default palette + green") H plot.palette(y=ycol[16], colr=c(palette()), x=farleft+0.25, x0=4.65, P xtra="green", txt="Default palette + green", simulate="deutan") H plot.palette(y=ycol[17], colr=c(palette()), x=farleft+0.25, x0=4.65, P txt="Default palette + green", xtra="green", simulate="protan") H plot.palette(y=ycol[18], colr="Categorical.12", dichrom=T, x0=4.65, I txt=expression("Categorical.12 "*italic("(dichromat)")), x=farleft+0.25) H plot.palette(y=ycol[19], colr="Categorical.12", dichrom=T, x0=4.65, I txt="Categorical.12", x=farleft+0.25, simulate="deutan") G plot.palette(y=ycol[20], colr="Categorical.12", dichrom=T, x0=4.65, 6 txt="Categorical.12", x=farleft+0.25, ' simulate="protan")  if(device!="")dev.off()  } =k@Gyz!@3@@@@$@(!@*@,@2< ~/r-book/ed2/plateArt/  @333333@333333<<@@"*?ffffffk@k*??k?k@?@A?F@?@  lk@@? nN O =$$$$k?$$@ $=    zk@?czk@?z\?\yz!zk?c     D P% :  & ck?\.ck@?k?@?.4k?陙q *function(y, colr, txt=NULL, x=farleft-0.5, J simulate=NULL, x0=3.5, dichrom=F, xtra=NULL){  if(is.null(txt)){ . if(is.character(colr))txt <- colr else ( txt <- deparse(substitute(colr))  } - if(dichrom)colr <- colorschemes[[colr]]  num <- length(colr)  wid <- (31-x0)/num 1 if(!is.null(xtra))wid <- (31-x0)/(num+1.25) oset <- (0:(num-1))*wid+x0  if(!is.null(simulate)){ ) colr <- dichromat(colr, simulate) : addtxt <- switch(simulate, deutan="D", protan="P") - txt <- paste(txt,": ",addtxt, sep="") < if(!is.null(xtra)) xtra <- dichromat(xtra, simulate)  } + rect(oset,y-1.5,oset+wid,y, col=colr) < if(!is.null(xtra))rect(31-wid, y-1.5, 31, y, col=xtra) text(x, y-0.8, txt, adj=0)  }4k?k*??yyy Selected schemes from the  dichromat package,  "e.g. colorshemes$GreentoMagenta.16q*@ GreentoMagenta.16 \?*@ BluetoGreen.14 \?*@ BluetoOrangeRed.14 \?*@ DarkRedtoBlue.12\?*@ BluetoOrange.12\?*@ DarkRedtoBlue.12\?*@  BluetoDarkOrange.12\?*@" BrowntoBlue.12  BrowntoBlue.12\?*@$ BluetoGray.8\?*@& BluetoOrange.8\?*@( LightBluetoDarkBlue.7\?*@* SteppedSequential.5\?4k?k*@,? FSimulation of Effects of Two Common types of Red-Green Color Blindnessq*@.\?@ green Default palette + green*@0\?@ green Default palette + green deutan*@1\?@ Default palette + green green protan*@2 Categorical.12@y Categorical.12  (dichromat)\?*@3 Categorical.12@ Categorical.12\? deutan*@4 Categorical.12@ Categorical.12\? protan : g99.8U 2function(device="", new=F, ycol = 47.5-(0:19)*2.1, E inc=c(3,5,10,12,13:14,18), path="~/r-book/ed2/plateArt/"){ < if(device!="")hardcopy(width=5.8, height=6.8, path=path, ) device=device) ( else if(new)x11(width=6.0, height=9) eps <- numeric(length(ycol))  eps[inc] <- 0.35  ycol <- ycol-cumsum(eps)  yline <- 4.2  ypmax <- ycol[1]-1.75  ypmin <- min(ycol)-1.25  farleft <- -6 ( oldpar <- par(mar=c(0,0,0.5,0))  on.exit(par(oldpar))  par(xpd=TRUE)  library(dichromat) G plot(c(-7,31), c(ypmin, ypmax), type="n", xlab="", ylab="", axes=F) > plot.palette <- function(y, colr, txt=NULL, x=farleft-0.5, J simulate=NULL, x0=3.5, dichrom=F, xtra=NULL){  if(is.null(txt)){ . if(is.character(colr))txt <- colr else ( txt <- deparse(substitute(colr))  } - if(dichrom)colr <- colorschemes[[colr]]  num <- length(colr)  wid <- (31-x0)/num 1 if(!is.null(xtra))wid <- (31-x0)/(num+1.25) oset <- (0:(num-1))*wid+x0  if(!is.null(simulate)){ ) colr <- dichromat(colr, simulate) : addtxt <- switch(simulate, deutan="D", protan="P") - txt <- paste(txt,": ",addtxt, sep="") < if(!is.null(xtra)) xtra <- dichromat(xtra, simulate)  } + rect(oset,y-1.5,oset+wid,y, col=colr) < if(!is.null(xtra))rect(31-wid, y-1.5, 31, y, col=xtra) text(x, y-0.8, txt, adj=0)  } # text(farleft-0.75, ycol[1]-1.0, E expression("Selected schemes from the "*italic("dichromat")* H " package, "* "e.g. colorshemes$GreentoMagenta.16"), adj=0) C plot.palette(y=ycol[2], colr="GreentoMagenta.16", dichrom=TRUE, x=farleft+0.25) @ plot.palette(y=ycol[3], colr="BluetoGreen.14", dichrom=TRUE, x=farleft+0.25) D plot.palette(y=ycol[4], colr="BluetoOrangeRed.14", dichrom=TRUE, x=farleft+0.25) ? plot.palette(y=ycol[5], colr="DarkRedtoBlue.12", dichrom=T, x=farleft+0.25) > plot.palette(y=ycol[6], colr="BluetoOrange.12", dichrom=T, x=farleft+0.25) ? plot.palette(y=ycol[7], colr="DarkRedtoBlue.12", dichrom=T, x=farleft+0.25) B plot.palette(y=ycol[8], colr="BluetoDarkOrange.12", dichrom=T, x=farleft+0.25) @ plot.palette(y=ycol[9], colr="BrowntoBlue.12", dichrom=TRUE, 6 txt="BrowntoBlue.12", x=farleft+0.25) < plot.palette(y=ycol[10], colr="BluetoGray.8", dichrom=T, x=farleft+0.25) > plot.palette(y=ycol[11], colr="BluetoOrange.8", dichrom=T, x=farleft+0.25) E plot.palette(y=ycol[12], colr="LightBluetoDarkBlue.7", dichrom=T, ! x=farleft+0.25) C plot.palette(y=ycol[13], colr="SteppedSequential.5", dichrom=T, x=farleft+0.25) $ text(farleft-0.75, ycol[14]-1.0, R "Simulation of Effects of Two Common types of Red-Green Color Blindness",  adj=0) H plot.palette(y=ycol[15], colr=c(palette()), x=farleft+0.25, x0=4.65, = xtra="green", txt="Default palette + green") H plot.palette(y=ycol[16], colr=c(palette()), x=farleft+0.25, x0=4.65, P xtra="green", txt="Default palette + green", simulate="deutan") H plot.palette(y=ycol[17], colr=c(palette()), x=farleft+0.25, x0=4.65, P txt="Default palette + green", xtra="green", simulate="protan") H plot.palette(y=ycol[18], colr="Categorical.12", dichrom=T, x0=4.65, I txt=expression("Categorical.12 "*italic("(dichromat)")), x=farleft+0.25) H plot.palette(y=ycol[19], colr="Categorical.12", dichrom=T, x0=4.65, I txt="Categorical.12", x=farleft+0.25, simulate="deutan") G plot.palette(y=ycol[20], colr="Categorical.12", dichrom=T, x0=4.65, 6 txt="Categorical.12", x=farleft+0.25, ' simulate="protan")  if(device!="")dev.off()  } =k@Gyz!@3@@@@$@(!@*@,@2< ~/r-book/ed2/plateArt/  @333333@333333<<@@"*?ffffffk@k*??k?k@?@A?F@?@  lk@@? nN O =$$$$k?$$@ $=    zk@?czk@?z\?\yz!zk?c     D P% :  & ck?\.ck@?k?@?.4k?陙q *function(y, colr, txt=NULL, x=farleft-0.5, J simulate=NULL, x0=3.5, dichrom=F, xtra=NULL){  if(is.null(txt)){ . if(is.character(colr))txt <- colr else ( txt <- deparse(substitute(colr))  } - if(dichrom)colr <- colorschemes[[colr]]  num <- length(colr)  wid <- (31-x0)/num 1 if(!is.null(xtra))wid <- (31-x0)/(num+1.25) oset <- (0:(num-1))*wid+x0  if(!is.null(simulate)){ ) colr <- dichromat(colr, simulate) : addtxt <- switch(simulate, deutan="D", protan="P") - txt <- paste(txt,": ",addtxt, sep="") < if(!is.null(xtra)) xtra <- dichromat(xtra, simulate)  } + rect(oset,y-1.5,oset+wid,y, col=colr) < if(!is.null(xtra))rect(31-wid, y-1.5, 31, y, col=xtra) text(x, y-0.8, txt, adj=0)  }4k?k*??yyy Selected schemes from the  dichromat package,  "e.g. colorshemes$GreentoMagenta.16q*@ GreentoMagenta.16 \?*@ BluetoGreen.14 \?*@ BluetoOrangeRed.14 \?*@ DarkRedtoBlue.12\?*@ BluetoOrange.12\?*@ DarkRedtoBlue.12\?*@  BluetoDarkOrange.12\?*@" BrowntoBlue.12  BrowntoBlue.12\?*@$ BluetoGray.8\?*@& BluetoOrange.8\?*@( LightBluetoDarkBlue.7\?*@* SteppedSequential.5\?4k?k*@,? FSimulation of Effects of Two Common types of Red-Green Color Blindnessq*@.\?@ green Default palette + green*@0\?@ green Default palette + green deutan*@1\?@ Default palette + green green protan*@2 Categorical.12@y Categorical.12  (dichromat)\?*@3 Categorical.12@ Categorical.12\? deutan*@4 Categorical.12@ Categorical.12\? protan : 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)  } fnamM ~/r-book/ed2/figures/figs splitchar /ch cc  srcref dj--  srcref kkHH  srcref ll&&  srcref mm  srcref nn  srcref  dd  srcref ee  srcref ff77  srcref gh!!  srcref < getwd pathtag  strsplit< /ch fixed ?%M* .R& %M& / objnames objects pattern ^g envir sys.frame hardcopy cat  Dump to file:  ' 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_at dim ( 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])  }  }@@==  pdf ps< >@ @ horiz= HHHH  srcref ))  srcref   srcref @@  srcref **  srcref ,,  srcref   srcref   srcref 66  srcref 33  srcref !!  srcref   srcref   srcref 66  srcref   srcref c>*>? funtxt sys.call?*  as.character# (?? dotsplit  \.?*&? substring*&?@ prefix1% == nchar*&?? 0 *&?&  prefix2%)**&@? 0 *&@& )  stop No device has been specified suffix  ps .eps pdf .pdf% ~/r-book/second/Art/( -+-& ' dev.out*? dev.fun 0//. postscript   srcref   srcref ==  srcref LL  srcref   trellis.device file1"" fontsize24*>?3*>@0    srcref     srcref  C C  srcref '14 paper special enc MacRoman"">*>? 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)  }M ~/r-book/ed2/figures/figs /ch xtras renum.fun renum.files hardcopy KKKK  srcref --  srcref CC  srcref &&  srcref   srcref ""  srcref    srcref   srcref 77  srcref %%  srcref < < /ch ?%M* .RData& %M& / ^g9  Dump to file:  ' save24 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$!@4@$!@5@ $ doit= < < /ch ? endbit*<%<?& =%=?&  for i!? %= .*A  <- < .*A& > eval parse4' 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 ??*)*?@ chap%?E% 0?& <%<E -& =%=E -& @A!?  <=*A@" ltext% 0*A& G%*AF*A@" rtext% 0*A& H%*A% mv <G .eps  =H .eps&  backup% cp <G .eps   archive& > systemI>J'I'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/4 format nn-nn name split \.>@ @ fonts"  ...   srcref ))  srcref   srcref BB  srcref 33  srcref &&  srcref   srcref   srcref --  srcref ::  srcref   srcref 66  srcref   srcref <<  srcref c>*>?#$? nam* %# ( ??- . .eps/ .pdf &P< >*<?'<*< /<%< /& 4)*K? nn-nn ----  srcref   srcref 88  srcref   srcref   srcref %%  srcref cL& OL?&O)&?& & nn2%)**&@? 0 *&@& Q**&?   srcref  O O  srcref  / /  srcref  G G  srcref  numstart* whichT unlist*&? %!@"? nn1'*&?SV%)*V? 0 V -& V 4%VR& 4OPQ*4@)'4\k*4*-?-- 4%<4-& '% Output will be directed to file:40*?1 0//.2   srcref   srcref DD  srcref RR  srcref  ) ps3441""MMN3441MMN2524*>?3*>@0    srcref   srcref FF  srcref ') ps1446 special""MM>*>?N1446 specialMM>*>?N2524*>?3*>@