### R code from vignette source 'gridBase.Rnw' ################################################### ### code chunk number 1: gridBase.Rnw:81-84 ################################################### library(grid) library(gridBase) ################################################### ### code chunk number 2: basesetup (eval = FALSE) ################################################### ## midpts <- barplot(1:10, axes=FALSE) ## axis(2) ## axis(1, at=midpts, labels=FALSE) ## ################################################### ### code chunk number 3: baseviewport (eval = FALSE) ################################################### ## vps <- baseViewports() ## pushViewport(vps$inner, vps$figure, vps$plot) ## ################################################### ### code chunk number 4: gridtext (eval = FALSE) ################################################### ## grid.text(c("one", "two", "three", "four", "five", ## "six", "seven", "eight", "nine", "ten"), ## x=unit(midpts, "native"), y=unit(-1, "lines"), ## just="right", rot=60) ## popViewport(3) ## ################################################### ### code chunk number 5: gridBase.Rnw:110-114 ################################################### midpts <- barplot(1:10, axes=FALSE) axis(2) axis(1, at=midpts, labels=FALSE) vps <- baseViewports() pushViewport(vps$inner, vps$figure, vps$plot) grid.text(c("one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten"), x=unit(midpts, "native"), y=unit(-1, "lines"), just="right", rot=60) popViewport(3) ################################################### ### code chunk number 6: plotsymbol (eval = FALSE) ################################################### ## novelsym <- function(speed, temp, ## width=unit(3, "mm"), ## length=unit(0.5, "inches")) { ## grid.rect(height=length, y=0.5, ## just="top", width=width, ## gp=gpar(fill="white")) ## grid.rect(height=temp*length, ## y=unit(0.5, "npc") - length, ## width=width, ## just="bottom", gp=gpar(fill="grey")) ## grid.lines(x=0.5, ## y=unit.c(unit(0.5, "npc"), unit(0.5, "npc") + speed*length), ## arrow=arrow(length=unit(3, "mm"), type="closed"), ## gp=gpar(fill="black")) ## grid.points(unit(0.5, "npc"), unit(0.5, "npc"), size=unit(2, "mm"), ## pch=16) ## } ## ################################################### ### code chunk number 7: baseplot (eval = FALSE) ################################################### ## chinasea <- read.table(system.file("doc", "chinasea.txt", ## package="gridBase"), ## header=TRUE) ## plot(chinasea$lat, chinasea$long, type="n", ## xlab="latitude", ylab="longitude", ## main="China Sea Wind Speed/Direction and Temperature") ## ################################################### ### code chunk number 8: gridsym (eval = FALSE) ################################################### ## speed <- 0.8*chinasea$speed/14 + 0.2 ## temp <- chinasea$temp/40 ## vps <- baseViewports() ## pushViewport(vps$inner, vps$figure, vps$plot) ## for (i in 1:25) { ## pushViewport(viewport(x=unit(chinasea$lat[i], "native"), ## y=unit(chinasea$long[i], "native"), ## angle=chinasea$dir[i])) ## novelsym(speed[i], temp[i]) ## popViewport() ## } ## popViewport(3) ## ################################################### ### code chunk number 9: gridBase.Rnw:184-188 ################################################### novelsym <- function(speed, temp, width=unit(3, "mm"), length=unit(0.5, "inches")) { grid.rect(height=length, y=0.5, just="top", width=width, gp=gpar(fill="white")) grid.rect(height=temp*length, y=unit(0.5, "npc") - length, width=width, just="bottom", gp=gpar(fill="grey")) grid.lines(x=0.5, y=unit.c(unit(0.5, "npc"), unit(0.5, "npc") + speed*length), arrow=arrow(length=unit(3, "mm"), type="closed"), gp=gpar(fill="black")) grid.points(unit(0.5, "npc"), unit(0.5, "npc"), size=unit(2, "mm"), pch=16) } chinasea <- read.table(system.file("doc", "chinasea.txt", package="gridBase"), header=TRUE) plot(chinasea$lat, chinasea$long, type="n", xlab="latitude", ylab="longitude", main="China Sea Wind Speed/Direction and Temperature") speed <- 0.8*chinasea$speed/14 + 0.2 temp <- chinasea$temp/40 vps <- baseViewports() pushViewport(vps$inner, vps$figure, vps$plot) for (i in 1:25) { pushViewport(viewport(x=unit(chinasea$lat[i], "native"), y=unit(chinasea$long[i], "native"), angle=chinasea$dir[i])) novelsym(speed[i], temp[i]) popViewport() } popViewport(3) ################################################### ### code chunk number 10: gridBase.Rnw:220-225 ################################################### data(USArrests) hc <- hclust(dist(USArrests), "ave") dend1 <- as.dendrogram(hc) dend2 <- cut(dend1, h=70) ################################################### ### code chunk number 11: gridBase.Rnw:229-233 ################################################### x <- 1:4 y <- 1:4 height <- factor(round(unlist(lapply(dend2$lower, attr, "height")))) ################################################### ### code chunk number 12: gridBase.Rnw:248-260 ################################################### space <- max(unit(rep(1, 50), "strwidth", as.list(rownames(USArrests)))) dendpanel <- function(x, y, subscripts, ...) { pushViewport(viewport(y=space, width=0.9, height=unit(0.9, "npc") - space, just="bottom")) grid.rect(gp=gpar(col="grey", lwd=5)) par(plt=gridPLT(), new=TRUE, ps=10) plot(dend2$lower[[subscripts]], axes=FALSE) popViewport() } ################################################### ### code chunk number 13: gridBase.Rnw:266-273 ################################################### library(lattice) plot.new() print(xyplot(y ~ x | height, subscripts=TRUE, xlab="", ylab="", strip=function(...) { strip.default(style=4, ...) }, scales=list(draw=FALSE), panel=dendpanel), newpage=FALSE) ################################################### ### code chunk number 14: gridBase.Rnw:290-294 ################################################### counts <- c(18,17,15,20,10,20,25,13,12) outcome <- gl(3,1,9) treatment <- gl(3,3) ################################################### ### code chunk number 15: gridBase.Rnw:302-304 ################################################### oldpar <- par(no.readonly=TRUE) ################################################### ### code chunk number 16: regions (eval = FALSE) ################################################### ## pushViewport(viewport(layout=grid.layout(1, 3, ## widths=unit(rep(1, 3), c("null", "cm", "null"))))) ## ################################################### ### code chunk number 17: lattice (eval = FALSE) ################################################### ## pushViewport(viewport(layout.pos.col=1)) ## library(lattice) ## bwplot <- bwplot(counts ~ outcome | treatment) ## print(bwplot, newpage=FALSE) ## popViewport() ## ################################################### ### code chunk number 18: diagnostic (eval = FALSE) ################################################### ## pushViewport(viewport(layout.pos.col=3)) ## glm.D93 <- glm(counts ~ outcome + treatment, family=poisson()) ## par(omi=gridOMI(), mfrow=c(2, 2), new=TRUE) ## par(cex=0.5, mar=c(5, 4, 1, 2)) ## par(mfg=c(1, 1)) ## plot(glm.D93, caption="", ask=FALSE) ## popViewport(2) ## ################################################### ### code chunk number 19: multiplot ################################################### pushViewport(viewport(layout=grid.layout(1, 3, widths=unit(rep(1, 3), c("null", "cm", "null"))))) pushViewport(viewport(layout.pos.col=1)) library(lattice) bwplot <- bwplot(counts ~ outcome | treatment) print(bwplot, newpage=FALSE) popViewport() pushViewport(viewport(layout.pos.col=3)) glm.D93 <- glm(counts ~ outcome + treatment, family=poisson()) par(omi=gridOMI(), mfrow=c(2, 2), new=TRUE) par(cex=0.5, mar=c(5, 4, 1, 2)) par(mfg=c(1, 1)) plot(glm.D93, caption="", ask=FALSE) popViewport(2) ################################################### ### code chunk number 20: gridBase.Rnw:346-348 ################################################### par(oldpar) ################################################### ### code chunk number 21: gridBase.Rnw:375-379 ################################################### x <- c(0.88, 1.00, 0.67, 0.34) y <- c(0.87, 0.43, 0.04, 0.94) z <- matrix(runif(4*2), ncol=2) ################################################### ### code chunk number 22: gridBase.Rnw:386-388 ################################################### oldpar <- par(no.readonly=TRUE) ################################################### ### code chunk number 23: plot1 (eval = FALSE) ################################################### ## plot(x, y, xlim=c(-0.2, 1.2), ylim=c(-0.2, 1.2), type="n") ## ################################################### ### code chunk number 24: plot2 (eval = FALSE) ################################################### ## vps <- baseViewports() ## pushViewport(vps$inner, vps$figure, vps$plot) ## grid.segments(x0=unit(c(rep(0, 4), x), ## rep(c("npc", "native"), each=4)), ## x1=unit(c(x, x), rep("native", 8)), ## y0=unit(c(y, rep(0, 4)), ## rep(c("native", "npc"), each=4)), ## y1=unit(c(y, y), rep("native", 8)), ## gp=gpar(lty="dashed", col="grey")) ## ################################################### ### code chunk number 25: gridBase.Rnw:427-431 ################################################### maxpiesize <- unit(1, "inches") totals <- apply(z, 1, sum) sizemult <- totals/max(totals) ################################################### ### code chunk number 26: plot3 (eval = FALSE) ################################################### ## for (i in 1:4) { ## pushViewport(viewport(x=unit(x[i], "native"), ## y=unit(y[i], "native"), ## width=sizemult[i]*maxpiesize, ## height=sizemult[i]*maxpiesize)) ## grid.rect(gp=gpar(col="grey", fill="white", lty="dashed")) ## par(plt=gridPLT(), new=TRUE) ## pie(z[i,], radius=1, labels=rep("", 2)) ## popViewport() ## } ## ################################################### ### code chunk number 27: plot4 (eval = FALSE) ################################################### ## popViewport(3) ## par(oldpar) ## ################################################### ### code chunk number 28: complex ################################################### plot(x, y, xlim=c(-0.2, 1.2), ylim=c(-0.2, 1.2), type="n") vps <- baseViewports() pushViewport(vps$inner, vps$figure, vps$plot) grid.segments(x0=unit(c(rep(0, 4), x), rep(c("npc", "native"), each=4)), x1=unit(c(x, x), rep("native", 8)), y0=unit(c(y, rep(0, 4)), rep(c("native", "npc"), each=4)), y1=unit(c(y, y), rep("native", 8)), gp=gpar(lty="dashed", col="grey")) for (i in 1:4) { pushViewport(viewport(x=unit(x[i], "native"), y=unit(y[i], "native"), width=sizemult[i]*maxpiesize, height=sizemult[i]*maxpiesize)) grid.rect(gp=gpar(col="grey", fill="white", lty="dashed")) par(plt=gridPLT(), new=TRUE) pie(z[i,], radius=1, labels=rep("", 2)) popViewport() } popViewport(3) par(oldpar) ################################################### ### code chunk number 29: gridBase.Rnw:544-549 ################################################### ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14) trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69) group <- gl(2,10,20, labels=c("Ctl","Trt")) weight <- c(ctl, trt) ################################################### ### code chunk number 30: gridBase.Rnw:557-559 ################################################### oldpar <- par(no.readonly=TRUE) ################################################### ### code chunk number 31: regions (eval = FALSE) ################################################### ## pushViewport(viewport(layout=grid.layout(1, 3, ## widths=unit(rep(1, 3), c("null", "cm", "null"))))) ## ################################################### ### code chunk number 32: lattice (eval = FALSE) ################################################### ## pushViewport(viewport(layout.pos.col=1)) ## library(lattice) ## bwplot <- bwplot(weight ~ group) ## print(bwplot, newpage=FALSE) ## popViewport() ## ################################################### ### code chunk number 33: diagnostic (eval = FALSE) ################################################### ## pushViewport(viewport(layout.pos.col=3)) ## lm.D9 <- lm(weight ~ group) ## par(omi=gridOMI(), mfrow=c(2, 2), new=TRUE) ## par(cex=0.5) ## par(mfg=c(1, 1)) ## plot(lm.D9, caption="", ask=FALSE) ## popViewport(2) ##