### R code from vignette source 'gore.Rnw' ################################################### ### code chunk number 1: gore.Rnw:49-51 ################################################### options(prompt=" ") options(continue=" ") ################################################### ### code chunk number 2: ggplot ################################################### library(ggplot2) qplot(Sepal.Length, Sepal.Width, data=iris, color=Species) ################################################### ### code chunk number 3: griddetail (eval = FALSE) ################################################### ## library(grid) ## grid.lines(x, y, gp=gpar(col="grey50", lwd=40, ## lineend="square", ## linejoin="mitre")) ################################################### ### code chunk number 4: grid ################################################### x <- c(.4, .6, .4) y <- c(.2, .5, .8) library(grid) grid.lines(x, y, gp=gpar(col="grey50", lwd=40, lineend="square", linejoin="mitre")) grid.points(x, y, default="npc", pch=16, gp=gpar(cex=0.5)) grid.lines(x - .3, y, gp=gpar(lwd=40, col="gray50")) # lineend="round", linejoin="round" grid.points(x - .3, y, default="npc", pch=16, gp=gpar(cex=0.5)) grid.lines(x + .3, y, gp=gpar(lwd=40, lineend="butt", linejoin="bevel", col="gray50")) grid.points(x + .3, y, default="npc", pch=16, gp=gpar(cex=0.5)) ################################################### ### code chunk number 5: gore.Rnw:165-181 ################################################### outline <- function(x, y, col="black") { n <- length(x) for (i in 1:n) { start <- i if (i == n) end <- 1 else end <- i + 1 grid.segments(x[start], y[start], x[end], y[end], default="native", arrow=arrow(angle=10, length=unit(5, "mm"), type="closed"), gp=gpar(col=col, fill=col)) } } ################################################### ### code chunk number 6: polygon ################################################### t <- seq(0, 2*pi, length=6)[-6] x <- cos(t) y <- sin(t) # grid.newpage() pushViewport(viewport(layout=grid.layout(1, 3, respect=TRUE))) pushViewport(viewport(layout.pos.col=1, xscale=c(-1, 1), yscale=c(-1, 1))) grid.polygon(x, y, default="native", gp=gpar(fill="grey")) outline(x, y) popViewport() pushViewport(viewport(layout.pos.col=2, xscale=c(-1, 1), yscale=c(-1, 1))) grid.polygon(x[c(1, 5, 2, 4, 3)], y[c(1, 5, 2, 4, 3)], default="native", gp=gpar(fill="grey")) outline(x[c(1, 5, 2, 4, 3)], y[c(1, 5, 2, 4, 3)]) popViewport() pushViewport(viewport(layout.pos.col=3, xscale=c(-1, 1), yscale=c(-1, 1))) grid.path(c(x, .5*x), c(y, .5*y), id.lengths=rep(5, 2), rule="evenodd", default="native", gp=gpar(fill="grey")) outline(x, y) outline(.5*x, .5*y) popViewport() ################################################### ### code chunk number 7: fillrule ################################################### x <- c(0, 0, .8, .2, 1, 1) y <- c(0, 1, .5, .5, 1, 0) star <- function(lab, rule, gp=gpar(col=NA, fill="black", lwd=1)) { grid.text(lab, y=unit(1, "npc"), just="bottom") pushViewport(viewport(width=.8, height=.8)) grid.path(x, y, id.lengths=c(3, 3), default="native", gp=gp, rule=rule) popViewport() } # grid.newpage() pushViewport(viewport(layout=grid.layout(1, 3, respect=TRUE))) pushViewport(viewport(layout.pos.col=1)) star("even-odd", "evenodd") popViewport() pushViewport(viewport(layout.pos.col=2), viewport(width=.8, height=.8)) xl <- split(x, rep(1:2, each=3)) yl <- split(y, rep(1:2, each=3)) for (i in 1:2) { grid.path(xl[[i]], yl[[i]], gp=gpar(fill=rgb((1:0)[i], 0, (0:1)[i], .2))) outline(xl[[i]], yl[[i]], col=rgb((1:0)[i], 0, (0:1)[i])) } popViewport(2) pushViewport(viewport(layout.pos.col=3)) star("non-zero winding", "winding") popViewport() ################################################### ### code chunk number 8: gnu ################################################### library(grImport) # PostScriptTrace("GNU.eps", "GNU.xml") gnu <- readPicture("GNU.xml") # grid.newpage() pushViewport(viewport(layout=grid.layout(1, 3, respect=TRUE))) pushViewport(viewport(layout.pos.col=1)) grid.picture(gnu) grid.rect(gp=gpar(col=NA, fill="white")) downViewport("picture.scale") brokenGNU <- explodePaths(gnu[-(1:2)]) lapply(brokenGNU@paths, function(path) { grid.polygon(path@x, path@y, default="native") }) popViewport(3) pushViewport(viewport(layout.pos.col=2)) grid.picture(gnu) grid.rect(gp=gpar(col=NA, fill="white")) downViewport("picture.scale") grid.polygon(gnu@paths[[3]]@x, gnu@paths[[3]]@y, default="native", gp=gpar(fill="black")) grid.text('grid.polygon()', y=0, just="top") popViewport(3) pushViewport(viewport(layout.pos.col=3)) grid.picture(gnu) grid.text('grid.path(rule="winding")', y=0, just="top") popViewport() ################################################### ### code chunk number 9: dataprep ################################################### library(akima) library(maps) library(gpclib) library(maptools) quakes <- read.csv("quakes-mod.csv") quakes$long <- ifelse(quakes$LONG < 0, 360 + quakes$LONG, quakes$LONG) quakes <- quakes[quakes$LAT < 0 & quakes$long < 190, ] library(MASS) qd <- kde2d(quakes$long, quakes$LAT, n=100) ql <- contourLines(qd$x, qd$y, qd$z, nlevels=10) n <- length(ql) # points(quakes$long, quakes$LAT, pch=".") outline <- map("nz", plot=FALSE) xrange <- range(outline$x, na.rm=TRUE) yrange <- range(outline$y, na.rm=TRUE) xbox <- xrange + c(-2, 2) ybox <- yrange + c(-2, 2) hue <- 240 ################################################### ### code chunk number 10: nzfinal ################################################### par(mar=rep(2, 4)) # Plot the data map("nz") mapply(function(c, col) { polygon(c, col=col, border=adjustcolor(col, 1, .9, .9, .9)) }, ql, as.list(hcl(hue, 50, 20 + 60*n:1/(n+1)))) # grey(.7*n:1/(n+1) + .2))) polypath(c(outline$x, NA, c(xbox, rev(xbox))), c(outline$y, NA, rep(ybox, each=2)), col="white", rule="evenodd") points(quakes$long[quakes$MAG > 7], quakes$LAT[quakes$MAG > 7], pch=21, bg=hcl(hue - 180, 80, 80)) box() ################################################### ### code chunk number 11: nzpoints ################################################### par(mar=rep(2, 4)) map("nz", col=NA) points(quakes$long[quakes$MAG > 7], quakes$LAT[quakes$MAG > 7], pch=21, bg=hcl(hue - 180, 50, 80)) box() ################################################### ### code chunk number 12: gore.Rnw:402-403 (eval = FALSE) ################################################### ## points(x, y, ...) ################################################### ### code chunk number 13: nzmap ################################################### par(mar=rep(2, 4)) # Plot the data map("nz") box() ################################################### ### code chunk number 14: gore.Rnw:433-435 (eval = FALSE) ################################################### ## library(maps) ## map("nz") ################################################### ### code chunk number 15: nzcontour ################################################### par(mar=rep(2, 4)) # Plot the data map("nz", col=NA) mapply(function(c, col) { polygon(c, col=col, border=adjustcolor(col, 1, .9, .9, .9)) }, ql, as.list(hcl(hue, 50, 20 + 60*n:1/(n+1)))) box() ################################################### ### code chunk number 16: gore.Rnw:470-473 (eval = FALSE) ################################################### ## mapply(polygon, ## contourLines(...), ## col=...) ################################################### ### code chunk number 17: nzmappath ################################################### par(mar=rep(2, 4)) map("nz", col="grey", fill=TRUE) ################################################### ### code chunk number 18: gore.Rnw:501-505 (eval = FALSE) ################################################### ## outline <- map("nz", ## plot=FALSE) ## polypath(outline, ## rule="evenodd") ################################################### ### code chunk number 19: nzpathbox ################################################### par(mar=rep(2, 4)) map("nz", col=NA) polypath(c(outline$x, NA, c(xbox, rev(xbox))), c(outline$y, NA, rep(ybox, each=2)), col="white", rule="evenodd") box() ################################################### ### code chunk number 20: gore.Rnw:537-542 (eval = FALSE) ################################################### ## xrange <- range(outline$x) ## xbox <- xrange + c(-2, 2) ## path$x <- c(outline$x, NA, ## c(xbox, ## rev(xbox))) ################################################### ### code chunk number 21: nzpathfill ################################################### par(mar=rep(2, 4)) map("nz", col=NA) polypath(c(outline$x, NA, c(xbox, rev(xbox))), c(outline$y, NA, rep(ybox, each=2)), col="grey", rule="evenodd") box() ################################################### ### code chunk number 22: gore.Rnw:575-577 (eval = FALSE) ################################################### ## polypath(path, ## rule="evenodd") ################################################### ### code chunk number 23: nzoverlaycontour ################################################### par(mar=rep(2, 4)) # P1 map("nz", col=NA) mapply(function(c, col) { polygon(c, col=col, border=adjustcolor(col, 1, .9, .9, .9)) }, ql, as.list(hcl(hue, 50, 20 + 60*n:1/(n+1)))) box() ################################################### ### code chunk number 24: gore.Rnw:611-614 (eval = FALSE) ################################################### ## mapply(polygon, ## contourLines(...), ## col=...) ################################################### ### code chunk number 25: nzoverlaypath ################################################### par(mar=rep(2, 4)) # P1 map("nz", col=NA) mapply(function(c, col) { polygon(c, col=col, border=adjustcolor(col, 1, .9, .9, .9)) }, ql, as.list(hcl(hue, 50, 20 + 60*n:1/(n+1)))) polypath(c(outline$x, NA, c(xbox, rev(xbox))), c(outline$y, NA, rep(ybox, each=2)), col="white", rule="evenodd") box() ################################################### ### code chunk number 26: gore.Rnw:652-657 (eval = FALSE) ################################################### ## mapply(polygon, ## contourLines(...), ## col=...) ## polypath(path, ## rule="evenodd") ################################################### ### code chunk number 27: nzoverlaypoints ################################################### par(mar=rep(2, 4)) map("nz", col=NA) mapply(function(c, col) { polygon(c, col=col, border=adjustcolor(col, 1, .9, .9, .9)) }, ql, as.list(hcl(hue, 50, 20 + 60*n:1/(n+1)))) polypath(c(outline$x, NA, c(xbox, rev(xbox))), c(outline$y, NA, rep(ybox, each=2)), col="white", rule="evenodd") points(quakes$long[quakes$MAG > 7], quakes$LAT[quakes$MAG > 7], pch=21, bg=hcl(hue - 180, 50, 80)) box() ################################################### ### code chunk number 28: gore.Rnw:696-702 (eval = FALSE) ################################################### ## mapply(polygon, ## contourLines(...), ## col=...) ## polypath(path, ## rule="evenodd") ## points(x, y, ...) ################################################### ### code chunk number 29: gore.Rnw:725-789 ################################################### library(png) png("worldsmall.png", width=600, height=300) worldsmall <- readPNG(system.file("textures/worldsmall.png",package="rgl")) grid.raster(worldsmall) dev.off() png("worldsmall-grid.png", width=600, height=300) worldsmall <- readPNG(system.file("textures/worldsmall.png",package="rgl")) grid.raster(worldsmall) grid.rect(x=rep(0:19/20, 20), y=rep(0:19/20, each=20), width=1/20, height=1/20, just=c("left", "bottom"), gp=gpar(fill=NA)) dev.off() library(rgl) lat <- matrix(seq(90,-90, len=20)*pi/180, 20, 20, byrow=TRUE) long <- matrix(seq(-180, 180, len=20)*pi/180, 20, 20) r <- 6378.1 # radius of Earth in km x <- r*cos(lat)*cos(long) y <- r*cos(lat)*sin(long) z <- r*sin(lat) open3d(windowRect=c(0, 0, 300, 300)) clear3d("all") light3d() persp3d(x, y, z, col="white", axes=FALSE, box=FALSE, xlab="", ylab="", zlab="", normal_x=x, normal_y=y, normal_z=z) par3d(userMatrix=rotationMatrix(-pi/2, 1, 0, 0)%*% rotationMatrix(-30/180*pi, 0, 0, 1)%*% rotationMatrix(45/180*pi, 1, 0, 0), zoom=2/3) snapshot3d("sphere.png") open3d(windowRect=c(0, 0, 300, 300)) clear3d("all") material3d(shininess=100, specular="black") persp3d(x, y, z, col="black", front="line", back="culled", axes=FALSE, box=FALSE, xlab="", ylab="", zlab="", normal_x=x, normal_y=y, normal_z=z) par3d(userMatrix=rotationMatrix(-pi/2, 1, 0, 0)%*% rotationMatrix(-30/180*pi, 0, 0, 1)%*% rotationMatrix(45/180*pi, 1, 0, 0), zoom=2/3) snapshot3d("sphereWire.png") open3d(windowRect=c(0, 0, 300, 300)) clear3d("all") light3d() persp3d(x, y, z, col="white", texture=system.file("textures/worldsmall.png",package="rgl"), specular="black", axes=FALSE, box=FALSE, xlab="", ylab="", zlab="", normal_x=x, normal_y=y, normal_z=z) par3d(userMatrix=rotationMatrix(-pi/2, 1, 0, 0)%*% rotationMatrix(-30/180*pi, 0, 0, 1)%*% rotationMatrix(45/180*pi, 1, 0, 0), zoom=2/3) snapshot3d("sphereTexture.png") ################################################### ### code chunk number 30: gore.Rnw:873-921 ################################################### load("RData_forpaul") nrz <- nrow(z) ncz <- ncol(z) color <- colorRampPalette(c("blue", "white", "red"))(16) zfacet <- 0.25*(z[-1, -1] + z[-1, -ncz] + z[-nrz, -1] + z[-nrz, -ncz]) facetcol <- cut(zfacet,breaks=c(-7,-4,seq(-3,3,by=0.5),4,7)) library(maps) customFC <- function(x, y, z, col, levels) { par(mar = rep(0, 4)) plot.new() plot.window(range(x, finite=TRUE), range(y, finite=TRUE), "", xaxs="i", yaxs="i", asp=NA) .Internal(filledcontour(as.double(x), as.double(y), z, as.double(levels), col=col)) } # Do a PNG of filled.contour with world map png("world.png", width=600, height=300) customFC(x, y, z, col=color, levels=c(-7, -4, seq(-3, 3, by=0.5), 4, 7)) map("world", add=TRUE, interior=FALSE) dev.off() xx <- matrix(x, nrow=length(x), ncol=length(y)) yy <- matrix(2*rev(y), nrow=length(x), ncol=length(y), byrow=TRUE) zz <- z[, dim(z)[2]:1] open3d(windowRect=c(0, 0, 900, 900)) clear3d("all") light3d() persp3d(x, y, z, zlim=c(-10, 10), aspect=c(1, .5, 1), col="white", specular="black", texture="world.png", texture_s=matrix(1:128/129, 128, 64), texture_t=matrix(1:64/65, 128, 64, byrow=TRUE), axes=FALSE, box=FALSE, xlab="", ylab="", zlab="") par3d(userMatrix=rotationMatrix(-pi/2, 1, 0, 0)%*% rotationMatrix(15/180*pi, 1, 0, 0)%*% rotationMatrix(50/180*pi, 0, 0, 1)%*% rotationMatrix(30/180*pi, 1, 0, 0), zoom=.75) snapshot3d("heatmapTexture.png") ################################################### ### code chunk number 31: gore.Rnw:941-965 ################################################### pdf("heatmap.pdf") customFC(x, y, z, col=color, levels=c(-7, -4, seq(-3, 3, by=0.5), 4, 7)) dev.off() pdf("worldmap.pdf", height=3.5) par(mar=rep(0, 4)) map("world", interior=FALSE) dev.off() open3d(windowRect=c(0, 0, 900, 900)) clear3d("all") light3d() persp3d(x, y, z, front="fill", back="fill", col="white", zlim=c(-10, 10), aspect=c(1, .5, 1), axes=FALSE, box=FALSE, xlab="", ylab="", zlab="") par3d(userMatrix=rotationMatrix(-pi/2, 1, 0, 0)%*% rotationMatrix(15/180*pi, 1, 0, 0)%*% rotationMatrix(50/180*pi, 0, 0, 1)%*% rotationMatrix(30/180*pi, 1, 0, 0), zoom=.75) snapshot3d("surface.png") ################################################### ### code chunk number 32: gore.Rnw:1061-1080 ################################################### open3d(windowRect=c(0, 0, 900, 900)) clear3d("all") light3d() persp3d(x, y, z, front="fill", back="fill", col="white", zlim=c(-10, 10), aspect=c(1, .5, 1), axes=FALSE, box=FALSE, xlab="", ylab="", zlab="") material3d(alpha=.8) surface3d(x, y, matrix(4, nrow=length(x), ncol=length(y)), col="white", specular="black", texture="world.png", texture_s=matrix(1:128/129, 128, 64), texture_t=matrix(1:64/65, 128, 64, byrow=TRUE)) par3d(userMatrix=rotationMatrix(-pi/2, 1, 0, 0)%*% rotationMatrix(15/180*pi, 1, 0, 0)%*% rotationMatrix(50/180*pi, 0, 0, 1)%*% rotationMatrix(30/180*pi, 1, 0, 0), zoom=.75) snapshot3d("combine.png") ################################################### ### code chunk number 33: gore.Rnw:1111-1112 ################################################### rgb(.8, .6, .4) ################################################### ### code chunk number 34: rgb ################################################### grid.rect(gp=gpar(fill=rgb(.8, .6, .4))) ################################################### ### code chunk number 35: gore.Rnw:1155-1156 ################################################### hcl(46, 55, 67) ################################################### ### code chunk number 36: gore.Rnw:1181-1183 ################################################### options(width=50) ################################################### ### code chunk number 37: gore.Rnw:1184-1185 ################################################### hcl(46, 55, seq(10, 90, 10)) ################################################### ### code chunk number 38: hcl ################################################### grid.circle(x=1:9/10, r=unit(1, "cm"), gp=gpar(col=NA, fill=hcl(46, 55, seq(10, 90, 10)))) ################################################### ### code chunk number 39: oz ################################################### library(oz) 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 40: ozregions ################################################### library(oz) par(mar=rep(1, 4)) oz() ################################################### ### code chunk number 41: gore.Rnw:1306-1308 (eval = FALSE) ################################################### ## library(oz) ## oz() ################################################### ### code chunk number 42: gore.Rnw:1330-1331 (eval = FALSE) ################################################### ## hcl(46, 55, 4*popDens) ################################################### ### code chunk number 43: ozcolours ################################################### grid.circle(x=1:7/8, r=unit(1, "cm"), gp=gpar(col=NA, fill=hcl(46, 55, 4*sort(popDens)))) ################################################### ### code chunk number 44: gore.Rnw:1357-1358 (eval = FALSE) ################################################### ## ifelse(4*popDens < 80, "white", "black") ################################################### ### code chunk number 45: oztext ################################################### grid.circle(x=1:7/8, r=unit(1, "cm"), gp=gpar(col=NA, fill=hcl(46, 55, 4*sort(popDens)))) grid.text(round(sort(popDens)), x=1:7/8, gp=gpar(col=ifelse(4*sort(popDens) < 80, "white", "black"))) ################################################### ### code chunk number 46: gore.Rnw:1380-1383 (eval = FALSE) ################################################### ## polygon(australia$states, col=hcl(46, 55, 4*popDens)) ## text(cntr[1], cntr[2], round(popDens), ## col=ifelse(4*popDens < 80, "white", "black")) ################################################### ### code chunk number 47: gore.Rnw:1458-1475 ################################################### key <- function(key, filename=key) { pdf(paste(filename, ".pdf", sep=""), width=1/4, height=1/4) grid.roundrect(width=.8, height=.8) grid.text(key) dev.off() } key("A") key("B") key("C") key("D") key("0", filename="zero") key("!", filename="exclam") key("&", filename="ampersand") key("\\", filename="slash") key("2", filename="two") key("6", filename="six") key("1", filename="one") ################################################### ### code chunk number 48: gore.Rnw:1530-1531 (eval = FALSE) ################################################### ## curve(20*(3*log(1-x) + log(x))) ################################################### ### code chunk number 49: curve ################################################### par(mar=c(2, 3, 2, 2)) curve(20*(3*log(1-x) + log(x)), 0.01, .9, xlab="", ylab="", axes=FALSE) box() ################################################### ### code chunk number 50: scriptl (eval = FALSE) ################################################### ## grid.text("\200", gp=gpar(fontfamily="special")) ################################################### ### code chunk number 51: lscriptfont (eval = FALSE) ################################################### ## lscriptFont <- ## Type1Font(family="special", ## metrics=c("./cmmi10.afm", ## "Helvetica-Bold.afm", ## "Helvetica-Oblique.afm", ## "Helvetica-BoldOblique.afm"), ## encoding="./special") ## pdfFonts(special=lscriptFont) ################################################### ### code chunk number 52: scriptl ################################################### lscriptFont <- Type1Font(family="special", metrics=c("./cmmi10.afm", "Helvetica-Bold.afm", "Helvetica-Oblique.afm", "Helvetica-BoldOblique.afm"), encoding="./special") pdfFonts(special=lscriptFont) Sys.setlocale("LC_CTYPE", "en_NZ.iso-8859-1") grid.text("\200", gp=gpar(fontfamily="special")) ################################################### ### code chunk number 53: gore.Rnw:1651-1652 (eval = FALSE) ################################################### ## lscriptFont <- ## Type1Font(family="special", ## metrics=c("./cmmi10.afm", ## "Helvetica-Bold.afm", ## "Helvetica-Oblique.afm", ## "Helvetica-BoldOblique.afm"), ## encoding="./special") ## pdfFonts(special=lscriptFont) ################################################### ### code chunk number 54: lscript (eval = FALSE) ################################################### ## mtext("\200", side=2, line=1, cex=1.5, ## family="special") ################################################### ### code chunk number 55: gore.Rnw:1662-1673 ################################################### pdf("ell.pdf", width=5, height=4) par(mar=c(2, 3, 2, 2)) curve(20*(3*log(1-x) + log(x)), 0.01, .9, xlab="", ylab="", axes=FALSE) mtext("\200", side=2, line=1, cex=1.5, family="special") mtext(expression(italic(p)), side=1, line=1) box() dev.off() embedFonts("ell.pdf", out="ellEmbedded.pdf", fontpaths=".") ################################################### ### code chunk number 56: gore.Rnw:1682-1684 (eval = FALSE) ################################################### ## curve(20*(3*log(1-x) + log(x)), axes=FALSE) ## mtext("\200", side=2, family="special") ################################################### ### code chunk number 57: gore.Rnw:1704-1705 (eval = FALSE) ################################################### ## segments(.5, 0, .5, runif(1), lwd=10) ################################################### ### code chunk number 58: badend ################################################### # From R-help 2011-06-17 from Frank Harrell set.seed(1) par(mfrow=c(2, 2), mar=rep(.5, 4), oma=rep(2, 4), yaxs="i", xpd=NA) plot.new() grid.rect(gp=gpar(col=NA, fill="grey")) rect(0, 0, 1, 1, col="white", border=NA) segments(.5, 0, .5, runif(1), lwd=10) mtext("x3", side=2, line=1) mtext("x1", side=3, line=1) plot.new() rect(0, 0, 1, 1, col="white", border=NA) segments(.5, 0, .5, runif(1), lwd=10) mtext("x3", side=4, line=1) mtext("x2", side=3, line=1) mtext("x2", side=1, line=1) plot.new() rect(0, 0, 1, 1, col="white", border=NA) segments(.5, 0, .5, runif(1), lwd=10) mtext("x2", side=2, line=1) mtext("x2", side=4, line=1) mtext("x1", side=1, line=1) library(grid) # grid.rect(width=.99, height=.99) ################################################### ### code chunk number 59: gore.Rnw:1752-1753 (eval = FALSE) ################################################### ## segments(.5, 0, .5, runif(1), lwd=10, lend="butt") ################################################### ### code chunk number 60: happyend ################################################### set.seed(1) par(mfrow=c(2, 2), mar=rep(.5, 4), oma=rep(2, 4), yaxs="i", xpd=NA) plot.new() library(grid) grid.rect(gp=gpar(col=NA, fill="grey")) rect(0, 0, 1, 1, col="white", border=NA) segments(.5, 0, .5, runif(1), lwd=10, lend="butt") mtext("x3", side=2, line=1) mtext("x1", side=3, line=1) plot.new() rect(0, 0, 1, 1, col="white", border=NA) segments(.5, 0, .5, runif(1), lwd=10, lend="butt") mtext("x3", side=4, line=1) mtext("x2", side=3, line=1) mtext("x2", side=1, line=1) plot.new() rect(0, 0, 1, 1, col="white", border=NA) segments(.5, 0, .5, runif(1), lwd=10, lend="butt") mtext("x2", side=2, line=1) mtext("x2", side=4, line=1) mtext("x1", side=1, line=1) # grid.rect(width=.99, height=.99)