1### R code from vignette source 'gridBase.Rnw' 2 3################################################### 4### code chunk number 1: gridBase.Rnw:81-84 5################################################### 6library(grid) 7library(gridBase) 8 9 10 11################################################### 12### code chunk number 2: basesetup (eval = FALSE) 13################################################### 14## midpts <- barplot(1:10, axes=FALSE) 15## axis(2) 16## axis(1, at=midpts, labels=FALSE) 17## 18 19 20################################################### 21### code chunk number 3: baseviewport (eval = FALSE) 22################################################### 23## vps <- baseViewports() 24## pushViewport(vps$inner, vps$figure, vps$plot) 25## 26 27 28################################################### 29### code chunk number 4: gridtext (eval = FALSE) 30################################################### 31## grid.text(c("one", "two", "three", "four", "five", 32## "six", "seven", "eight", "nine", "ten"), 33## x=unit(midpts, "native"), y=unit(-1, "lines"), 34## just="right", rot=60) 35## popViewport(3) 36## 37 38 39################################################### 40### code chunk number 5: gridBase.Rnw:110-114 41################################################### 42midpts <- barplot(1:10, axes=FALSE) 43axis(2) 44axis(1, at=midpts, labels=FALSE) 45 46vps <- baseViewports() 47pushViewport(vps$inner, vps$figure, vps$plot) 48 49grid.text(c("one", "two", "three", "four", "five", 50 "six", "seven", "eight", "nine", "ten"), 51 x=unit(midpts, "native"), y=unit(-1, "lines"), 52 just="right", rot=60) 53popViewport(3) 54 55 56 57 58################################################### 59### code chunk number 6: plotsymbol (eval = FALSE) 60################################################### 61## novelsym <- function(speed, temp, 62## width=unit(3, "mm"), 63## length=unit(0.5, "inches")) { 64## grid.rect(height=length, y=0.5, 65## just="top", width=width, 66## gp=gpar(fill="white")) 67## grid.rect(height=temp*length, 68## y=unit(0.5, "npc") - length, 69## width=width, 70## just="bottom", gp=gpar(fill="grey")) 71## grid.lines(x=0.5, 72## y=unit.c(unit(0.5, "npc"), unit(0.5, "npc") + speed*length), 73## arrow=arrow(length=unit(3, "mm"), type="closed"), 74## gp=gpar(fill="black")) 75## grid.points(unit(0.5, "npc"), unit(0.5, "npc"), size=unit(2, "mm"), 76## pch=16) 77## } 78## 79 80 81################################################### 82### code chunk number 7: baseplot (eval = FALSE) 83################################################### 84## chinasea <- read.table(system.file("doc", "chinasea.txt", 85## package="gridBase"), 86## header=TRUE) 87## plot(chinasea$lat, chinasea$long, type="n", 88## xlab="latitude", ylab="longitude", 89## main="China Sea Wind Speed/Direction and Temperature") 90## 91 92 93################################################### 94### code chunk number 8: gridsym (eval = FALSE) 95################################################### 96## speed <- 0.8*chinasea$speed/14 + 0.2 97## temp <- chinasea$temp/40 98## vps <- baseViewports() 99## pushViewport(vps$inner, vps$figure, vps$plot) 100## for (i in 1:25) { 101## pushViewport(viewport(x=unit(chinasea$lat[i], "native"), 102## y=unit(chinasea$long[i], "native"), 103## angle=chinasea$dir[i])) 104## novelsym(speed[i], temp[i]) 105## popViewport() 106## } 107## popViewport(3) 108## 109 110 111################################################### 112### code chunk number 9: gridBase.Rnw:184-188 113################################################### 114novelsym <- function(speed, temp, 115 width=unit(3, "mm"), 116 length=unit(0.5, "inches")) { 117 grid.rect(height=length, y=0.5, 118 just="top", width=width, 119 gp=gpar(fill="white")) 120 grid.rect(height=temp*length, 121 y=unit(0.5, "npc") - length, 122 width=width, 123 just="bottom", gp=gpar(fill="grey")) 124 grid.lines(x=0.5, 125 y=unit.c(unit(0.5, "npc"), unit(0.5, "npc") + speed*length), 126 arrow=arrow(length=unit(3, "mm"), type="closed"), 127 gp=gpar(fill="black")) 128 grid.points(unit(0.5, "npc"), unit(0.5, "npc"), size=unit(2, "mm"), 129 pch=16) 130} 131 132chinasea <- read.table(system.file("doc", "chinasea.txt", 133 package="gridBase"), 134 header=TRUE) 135plot(chinasea$lat, chinasea$long, type="n", 136 xlab="latitude", ylab="longitude", 137 main="China Sea Wind Speed/Direction and Temperature") 138 139speed <- 0.8*chinasea$speed/14 + 0.2 140temp <- chinasea$temp/40 141vps <- baseViewports() 142pushViewport(vps$inner, vps$figure, vps$plot) 143for (i in 1:25) { 144 pushViewport(viewport(x=unit(chinasea$lat[i], "native"), 145 y=unit(chinasea$long[i], "native"), 146 angle=chinasea$dir[i])) 147 novelsym(speed[i], temp[i]) 148 popViewport() 149} 150popViewport(3) 151 152 153 154 155################################################### 156### code chunk number 10: gridBase.Rnw:220-225 157################################################### 158 data(USArrests) 159 hc <- hclust(dist(USArrests), "ave") 160 dend1 <- as.dendrogram(hc) 161 dend2 <- cut(dend1, h=70) 162 163 164 165################################################### 166### code chunk number 11: gridBase.Rnw:229-233 167################################################### 168x <- 1:4 169y <- 1:4 170height <- factor(round(unlist(lapply(dend2$lower, attr, "height")))) 171 172 173 174################################################### 175### code chunk number 12: gridBase.Rnw:248-260 176################################################### 177space <- max(unit(rep(1, 50), "strwidth", 178 as.list(rownames(USArrests)))) 179dendpanel <- function(x, y, subscripts, ...) { 180 pushViewport(viewport(y=space, width=0.9, 181 height=unit(0.9, "npc") - space, 182 just="bottom")) 183 grid.rect(gp=gpar(col="grey", lwd=5)) 184 par(plt=gridPLT(), new=TRUE, ps=10) 185 plot(dend2$lower[[subscripts]], axes=FALSE) 186 popViewport() 187} 188 189 190 191################################################### 192### code chunk number 13: gridBase.Rnw:266-273 193################################################### 194library(lattice) 195plot.new() 196print(xyplot(y ~ x | height, subscripts=TRUE, xlab="", ylab="", 197 strip=function(...) { strip.default(style=4, ...) }, 198 scales=list(draw=FALSE), panel=dendpanel), 199 newpage=FALSE) 200 201 202 203################################################### 204### code chunk number 14: gridBase.Rnw:290-294 205################################################### 206 counts <- c(18,17,15,20,10,20,25,13,12) 207 outcome <- gl(3,1,9) 208 treatment <- gl(3,3) 209 210 211 212################################################### 213### code chunk number 15: gridBase.Rnw:302-304 214################################################### 215oldpar <- par(no.readonly=TRUE) 216 217 218 219################################################### 220### code chunk number 16: regions (eval = FALSE) 221################################################### 222## pushViewport(viewport(layout=grid.layout(1, 3, 223## widths=unit(rep(1, 3), c("null", "cm", "null"))))) 224## 225 226 227################################################### 228### code chunk number 17: lattice (eval = FALSE) 229################################################### 230## pushViewport(viewport(layout.pos.col=1)) 231## library(lattice) 232## bwplot <- bwplot(counts ~ outcome | treatment) 233## print(bwplot, newpage=FALSE) 234## popViewport() 235## 236 237 238################################################### 239### code chunk number 18: diagnostic (eval = FALSE) 240################################################### 241## pushViewport(viewport(layout.pos.col=3)) 242## glm.D93 <- glm(counts ~ outcome + treatment, family=poisson()) 243## par(omi=gridOMI(), mfrow=c(2, 2), new=TRUE) 244## par(cex=0.5, mar=c(5, 4, 1, 2)) 245## par(mfg=c(1, 1)) 246## plot(glm.D93, caption="", ask=FALSE) 247## popViewport(2) 248## 249 250 251################################################### 252### code chunk number 19: multiplot 253################################################### 254pushViewport(viewport(layout=grid.layout(1, 3, 255 widths=unit(rep(1, 3), c("null", "cm", "null"))))) 256 257pushViewport(viewport(layout.pos.col=1)) 258library(lattice) 259bwplot <- bwplot(counts ~ outcome | treatment) 260print(bwplot, newpage=FALSE) 261popViewport() 262 263pushViewport(viewport(layout.pos.col=3)) 264 glm.D93 <- glm(counts ~ outcome + treatment, family=poisson()) 265 par(omi=gridOMI(), mfrow=c(2, 2), new=TRUE) 266 par(cex=0.5, mar=c(5, 4, 1, 2)) 267 par(mfg=c(1, 1)) 268 plot(glm.D93, caption="", ask=FALSE) 269popViewport(2) 270 271 272 273 274################################################### 275### code chunk number 20: gridBase.Rnw:346-348 276################################################### 277par(oldpar) 278 279 280 281################################################### 282### code chunk number 21: gridBase.Rnw:375-379 283################################################### 284x <- c(0.88, 1.00, 0.67, 0.34) 285y <- c(0.87, 0.43, 0.04, 0.94) 286z <- matrix(runif(4*2), ncol=2) 287 288 289 290################################################### 291### code chunk number 22: gridBase.Rnw:386-388 292################################################### 293oldpar <- par(no.readonly=TRUE) 294 295 296 297################################################### 298### code chunk number 23: plot1 (eval = FALSE) 299################################################### 300## plot(x, y, xlim=c(-0.2, 1.2), ylim=c(-0.2, 1.2), type="n") 301## 302 303 304################################################### 305### code chunk number 24: plot2 (eval = FALSE) 306################################################### 307## vps <- baseViewports() 308## pushViewport(vps$inner, vps$figure, vps$plot) 309## grid.segments(x0=unit(c(rep(0, 4), x), 310## rep(c("npc", "native"), each=4)), 311## x1=unit(c(x, x), rep("native", 8)), 312## y0=unit(c(y, rep(0, 4)), 313## rep(c("native", "npc"), each=4)), 314## y1=unit(c(y, y), rep("native", 8)), 315## gp=gpar(lty="dashed", col="grey")) 316## 317 318 319################################################### 320### code chunk number 25: gridBase.Rnw:427-431 321################################################### 322maxpiesize <- unit(1, "inches") 323totals <- apply(z, 1, sum) 324sizemult <- totals/max(totals) 325 326 327 328################################################### 329### code chunk number 26: plot3 (eval = FALSE) 330################################################### 331## for (i in 1:4) { 332## pushViewport(viewport(x=unit(x[i], "native"), 333## y=unit(y[i], "native"), 334## width=sizemult[i]*maxpiesize, 335## height=sizemult[i]*maxpiesize)) 336## grid.rect(gp=gpar(col="grey", fill="white", lty="dashed")) 337## par(plt=gridPLT(), new=TRUE) 338## pie(z[i,], radius=1, labels=rep("", 2)) 339## popViewport() 340## } 341## 342 343 344################################################### 345### code chunk number 27: plot4 (eval = FALSE) 346################################################### 347## popViewport(3) 348## par(oldpar) 349## 350 351 352################################################### 353### code chunk number 28: complex 354################################################### 355plot(x, y, xlim=c(-0.2, 1.2), ylim=c(-0.2, 1.2), type="n") 356 357vps <- baseViewports() 358pushViewport(vps$inner, vps$figure, vps$plot) 359grid.segments(x0=unit(c(rep(0, 4), x), 360 rep(c("npc", "native"), each=4)), 361 x1=unit(c(x, x), rep("native", 8)), 362 y0=unit(c(y, rep(0, 4)), 363 rep(c("native", "npc"), each=4)), 364 y1=unit(c(y, y), rep("native", 8)), 365 gp=gpar(lty="dashed", col="grey")) 366 367for (i in 1:4) { 368 pushViewport(viewport(x=unit(x[i], "native"), 369 y=unit(y[i], "native"), 370 width=sizemult[i]*maxpiesize, 371 height=sizemult[i]*maxpiesize)) 372 grid.rect(gp=gpar(col="grey", fill="white", lty="dashed")) 373 par(plt=gridPLT(), new=TRUE) 374 pie(z[i,], radius=1, labels=rep("", 2)) 375 popViewport() 376} 377 378popViewport(3) 379par(oldpar) 380 381 382 383 384################################################### 385### code chunk number 29: gridBase.Rnw:544-549 386################################################### 387 ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14) 388 trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69) 389 group <- gl(2,10,20, labels=c("Ctl","Trt")) 390 weight <- c(ctl, trt) 391 392 393 394################################################### 395### code chunk number 30: gridBase.Rnw:557-559 396################################################### 397oldpar <- par(no.readonly=TRUE) 398 399 400 401################################################### 402### code chunk number 31: regions (eval = FALSE) 403################################################### 404## pushViewport(viewport(layout=grid.layout(1, 3, 405## widths=unit(rep(1, 3), c("null", "cm", "null"))))) 406## 407 408 409################################################### 410### code chunk number 32: lattice (eval = FALSE) 411################################################### 412## pushViewport(viewport(layout.pos.col=1)) 413## library(lattice) 414## bwplot <- bwplot(weight ~ group) 415## print(bwplot, newpage=FALSE) 416## popViewport() 417## 418 419 420################################################### 421### code chunk number 33: diagnostic (eval = FALSE) 422################################################### 423## pushViewport(viewport(layout.pos.col=3)) 424## lm.D9 <- lm(weight ~ group) 425## par(omi=gridOMI(), mfrow=c(2, 2), new=TRUE) 426## par(cex=0.5) 427## par(mfg=c(1, 1)) 428## plot(lm.D9, caption="", ask=FALSE) 429## popViewport(2) 430## 431 432 433