### R code from vignette source 'rgraphics.Rnw' ################################################### ### code chunk number 1: rgraphics.Rnw:51-54 ################################################### options(continue=" ") library(grid) library(lattice) ################################################### ### code chunk number 2: latticesrc (eval = FALSE) ################################################### ## barchart(yield ~ variety | site, data = barley, ## groups = year, layout = c(1,6), stack = TRUE, ## ylab = "Barley Yield (bushels/acre)", ## scales = list(x = list(rot = 45))) ################################################### ### code chunk number 3: lattice ################################################### print( barchart(yield ~ variety | site, data = barley, groups = year, layout = c(1,6), stack = TRUE, ylab = "Barley Yield (bushels/acre)", scales = list(x = list(rot = 45))) ) ################################################### ### code chunk number 4: ggplot2 ################################################### library(ggplot2) qplot(disp, mpg, data=mtcars) + facet_wrap(~ gear) + stat_smooth(method="lm") ################################################### ### code chunk number 5: oz ################################################### library(oz) library(maps) ozLines <- ozRegion() # The sections are as # follows: 1-7, coastlines of WA(1), NT(2), QLD(3), NSW(4), # VIC(5), TAS(6) and SA(7) respectively; sections 8-16 are # internal mainland state boundaries: SA-WA(8), WA-NT(9), # NT-SA(10), NT-QLD(11), QLD-SA(12), QLD-NSW(13), NSW-SA(14), # NSW-VIC(15), VIC-SA(16). makeBdry <- function(lines, rev=NULL) { if (is.null(rev)) { list(x=unlist(lapply(lines, function(line) line$x)), y=unlist(lapply(lines, function(line) line$y))) } else { list(x=unlist(mapply(function(line, rev) { if (rev) { rev(line$x) } else { line$x } }, lines, as.list(rev))), y=unlist(mapply(function(line, rev) { if (rev) { rev(line$y) } else { line$y } }, lines, as.list(rev)))) } } WA <- makeBdry(ozLines$lines[c(1, 8, 9)]) NT <- makeBdry(ozLines$lines[c(2, 11, 10, 9)], rev=c(FALSE, TRUE, TRUE, FALSE)) QLD <- makeBdry(ozLines$lines[c(3, 13, 12, 11)], rev=c(FALSE, FALSE, TRUE, FALSE)) NSW <- makeBdry(ozLines$lines[c(4, 15, 14, 13)], rev=c(FALSE, FALSE, TRUE, TRUE)) VIC <- makeBdry(ozLines$lines[c(5, 16, 15)], rev=c(FALSE, TRUE, TRUE)) TAS <- makeBdry(ozLines$lines[6]) SA <- makeBdry(ozLines$lines[c(7, 8, 10, 12, 14, 16)]) australia <- list(states=list(WA=WA, NT=NT, QLD=QLD, NSW=NSW, VIC=VIC, TAS=TAS, SA=SA), xrange=ozLines$rangex, yrange=ozLines$rangey) centre <- function(bdry) { # c(mean(range(bdry$x)), mean(range(bdry$y))) # From 'maps' package centroid.polygon(bdry) } australia$centres <- lapply(australia$states, centre) stateInfo <- read.table("oz.txt", head=TRUE, sep="\t") pop <- as.numeric(gsub(",", "", stateInfo$Population)) area <- as.numeric(gsub(",", "", stateInfo$Area)) popDens <- pop/area names(popDens) <- gsub(" +", "", stateInfo$Postal) par(mar=rep(0, 4)) plot.new() plot.window(australia$xrange, australia$yrange) for (i in names(popDens)) { polygon(australia$states[[i]], col=hcl(46, 55, 4*popDens[i])) cntr <- australia$centres[[i]] text(cntr[1], cntr[2], round(popDens[i]), col=if (4*popDens[i] < 80) "white" else "black") } oz(coast=FALSE, state=TRUE, col="grey", add=TRUE) ################################################### ### code chunk number 6: rgraphics.Rnw:291-308 ################################################### insight <- read.csv("insight.csv", stringsAsFactors=FALSE) insight$Date <- as.Date(gsub(" - .+$", "", insight$Week)) # Drop Week column and first 4 rows (all zeroes) insight <- insight[-(1:4), -1] # Restrict dates insight <- insight[insight$Date > as.Date("2009-01-01"), ] # insight <- insight[insight$Date > as.Date("2011-01-01"), ] library(reshape) insightDF <- melt(insight, id="Date") colors <- hcl(seq(0, 270, 90), 80, 60) insightPlot <- ggplot(insightDF, aes(x=Date, y=value/100, colour=variable)) + geom_line(size=0.5) + scale_y_continuous(name="Level of Interest") + scale_colour_manual(values=colors) + theme_bw() + opts(axis.title.x=theme_blank()) ################################################### ### code chunk number 7: unadornedplot ################################################### print(insightPlot) ################################################### ### code chunk number 8: rgraphics.Rnw:327-338 ################################################### releases <- read.table("rReleases.txt", sep=":", as.is=TRUE, col.names=c("name", "date")) releases$date <- as.Date(paste("01,", releases$date, sep=""), format="%d, %B, %Y") # Get (x, y) from 'insightDF' that is closest to release date subset <- sapply(releases$date, function(d) { min(which(d < insight$Date)) }) releases$Date <- insight$Date[subset] releases$Interest <- insight$r.plot[subset] ################################################### ### code chunk number 9: rgraphics.Rnw:342-356 ################################################### library(grImport) # PostScriptTrace("Cc.logo.circle.ps", "Cc.logo.circle.xml") cclogo <- readPicture("Cc.logo.circle.xml") # PostScriptTrace("cc.eps", "cc.xml") # cclogo <- readPicture("cc.xml") # grid.picture(cclogo) ccgrob <- pictureGrob(cclogo) # grid.newpage() # grid.draw(ccgrob) library(png) cclogoPNG <- readPNG("cc.large.png") # grid.newpage() # grid.raster(cclogoPNG) ################################################### ### code chunk number 10: ggplotscale ################################################### pdf("ggplotScale.pdf", width=7, height=4) # Scaling information for animation below source("ggplotScale.R") dev.off() ################################################### ### code chunk number 11: logoplot ################################################### grid.newpage() grid.rect(gp=gpar(col="grey50", fill="grey95")) pushViewport(viewport(y=unit(1, "lines"), height=unit(1, "npc") - unit(2, "lines"), just="bottom", gp=gpar(cex=1))) print(insightPlot, newpage=FALSE) downViewport("panel-3-3") grid.points(ggplotScaleX(as.numeric(releases$Date), min(as.numeric(insight$Date)), max(as.numeric(insight$Date))), ggplotScaleY(releases$Interest, min(insightDF$value), max(insightDF$value)), pch=16, size=unit(1.5, "mm"), gp=gpar(col="black"), name=paste("points", i, sep="")) grid.text(paste(" ", releases$name, " "), ggplotScaleX(as.numeric(releases$Date), min(as.numeric(insight$Date)), max(as.numeric(insight$Date))), ggplotScaleY(releases$Interest, min(insightDF$value), max(insightDF$value)), default.units="native", rot=90, gp=gpar(cex=.5, col="black"), just="right") upViewport(0) grid.rect(y=1, height=unit(1, "lines"), just="top", gp=gpar(col=NA, fill="grey50")) grid.text("Google Insights for Search", x=unit(1, "mm"), just="left", y=unit(1, "npc") - unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.text(Sys.time(), x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(1, "npc") - unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.rect(y=0, height=unit(1, "lines"), just="bottom", gp=gpar(col=NA, fill="grey50")) grid.text("BY-NC-SA", x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.picture(cclogo, x=unit(1, "npc") - stringWidth("BY-NC-SA "), y=unit(.5, "lines"), just=c("right"), width=unit(1, "char"), height=unit(1, "char"), use.gc=FALSE, gp=gpar(col=NA, fill="white")) ################################################### ### code chunk number 12: rgraphics.Rnw:481-496 ################################################### shadowCanvas <- function(n=10) { deltas <- unit(seq(2, 0, length=n), "mm") greys <- grey(seq(1, .8, length=n)) for (i in 1:n) { grid.roundrect(x=unit(.5, "npc") + unit(2, "mm"), y=unit(.5, "npc") - unit(2, "mm"), width=unit(.8, "npc") + deltas[i], height=unit(.8, "npc") + deltas[i], r=unit(2, "mm"), gp=gpar(col=NA, fill=greys[i])) } grid.roundrect(width=.8, height=.8, r=unit(2, "mm"), gp=gpar(lwd=3, fill="white")) } ################################################### ### code chunk number 13: painters1 ################################################### grid.newpage() shadowCanvas() grid.circle(x=.4, y=.6, r=.2, gp=gpar(lwd=10, fill="grey")) ################################################### ### code chunk number 14: painters2 ################################################### grid.newpage() shadowCanvas() grid.circle(x=.4, y=.6, r=.2, gp=gpar(lwd=10, fill="grey")) grid.circle(x=.6, y=.4, r=.2, gp=gpar(lwd=10, fill="black")) ################################################### ### code chunk number 15: rgraphics.Rnw:545-546 (eval = FALSE) ################################################### ## xyplot( ... ) ################################################### ### code chunk number 16: rgraphics.Rnw:549-550 (eval = FALSE) ################################################### ## grid.text( ... ) ################################################### ### code chunk number 17: annotatedplot ################################################### print(insightPlot) downViewport("panel-3-3") grid.points(ggplotScaleX(as.numeric(releases$Date), min(as.numeric(insight$Date)), max(as.numeric(insight$Date))), ggplotScaleY(releases$Interest, min(insightDF$value), max(insightDF$value)), pch=16, size=unit(1.5, "mm"), gp=gpar(col="black"), name=paste("points", i, sep="")) grid.text(paste(" ", releases$name, " "), ggplotScaleX(as.numeric(releases$Date), min(as.numeric(insight$Date)), max(as.numeric(insight$Date))), ggplotScaleY(releases$Interest, min(insightDF$value), max(insightDF$value)), default.units="native", rot=90, gp=gpar(cex=.5, col="black"), just="right") ################################################### ### code chunk number 18: logoplotpaintersbg ################################################### grid.newpage() grid.rect(gp=gpar(col="grey50", fill="grey95")) grid.rect(y=1, height=unit(1, "lines"), just="top", gp=gpar(col=NA, fill="grey50")) grid.text("Google Insights for Search", x=unit(1, "mm"), just="left", y=unit(1, "npc") - unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.text(Sys.time(), x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(1, "npc") - unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.rect(y=0, height=unit(1, "lines"), just="bottom", gp=gpar(col=NA, fill="grey50")) grid.text("BY-NC-SA", x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.picture(cclogo, x=unit(1, "npc") - stringWidth("BY-NC-SA "), y=unit(.5, "lines"), just=c("right"), width=unit(1, "char"), height=unit(1, "char"), use.gc=FALSE, gp=gpar(col=NA, fill="white")) ################################################### ### code chunk number 19: primitives ################################################### grid.newpage() shadowCanvas() pushViewport(viewport(gp=gpar(lwd=10, fill="grey"))) grid.circle(x=.2, y=.7, r=.1) grid.rect(x=.4, y=.7, width=.15, height=.2) grid.segments(.55, .8, .65, .6) grid.text("A", x=.8, y=.7, gp=gpar(fontsize=120)) pushViewport(viewport(xscale=c(-1, 1), yscale=c(-1, 1), x=.2, y=.3, height=unit(.2, "snpc"), width=unit(.2, "snpc"))) t <- pi/2 + seq(0, 2*pi, 2*pi/5)[-1] grid.polygon(cos(t), sin(t), default="native") popViewport() grid.segments(.35, .2, .45, .4, arrow=arrow(type="closed"), gp=gpar(fill="black")) grid.curve(.55, .2, .65, .4, ncp=8, curvature=.5, square=FALSE, arrow=arrow(type="closed"), gp=gpar(fill="black")) pushViewport(viewport(x=.8, y=.3, height=unit(.2, "snpc"), width=unit(.2, "snpc"))) grid.points(c(.3, .5, .7), c(.1, .5, .9), pch=c(0, 10, 21), gp=gpar(lwd=3, cex=2)) ################################################### ### code chunk number 20: rgraphics.Rnw:724-730 (eval = FALSE) ################################################### ## grid.circle(x = 0.5, ## y = 0.5, ## r = 0.1, ## gp=gpar(col = "black", ## lwd = 10, ## fill = "grey")) ################################################### ### code chunk number 21: logoplotprimitives1 ################################################### grid.newpage() grid.rect(gp=gpar(col="grey50", fill="grey95")) grid.text("1", gp=gpar(col=rgb(0,0,0,.1), fontsize=120)) ################################################### ### code chunk number 22: logoplotprimitives2 ################################################### grid.newpage() grid.rect(gp=gpar(col="grey50", fill="grey95")) grid.rect(y=1, height=unit(1, "lines"), just="top", gp=gpar(col=NA, fill="grey50")) grid.text("2", gp=gpar(col=rgb(0,0,0,.1), fontsize=120)) ################################################### ### code chunk number 23: logoplotprimitives3 ################################################### grid.newpage() grid.rect(gp=gpar(col="grey50", fill="grey95")) grid.rect(y=1, height=unit(1, "lines"), just="top", gp=gpar(col=NA, fill="grey50")) grid.text("Google Insights for Search", x=unit(1, "mm"), just="left", y=unit(1, "npc") - unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.text(Sys.time(), x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(1, "npc") - unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.text("3", gp=gpar(col=rgb(0,0,0,.1), fontsize=120)) ################################################### ### code chunk number 24: logoplotprimitives4 ################################################### grid.newpage() grid.rect(gp=gpar(col="grey50", fill="grey95")) grid.rect(y=1, height=unit(1, "lines"), just="top", gp=gpar(col=NA, fill="grey50")) grid.text("Google Insights for Search", x=unit(1, "mm"), just="left", y=unit(1, "npc") - unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.text(Sys.time(), x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(1, "npc") - unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.rect(y=0, height=unit(1, "lines"), just="bottom", gp=gpar(col=NA, fill="grey50")) grid.text("BY-NC-SA", x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.text("4", gp=gpar(col=rgb(0,0,0,.1), fontsize=120)) ################################################### ### code chunk number 25: modern1 ################################################### grid.newpage() shadowCanvas() grid.circle(x=.4, y=.6, r=.2, gp=gpar(lwd=10, fill=rgb(1,0,0,.5))) ################################################### ### code chunk number 26: modern2 ################################################### grid.newpage() shadowCanvas() grid.circle(x=.4, y=.6, r=.2, gp=gpar(lwd=10, fill=rgb(1,0,0,.5))) grid.circle(x=.6, y=.4, r=.2, gp=gpar(lwd=10, fill=rgb(0,0,1,.5))) ################################################### ### code chunk number 27: rgraphics.Rnw:874-880 (eval = FALSE) ################################################### ## grid.circle(x = 0.5, ## y = 0.6, ## r = 0.2, ## gp=gpar(lwd = 10, ## rgb(red = 1, green = 0, blue = 0, ## alpha = 0.5))) ################################################### ### code chunk number 28: rgraphics.Rnw:906-909 ################################################### Rlogo <- readPNG(system.file("img", "Rlogo.png", package="png")) PostScriptTrace("GNU.ps", "GNU.xml") GNUlogo <- readPicture("GNU.xml") ################################################### ### code chunk number 29: modern3 ################################################### grid.newpage() shadowCanvas() grid.raster(Rlogo, width=.6) ################################################### ### code chunk number 30: modern4 ################################################### grid.newpage() shadowCanvas() grid.picture(GNUlogo, width=.6) ################################################### ### code chunk number 31: rgraphics.Rnw:952-958 (eval = FALSE) ################################################### ## library("png") ## Rlogo <- readPNG(system.file("img", "Rlogo.png", ## package = "png")) ## grid.raster(Rlogo, ## x = 0.5, y = 0.5, ## width = 0.8) ################################################### ### code chunk number 32: rgraphics.Rnw:972-1009 ################################################### setGeneric("polygonify", function(object, ...) { standardGeneric("polygonify") }) setMethod("polygonify", signature("PictureFill"), function(object, ...) { polygonGrob(object@x, object@y, default.units="native", gp=gpar(col=NA, fill=object@rgb), ...) }) setGeneric("outlineify", function(object, ...) { standardGeneric("outlineify") }) setMethod("outlineify", signature("PictureFill"), function(object, ...) { n <- length(object@x) moves <- names(object@x) == "move" lty <- ifelse(moves, "dashed", "solid")[-1] gList(textGrob(1:sum(moves), x=unit(object@x[moves], "native") + unit(1.2, "mm"), y=unit(object@y[moves], "native") - unit(c(1.2, 1.2, -1.2, -0.8), "mm"), gp=gpar(col="black", cex=.5), ...), circleGrob(x=object@x[moves], y=object@y[moves], r=unit(.3, "mm"), default.units="native", gp=gpar(col=NA, fill="black"), ...), segmentsGrob(object@x[1:(n-1)], object@y[1:(n-1)], object@x[2:n], object@y[2:n], default.units="native", gp=gpar(col="black", lty=lty), ...)) }) ################################################### ### code chunk number 33: rgraphics.Rnw:1012-1021 ################################################### combinePaths <- function(paths) { x <- unlist(lapply(paths, function(p) p@x[-length(p@x)])) y <- unlist(lapply(paths, function(p) p@y[-length(p@x)])) names <- unlist(lapply(paths, function(p) names(p@x)[-length(p@x)])) names(x) <- names names(y) <- names list(new("PictureFill", x=x, y=y, rgb="black")) } ################################################### ### code chunk number 34: logopath ################################################### cclogoOnePath <- new("Picture", paths=combinePaths(cclogo@paths), summary=cclogo@summary) cclogoOnePath@summary@numPaths <- 1 grid.newpage() pushViewport(viewport(layout=grid.layout(1, 3))) pushViewport(viewport(layout.pos.col=1)) grid.picture(cclogoOnePath, FUN=polygonify) popViewport() pushViewport(viewport(layout.pos.col=2)) grid.picture(cclogoOnePath, FUN=outlineify) popViewport() pushViewport(viewport(layout.pos.col=3)) grid.picture(cclogo) popViewport() ################################################### ### code chunk number 35: logoplotpath ################################################### grid.newpage() pushViewport(viewport(clip=TRUE)) grid.rect(x=1, y=0, width=2, height=2, just=c("right", "bottom"), gp=gpar(lwd=3, col="grey50", fill="grey95")) grid.rect(y=0, height=unit(1, "lines"), just="bottom", gp=gpar(col=NA, fill="grey50")) grid.text("BY-NC-SA", x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.picture(cclogo, x=unit(1, "npc") - stringWidth("BY-NC-SA "), y=unit(.5, "lines"), just=c("right"), width=unit(1, "char"), height=unit(1, "char"), use.gc=FALSE, gp=gpar(col=NA, fill="white")) ################################################### ### code chunk number 36: latticecoord ################################################### library(lattice) xyplot(1:3 ~ 1:3 | 1) ################################################### ### code chunk number 37: latticecoordnative ################################################### xyplot(1:3 ~ 1:3 | 1) # grid.gremove(".*") grid.rect(gp=gpar(col=NA, fill=rgb(1, 1, 1, .8))) downViewport("plot_01.panel.1.1.off.vp") grid.rect(gp=gpar(lwd=3)) grid.xaxis(at=c(1, 3), gp=gpar(lwd=3, fontface="bold")) grid.yaxis(at=c(1, 3), gp=gpar(lwd=3, fontface="bold")) ################################################### ### code chunk number 38: latticecoordnpc ################################################### xyplot(1:3 ~ 1:3 | 1) # grid.gremove(".*") grid.rect(gp=gpar(col=NA, fill=rgb(1, 1, 1, .8))) downViewport("plot_01.panel.1.1.off.vp") grid.rect(gp=gpar(lwd=3)) pushViewport(viewport()) grid.xaxis(at=0:1, gp=gpar(lwd=3, fontface="bold")) grid.yaxis(at=0:1, gp=gpar(lwd=3, fontface="bold")) ################################################### ### code chunk number 39: latticecoordmm ################################################### xyplot(1:3 ~ 1:3 | 1) # grid.gremove(".*") grid.rect(gp=gpar(col=NA, fill=rgb(1, 1, 1, .8))) downViewport("plot_01.panel.1.1.off.vp") grid.rect(gp=gpar(lwd=3)) pushViewport(viewport()) grid.xaxis(at=0:1, label=paste(c(0, 10), "mm", sep=""), gp=gpar(lwd=3, fontface="bold")) grid.yaxis(at=0:1, label=paste(c(0, 10), "mm", sep=""), gp=gpar(lwd=3, fontface="bold")) ################################################### ### code chunk number 40: latticecoordadd ################################################### xyplot(1:3 ~ 1:3 | 1) grid.rect(gp=gpar(col=NA, fill=rgb(1, 1, 1, .8))) downViewport("plot_01.panel.1.1.vp") grid.text("1mm below and right from\ntop-left corner", unit(0, "npc") + unit(1, "mm"), unit(1, "npc") - unit(1, "mm"), just=c("left", "top")) grid.text("2mm above and right from (1, 1)", unit(1, "native") + unit(2, "mm"), unit(1, "native") + unit(2, "mm"), just=c("left", "bottom")) ################################################### ### code chunk number 41: rgraphics.Rnw:1263-1267 (eval = FALSE) ################################################### ## grid.text("1mm below and right from top-left corner", ## x = unit(0, "npc") + unit(1, "mm"), ## y = unit(1, "npc") - unit(1, "mm"), ## just = c("left", "top")) ################################################### ### code chunk number 42: rgraphics.Rnw:1270-1274 (eval = FALSE) ################################################### ## grid.text("2mm above and right from (1, 1)", ## x = unit(1, "native") + unit(2, "mm"), ## y = unit(1, "native") + unit(2, "mm"), ## just = c("left", "bottom")) ################################################### ### code chunk number 43: latticevps ################################################### pdf("rgraphics-latticevps-%d.pdf", width=4, height=4, onefile=FALSE) library(lattice) xyplot(1:3 ~ 1:3 | 1) showViewport(depth=2, col=NA, newpage=TRUE) downViewport("plot_01.panel.1.1.off.vp") grid.segments(0, 1, 1, 1, gp=gpar(col=rgb(0,0,1,.2))) dev.off() ################################################### ### code chunk number 44: latticevps ################################################### pdf("rgraphics-latticegrobs-%d.pdf", width=4, height=4, onefile=FALSE) library(lattice) xyplot(1:3 ~ 1:3 | 1) showViewport(depth=2, col=NA) dev.off() ################################################### ### code chunk number 45: rgraphics.Rnw:1400-1402 (eval = FALSE) ################################################### ## pushViewport(viewport(width = 0.5, height = 0.5, ## name = "plotvp")) ################################################### ### code chunk number 46: rgraphics.Rnw:1405-1406 (eval = FALSE) ################################################### ## upViewport(1) ################################################### ### code chunk number 47: rgraphics.Rnw:1409-1410 (eval = FALSE) ################################################### ## downViewport("plotvp") ################################################### ### code chunk number 48: vplayer (eval = FALSE) ################################################### ## pushViewport(viewport()) ## pushViewport(viewport(y=1, height=unit(1, "lines"), just="top")) ## upViewport() ## pushViewport(viewport(y=0, height=unit(1, "lines"), just="bottom")) ## upViewport(2) ## showViewport(col=NA) ## grid.segments(0, unit(0:1, "npc") + unit(c(1, -1), "lines"), ## 1, unit(0:1, "npc") + unit(c(1, -1), "lines"), ## gp=gpar(col=rgb(0,0,1,.2))) ################################################### ### code chunk number 49: logoplotcoords1 ################################################### pdf("rgraphics-logoplotcoords1-%d.pdf", height=4, onefile=FALSE) pushViewport(viewport()) pushViewport(viewport(y=1, height=unit(1, "lines"), just="top")) upViewport() pushViewport(viewport(y=0, height=unit(1, "lines"), just="bottom")) upViewport(2) showViewport(col=NA) grid.segments(0, unit(0:1, "npc") + unit(c(1, -1), "lines"), 1, unit(0:1, "npc") + unit(c(1, -1), "lines"), gp=gpar(col=rgb(0,0,1,.2))) dev.off() ################################################### ### code chunk number 50: logoplotcoords2 ################################################### pdf("rgraphics-logoplotcoords2-%d.pdf", height=4, onefile=FALSE) grid.newpage() pushViewport(viewport(y=unit(1, "lines"), height=unit(1, "npc") - unit(2, "lines"), just="bottom", gp=gpar(cex=1))) grid.rect(gp=gpar(col="grey50", fill="grey95")) print(insightPlot, newpage=FALSE) downViewport("panel-3-3") grid.points(ggplotScaleX(as.numeric(releases$Date), min(as.numeric(insight$Date)), max(as.numeric(insight$Date))), ggplotScaleY(releases$Interest, min(insightDF$value), max(insightDF$value)), pch=16, size=unit(1.5, "mm"), gp=gpar(col="black"), name=paste("points", i, sep="")) grid.text(paste(" ", releases$name, " "), ggplotScaleX(as.numeric(releases$Date), min(as.numeric(insight$Date)), max(as.numeric(insight$Date))), ggplotScaleY(releases$Interest, min(insightDF$value), max(insightDF$value)), default.units="native", rot=90, gp=gpar(cex=.5, col="black"), just="right") popViewport(0) pushViewport(viewport()) pushViewport(viewport(y=1, height=unit(1, "lines"), just="top")) upViewport() pushViewport(viewport(y=0, height=unit(1, "lines"), just="bottom")) upViewport(2) showViewport(col=NA) grid.segments(0, unit(0:1, "npc") + unit(c(1, -1), "lines"), 1, unit(0:1, "npc") + unit(c(1, -1), "lines"), gp=gpar(col=rgb(0,0,1,.2))) dev.off() ################################################### ### code chunk number 51: logoplotcoords3 ################################################### pdf("rgraphics-logoplotcoords3-%d.pdf", height=4, onefile=FALSE) grid.newpage() pushViewport(viewport(y=unit(1, "lines"), height=unit(1, "npc") - unit(2, "lines"), just="bottom", gp=gpar(cex=1))) grid.rect(gp=gpar(col="grey50", fill="grey95")) print(insightPlot, newpage=FALSE) downViewport("panel-3-3") grid.points(ggplotScaleX(as.numeric(releases$Date), min(as.numeric(insight$Date)), max(as.numeric(insight$Date))), ggplotScaleY(releases$Interest, min(insightDF$value), max(insightDF$value)), pch=16, size=unit(1.5, "mm"), gp=gpar(col="black"), name=paste("points", i, sep="")) grid.text(paste(" ", releases$name, " "), ggplotScaleX(as.numeric(releases$Date), min(as.numeric(insight$Date)), max(as.numeric(insight$Date))), ggplotScaleY(releases$Interest, min(insightDF$value), max(insightDF$value)), default.units="native", rot=90, gp=gpar(cex=.5, col="black"), just="right") popViewport(0) grid.rect(y=1, height=unit(1, "lines"), just="top", gp=gpar(col=NA, fill="grey50")) grid.text("Google Insights for Search", x=unit(1, "mm"), just="left", y=unit(1, "npc") - unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.text(Sys.time(), x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(1, "npc") - unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) pushViewport(viewport()) pushViewport(viewport(y=1, height=unit(1, "lines"), just="top")) upViewport() pushViewport(viewport(y=0, height=unit(1, "lines"), just="bottom")) upViewport(2) showViewport(col=NA) grid.segments(0, unit(0:1, "npc") + unit(c(1, -1), "lines"), 1, unit(0:1, "npc") + unit(c(1, -1), "lines"), gp=gpar(col=rgb(0,0,1,.2))) dev.off() ################################################### ### code chunk number 52: logoplotcoords4 ################################################### pdf("rgraphics-logoplotcoords4-%d.pdf", height=4, onefile=FALSE) grid.newpage() grid.rect(gp=gpar(col="grey50", fill="grey95")) pushViewport(viewport(y=unit(1, "lines"), height=unit(1, "npc") - unit(2, "lines"), just="bottom", gp=gpar(cex=1))) print(insightPlot, newpage=FALSE) downViewport("panel-3-3") grid.points(ggplotScaleX(as.numeric(releases$Date), min(as.numeric(insight$Date)), max(as.numeric(insight$Date))), ggplotScaleY(releases$Interest, min(insightDF$value), max(insightDF$value)), pch=16, size=unit(1.5, "mm"), gp=gpar(col="black"), name=paste("points", i, sep="")) grid.text(paste(" ", releases$name, " "), ggplotScaleX(as.numeric(releases$Date), min(as.numeric(insight$Date)), max(as.numeric(insight$Date))), ggplotScaleY(releases$Interest, min(insightDF$value), max(insightDF$value)), default.units="native", rot=90, gp=gpar(cex=.5, col="black"), just="right") popViewport(0) grid.rect(y=1, height=unit(1, "lines"), just="top", gp=gpar(col=NA, fill="grey50")) grid.text("Google Insights for Search", x=unit(1, "mm"), just="left", y=unit(1, "npc") - unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.text(Sys.time(), x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(1, "npc") - unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.rect(y=0, height=unit(1, "lines"), just="bottom", gp=gpar(col=NA, fill="grey50")) grid.text("BY-NC-SA", x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.picture(cclogo, x=unit(1, "npc") - stringWidth("BY-NC-SA "), y=unit(.5, "lines"), just=c("right"), width=unit(1, "char"), height=unit(1, "char"), use.gc=FALSE, gp=gpar(col=NA, fill="white")) pushViewport(viewport()) pushViewport(viewport(y=1, height=unit(1, "lines"), just="top")) upViewport() pushViewport(viewport(y=0, height=unit(1, "lines"), just="bottom")) upViewport(2) showViewport(col=NA) grid.segments(0, unit(0:1, "npc") + unit(c(1, -1), "lines"), 1, unit(0:1, "npc") + unit(c(1, -1), "lines"), gp=gpar(col=rgb(0,0,1,.2))) dev.off() ################################################### ### code chunk number 53: latticels ################################################### print(xyplot(1:3 ~ 1:3 | 1)) grid.ls() ################################################### ### code chunk number 54: rgraphics.Rnw:1655-1659 (eval = FALSE) ################################################### ## grid.text("BY-NC-SA", ## x = unit(1, "npc") - unit(1, "mm"), ## just = c("right"), ## name = "cclabel") ################################################### ### code chunk number 55: rgraphics.Rnw:1662-1664 (eval = FALSE) ################################################### ## ccx <- unit(1, "npc") - unit(1, "mm") - ## grobWidth("cclabel") ################################################### ### code chunk number 56: rgraphics.Rnw:1667-1668 (eval = FALSE) ################################################### ## grid.edit("cclabel", gp=gpar(fontface="bold")) ################################################### ### code chunk number 57: logoplotgrob1 ################################################### grid.newpage() pushViewport(viewport(clip=TRUE)) grid.rect(x=1, y=0, width=2, height=2, just=c("right", "bottom"), gp=gpar(lwd=3, col="grey50", fill="grey95")) grid.rect(y=0, height=unit(1, "lines"), just="bottom", gp=gpar(col=NA, fill="grey50")) grid.text("BY-NC-SA", x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(.5, "lines"), gp=gpar(fontface="italic", col="grey")) grid.rect(x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(.5, "lines"), width=stringWidth("BY-NC-SA"), height=stringHeight("BY-NC-SA"), gp=gpar(col="red")) ################################################### ### code chunk number 58: logoplotgrob2 ################################################### grid.newpage() pushViewport(viewport(clip=TRUE)) grid.rect(x=1, y=0, width=2, height=2, just=c("right", "bottom"), gp=gpar(lwd=3, col="grey50", fill="grey95")) grid.rect(y=0, height=unit(1, "lines"), just="bottom", gp=gpar(col=NA, fill="grey50")) grid.text("BY-NC-SA", x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(.5, "lines"), gp=gpar(fontface="italic", col="grey")) grid.rect(x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(.5, "lines"), width=stringWidth("BY-NC-SA"), height=stringHeight("BY-NC-SA"), gp=gpar(col="red")) grid.picture(cclogo, x=unit(1, "npc") - stringWidth("BY-NC-SA "), y=unit(.5, "lines"), just=c("right"), width=unit(1, "char"), height=unit(1, "char"), use.gc=FALSE, gp=gpar(col=NA, fill="white")) ################################################### ### code chunk number 59: logoplotgrob3 ################################################### grid.newpage() pushViewport(viewport(clip=TRUE)) grid.rect(x=1, y=0, width=2, height=2, just=c("right", "bottom"), gp=gpar(lwd=3, col="grey50", fill="grey95")) grid.rect(y=0, height=unit(1, "lines"), just="bottom", gp=gpar(col=NA, fill="grey50")) grid.text("BY-NC-SA", x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.picture(cclogo, x=unit(1, "npc") - stringWidth("BY-NC-SA "), y=unit(.5, "lines"), just=c("right"), width=unit(1, "char"), height=unit(1, "char"), use.gc=FALSE, gp=gpar(col=NA, fill="white")) ################################################### ### code chunk number 60: logoplotinteractive (eval = FALSE) ################################################### ## pdf("logoplot.pdf", width=7, height=4) ## # Main picture ## grid.newpage() ## grid.rect(gp=gpar(col="grey50", fill="grey95")) ## pushViewport(viewport(y=unit(1, "lines"), ## height=unit(1, "npc") - unit(2, "lines"), ## just="bottom", ## gp=gpar(cex=1))) ## print(insightPlot, newpage=FALSE) ## downViewport("panel-3-3") ## grid.points(ggplotScaleX(as.numeric(releases$Date), ## min(as.numeric(insight$Date)), ## max(as.numeric(insight$Date))), ## ggplotScaleY(releases$Interest, ## min(insightDF$value), ## max(insightDF$value)), ## pch=16, size=unit(1.5, "mm"), ## gp=gpar(col="black"), ## name=paste("points", i, sep="")) ## grid.text(paste(" ", releases$name, " "), ## ggplotScaleX(as.numeric(releases$Date), ## min(as.numeric(insight$Date)), ## max(as.numeric(insight$Date))), ## ggplotScaleY(releases$Interest, ## min(insightDF$value), ## max(insightDF$value)), ## default.units="native", ## rot=90, ## gp=gpar(cex=.5, col="black"), ## just="right") ## upViewport(0) ## grid.rect(y=1, height=unit(1, "lines"), just="top", ## gp=gpar(col=NA, fill="grey50")) ## grid.text("Google Insights for Search", ## x=unit(1, "mm"), ## just="left", ## y=unit(1, "npc") - unit(.5, "lines"), ## gp=gpar(fontface="italic", col="white"), ## name="google") ## grid.text(Sys.time(), ## x=unit(1, "npc") - unit(1, "mm"), ## just="right", ## y=unit(1, "npc") - unit(.5, "lines"), ## gp=gpar(fontface="italic", col="white")) ## grid.rect(y=0, height=unit(1, "lines"), just="bottom", ## gp=gpar(col=NA, fill="grey50")) ## grid.text("BY-NC-SA", ## x=unit(1, "npc") - unit(1, "mm"), ## just="right", ## y=unit(.5, "lines"), ## gp=gpar(fontface="italic", col="white")) ## grid.picture(cclogo, ## x=unit(1, "npc") - ## stringWidth("BY-NC-SA "), ## y=unit(.5, "lines"), ## just=c("right"), ## width=unit(1, "char"), ## height=unit(1, "char"), ## use.gc=FALSE, gp=gpar(col=NA, fill="white"), ## name="cc") ## library(gridSVG) ## # hyperlinks ## grid.hyperlink("google", href="http://www.google.com") ## grid.garnish("cc", "pointer-events"="all") ## grid.hyperlink("cc", href="http://creativecommons.org/") ## # Animation ## n <- nrow(insight) ## x <- animUnit(unit(ggplotScaleX(rep(as.numeric(insight$Date)[unlist(lapply(1:n, seq))], ## 4), ## min(as.numeric(insight$Date)), ## max(as.numeric(insight$Date))), ## "native"), ## timeid=rep(rep(1:n, 1:n), 4), ## id=rep(1:4, each=sum(1:n))) ## y <- animUnit(unit(ggplotScaleY(c(insight$r.plot[unlist(lapply(1:n, seq))], ## insight$sas.plot[unlist(lapply(1:n, seq))], ## insight$stata.plot[unlist(lapply(1:n, seq))], ## insight$spss.plot[unlist(lapply(1:n, seq))]), ## min(insightDF$value), ## max(insightDF$value)), ## "native"), ## timeid=rep(rep(1:n, 1:n), 4), ## id=rep(1:4, each=sum(1:n))) ## # Find the right polyline ## panelGrobs <- grid.ls(grid.get("panel-3-3"))$name ## polylineName <- panelGrobs[grep("GRID.polyline", panelGrobs)] ## grid.animate(polylineName, x=x, y=y, duration=5) ## # Interaction ## panelDepth <- downViewport("panel-3-3") ## # Create a viewport exactly like "panel-3-3", but with clipping off ## clippedvp <- current.viewport() ## clippedvp$clip <- NA ## clippedvp$name <- "intervp" ## upViewport() ## pushViewport(clippedvp, viewport(gp=gpar(cex=.5))) ## bar <- textGrob("|", ## x=unit(.75, "npc"), ## y=unit(1, "npc") + unit(1, "lines"), ## name="bar") ## grid.draw(garnishGrob(bar, visibility="hidden")) ## for (i in 1:nrow(insight)) { ## # Data points ## subset <- insightDF$Date == insight$Date[i] ## points <- pointsGrob(ggplotScaleX(as.numeric(insightDF$Date[subset]), ## min(as.numeric(insight$Date)), ## max(as.numeric(insight$Date))), ## ggplotScaleY(insightDF$value[subset], ## min(insightDF$value), ## max(insightDF$value)), ## pch=16, size=unit(1.5, "mm"), ## gp=gpar(col=colors), ## name=paste("points", i, sep="")) ## grid.draw(garnishGrob(points, visibility="hidden")) ## # Display above plot ## date <- textGrob(format(unique(insight$Date[i]), format="%B %Y"), ## x=unit(.75, "npc") + unit(2, "mm"), just="left", ## y=unit(1, "npc") + unit(1, "lines"), ## name=paste("date", i, sep="")) ## grid.draw(garnishGrob(date, visibility="hidden")) ## legPoints <- pointsGrob(x=unit(.75, "npc") - unit(2, "mm") - ## 1:4*stringWidth(" 0.00") - 0:3*unit(3, "mm"), ## y=rep(unit(1, "npc") + unit(1, "lines"), 4), ## pch=16, size=unit(1.5, "mm"), ## gp=gpar(col=colors), ## name=paste("legPoints", i, sep="")) ## grid.draw(garnishGrob(legPoints, visibility="hidden")) ## legText <- textGrob(sprintf("%0.2f", insightDF$value[subset]/100), ## x=unit(.75, "npc") - unit(2, "mm") - ## 0:3*stringWidth(" 0.00") - 0:3*unit(3, "mm"), ## just="right", ## y=unit(1, "npc") + unit(1, "lines"), ## name=paste("legText", i, sep="")) ## grid.draw(garnishGrob(legText, visibility="hidden")) ## } ## upViewport(1) ## # Draw an invisible rectangle ON TOP of the panel ## # to collect ALL mouse events in the panel ## erect <- rectGrob(name="event-rect") ## grid.draw(garnishGrob(erect, grep=TRUE, ## visibility="hidden", ## onmousemove=paste("highlightPoints(evt, ", ## ggplotScaleX(min(as.numeric(insight$Date)), ## min(as.numeric(insight$Date)), ## max(as.numeric(insight$Date))), ## ", ", ## ggplotScaleX(max(as.numeric(insight$Date)), ## min(as.numeric(insight$Date)), ## max(as.numeric(insight$Date))), ## ", ", ## nrow(insight), ")", ## sep=""), ## onmouseout="unhighlightPoints()", ## "pointer-events"="all")) ## grid.script(filename="highlight.js") ## gridToSVG("logoplot.svg") ## dev.off() ################################################### ### code chunk number 61: plotframe ################################################### plotframe <- function(title) { grid.newpage() grid.rect(gp=gpar(col="grey50", fill="grey95")) grid.rect(y=1, height=unit(1, "lines"), just="top", gp=gpar(col=NA, fill="grey50")) grid.text(title, x=unit(1, "mm"), just="left", y=unit(1, "npc") - unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.text(Sys.time(), x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(1, "npc") - unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.rect(y=0, height=unit(1, "lines"), just="bottom", gp=gpar(col=NA, fill="grey50")) grid.text("BY-NC-SA", x=unit(1, "npc") - unit(1, "mm"), just="right", y=unit(.5, "lines"), gp=gpar(fontface="italic", col="white")) grid.picture(cclogo, x=unit(1, "npc") - stringWidth("BY-NC-SA "), y=unit(.5, "lines"), just=c("right"), width=unit(1, "char"), height=unit(1, "char"), use.gc=FALSE, gp=gpar(col=NA, fill="white")) pushViewport(viewport(y=unit(1, "lines"), height=unit(1, "npc") - unit(2, "lines"), just="bottom", gp=gpar(cex=1))) } ################################################### ### code chunk number 62: frame ################################################### plotframe("Title goes here") ################################################### ### code chunk number 63: rgraphics.Rnw:2121-2123 (eval = FALSE) ################################################### ## plotframe("Google Insights for Search") ## ggplot( ... ) ################################################### ### code chunk number 64: framelattice ################################################### plotframe("Lattice Multipanel Conditioning") pushViewport(viewport(width=unit(1, "snpc"), gp=gpar(cex=.55))) print( barchart(yield ~ variety | site, data = barley, groups = year, layout = c(1,6), stack = TRUE, ylab = "Barley Yield (bushels/acre)", scales = list(x = list(rot = 45))) , newpage=FALSE) ################################################### ### code chunk number 65: rgraphics.Rnw:2146-2148 (eval = FALSE) ################################################### ## plotframe("Lattice Multipanel Conditioning") ## xyplot( ... ) ################################################### ### code chunk number 66: frameoz ################################################### pdf("rgraphics-frameoz-%d.pdf", width=6, height=4, onefile=FALSE) plot.new() plotframe("Australian Population Density") pushViewport(viewport(width=unit(1, "snpc"), height=unit(1, "snpc"))) library(gridBase) par(omi=gridOMI(), new=TRUE) library(oz) library(maps) ozLines <- ozRegion() # The sections are as # follows: 1-7, coastlines of WA(1), NT(2), QLD(3), NSW(4), # VIC(5), TAS(6) and SA(7) respectively; sections 8-16 are # internal mainland state boundaries: SA-WA(8), WA-NT(9), # NT-SA(10), NT-QLD(11), QLD-SA(12), QLD-NSW(13), NSW-SA(14), # NSW-VIC(15), VIC-SA(16). makeBdry <- function(lines, rev=NULL) { if (is.null(rev)) { list(x=unlist(lapply(lines, function(line) line$x)), y=unlist(lapply(lines, function(line) line$y))) } else { list(x=unlist(mapply(function(line, rev) { if (rev) { rev(line$x) } else { line$x } }, lines, as.list(rev))), y=unlist(mapply(function(line, rev) { if (rev) { rev(line$y) } else { line$y } }, lines, as.list(rev)))) } } WA <- makeBdry(ozLines$lines[c(1, 8, 9)]) NT <- makeBdry(ozLines$lines[c(2, 11, 10, 9)], rev=c(FALSE, TRUE, TRUE, FALSE)) QLD <- makeBdry(ozLines$lines[c(3, 13, 12, 11)], rev=c(FALSE, FALSE, TRUE, FALSE)) NSW <- makeBdry(ozLines$lines[c(4, 15, 14, 13)], rev=c(FALSE, FALSE, TRUE, TRUE)) VIC <- makeBdry(ozLines$lines[c(5, 16, 15)], rev=c(FALSE, TRUE, TRUE)) TAS <- makeBdry(ozLines$lines[6]) SA <- makeBdry(ozLines$lines[c(7, 8, 10, 12, 14, 16)]) australia <- list(states=list(WA=WA, NT=NT, QLD=QLD, NSW=NSW, VIC=VIC, TAS=TAS, SA=SA), xrange=ozLines$rangex, yrange=ozLines$rangey) centre <- function(bdry) { # c(mean(range(bdry$x)), mean(range(bdry$y))) # From 'maps' package centroid.polygon(bdry) } australia$centres <- lapply(australia$states, centre) stateInfo <- read.table("oz.txt", head=TRUE, sep="\t") pop <- as.numeric(gsub(",", "", stateInfo$Population)) area <- as.numeric(gsub(",", "", stateInfo$Area)) popDens <- pop/area names(popDens) <- gsub(" +", "", stateInfo$Postal) par(mar=rep(0, 4)) plot.new() plot.window(australia$xrange, australia$yrange) for (i in names(popDens)) { polygon(australia$states[[i]], col=hcl(46, 55, 4*popDens[i])) cntr <- australia$centres[[i]] text(cntr[1], cntr[2], round(popDens[i]), col=if (4*popDens[i] < 80) "white" else "black") } oz(coast=FALSE, state=TRUE, col="grey", add=TRUE) dev.off() ################################################### ### code chunk number 67: rgraphics.Rnw:2174-2176 (eval = FALSE) ################################################### ## plotframe("Australian Population Density") ## oz( ... ) ################################################### ### code chunk number 68: packages ################################################### grid.newpage() pushViewport(viewport(layout=grid.layout(3, 3))) pushViewport(viewport(layout.pos.row=1, layout.pos.col=2)) grid.text("grDevices") grid.move.to(.5, .4) popViewport() pushViewport(viewport(layout.pos.row=2, layout.pos.col=1:2)) grid.text("grid") grid.line.to(.5, .6, arrow=arrow(angle=10, type="closed"), gp=gpar(fill="black")) popViewport() pushViewport(viewport(layout.pos.row=1, layout.pos.col=2)) grid.move.to(.5, .4) popViewport() pushViewport(viewport(layout.pos.row=2, layout.pos.col=2:3)) grid.text("graphics") grid.line.to(.5, .6, arrow=arrow(angle=10, type="closed"), gp=gpar(fill="black")) popViewport() pushViewport(viewport(layout.pos.row=2, layout.pos.col=1:2)) grid.move.to(.5, .4) popViewport() pushViewport(viewport(layout.pos.row=3, layout.pos.col=1)) grid.text("lattice") grid.line.to(.5, .6, arrow=arrow(angle=10, type="closed"), gp=gpar(fill="black")) popViewport() pushViewport(viewport(layout.pos.row=2, layout.pos.col=1:2)) grid.move.to(.5, .4) popViewport() pushViewport(viewport(layout.pos.row=3, layout.pos.col=2)) grid.text("ggplot2") grid.line.to(.5, .6, arrow=arrow(angle=10, type="closed"), gp=gpar(fill="black")) popViewport()