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