433 lines
13 KiB
R
433 lines
13 KiB
R
|
### 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)
|
||
|
|
##
|
||
|
|
|
||
|
|
|