### R code from vignette source 'image.Rnw' ################################################### ### code chunk number 1: heatmapdata (eval = FALSE) ################################################### ## # http://www2.warwick.ac.uk/fac/sci/moac/students/peter_cock/r/heatmap ## library("ALL") ## data("ALL") ## eset <- ALL[, ALL$mol.biol %in% c("BCR/ABL", "ALL1/AF4")] ## library("limma") ## f <- factor(as.character(eset$mol.biol)) ## design <- model.matrix(~f) ## fit <- eBayes(lmFit(eset,design)) ## selected <- p.adjust(fit$p.value[, 2]) < 0.05 ## esetSel <- eset[selected, ] ## library("gplots") ## ################################################### ### code chunk number 2: heatmap (eval = FALSE) ################################################### ## pdf("image-heatmap.pdf") ## heatmap.2(exprs(esetSel), col=redgreen(75), scale="row", ## key=FALSE, density.info="none", dendrogram="none", ## trace="none", lwid=c(.2, 1), lhei=c(.2, 1), ## cexRow=.3) ## dev.off() ## ################################################### ### code chunk number 3: heatmap-raster (eval = FALSE) ################################################### ## pdf("image-heatmap-raster.pdf") ## heatmap.2(exprs(esetSel), col=redgreen(75), scale="row", ## key=FALSE, density.info="none", dendrogram="none", ## trace="none", lwid=c(.2, 1), lhei=c(.2, 1), ## cexRow=.3, useRaster=TRUE) ## dev.off() ## ################################################### ### code chunk number 4: heatmap-svg (eval = FALSE) ################################################### ## svg("image-heatmap-svg.svg") ## heatmap.2(exprs(esetSel), col=redgreen(75), scale="row", ## key=FALSE, density.info="none", dendrogram="none", ## trace="none", lwid=c(.2, 1), lhei=c(.2, 1), ## cexRow=.3) ## dev.off() ## ################################################### ### code chunk number 5: interp (eval = FALSE) ################################################### ## img <- readPNG(system.file("img", "Rlogo.png", package="png")) ## ## pdf("image-logo.pdf") ## library(grid) ## grid.raster(img, interp=FALSE) ## dev.off() ## ## pdf("image-logo-interp.pdf") ## library(grid) ## grid.raster(img) ## dev.off() ## ################################################### ### code chunk number 6: image.Rnw:272-287 ################################################### library(grid) options(continue=" ") # Background data unknown <- 8.7 total <- 9.1 known <- total - unknown theta0 <- pi/4 thetaN <- theta0 + 2*pi*unknown/total theta <- seq(theta0, thetaN, length.out=100) x <- 0.3*c(0, cos(theta)) + 0.5 y <- 0.3*c(0, sin(theta)) + 0.35 ################################################### ### code chunk number 7: imgbg (eval = FALSE) ################################################### ## library(png) ## bg <- readPNG("AfterTheBombs.png") ## library(grid) ## grid.raster(bg, height=1) ################################################### ### code chunk number 8: imgpoly (eval = FALSE) ################################################### ## grid.polygon(x, y, ## gp=gpar(col=NA, ## fill=rgb(.67, 0, .11, .7))) ################################################### ### code chunk number 9: bg ################################################### library(png) bg <- readPNG("AfterTheBombs.png") library(grid) grid.raster(bg, height=1) pushViewport(viewport(width=unit(1, "snpc"), height=unit(1, "snpc"))) grid.polygon(x, y, gp=gpar(col=NA, fill=rgb(.67, 0, .11, .7))) ################################################### ### code chunk number 10: image.Rnw:337-347 (eval = FALSE) ################################################### ## png("mask.png") ## grid.polygon(x, y, gp=gpar(col=NA, fill="black")) ## dev.off() ## ## mask <- readPNG("mask.png") ## maskRaster <- as.raster(mask) ## ## bgRaster <- as.raster(bg) ## ## bgMask <- bgRaster[maskRaster == "#000000"] ################################################### ### code chunk number 11: image.Rnw:350-374 ################################################### w <- dim(bg)[2] h <- dim(bg)[1] png("mask.png", width=w, height=h) pushViewport(viewport(width=unit(1, "snpc"), height=unit(1, "snpc"))) grid.polygon(x, y, gp=gpar(col=NA, fill="black")) dev.off() mask <- readPNG("mask.png") maskRaster <- as.raster(mask) bgRaster <- as.raster(bg) # Set the pixels under the mask so that # (i) they keep the same alpha # (ii) their blue and green channels are 0 # (iii) the red corresponds to the greyscale version of the original RGB bgTemp <- bgRaster bgTemp[maskRaster != "#000000"] <- NA png("bgmask.png", width=w, height=h) grid.raster(bgTemp) dev.off() ################################################### ### code chunk number 12: image.Rnw:401-409 (eval = FALSE) ################################################### ## bgMaskRGB <- col2rgb(bgMask) ## ## bgRed <- rgb((0.3*bgMaskRGB[1, ] + ## 0.59*bgMaskRGB[2, ] + ## 0.11*bgMaskRGB[3, ]), ## 0, 0, max=255) ## ## bgRaster[maskRaster == "#000000"] <- bgRed ################################################### ### code chunk number 13: image.Rnw:412-434 ################################################### bgMask <- bgRaster[maskRaster == "#000000"] bgMaskRGB <- col2rgb(bgMask) # Rough conversion to greyscale # Y = 0.3*R + 0.59*G + 0.11*B bgRed <- rgb((0.3*bgMaskRGB[1, ] + 0.59*bgMaskRGB[2, ] + 0.11*bgMaskRGB[3, ]), 0, 0, max=255) bgTemp[maskRaster == "#000000"] <- bgRed png("bgred.png", width=w, height=h) grid.raster(bgTemp) dev.off() bgRaster[maskRaster == "#000000"] <- bgRed png("bgraster.png", width=w, height=h) grid.raster(bgRaster) dev.off() ################################################### ### code chunk number 14: onhold (eval = FALSE) ################################################### ## headText <- ## "The Department of Defense is unable to account for the use of ## $8.7 billion of the $9.1 billion it spent on reconstruction in Iraq" ## heading <- textGrob(headText, ## x=unit(0.5, "cm"), ## y=unit(3, "lines"), ## just=c("left", "top"), ## gp=gpar(col="white")) ## pushViewport(viewport(gp=gpar(cex=.8)), ## viewport(x=0.05, y=1, ## just=c("left", "top"), ## height=grobHeight(heading) + unit(4, "lines"), ## width=grobWidth(heading) + unit(1, "cm"))) ## grid.rect(gp=gpar(fill="black")) ## grid.segments(x0=unit(0.5, "cm"), ## x1=unit(1, "npc") - unit(0.5, "cm"), ## y0=unit(1, "npc") - unit(2, "lines"), ## y1=unit(1, "npc") - unit(2, "lines"), ## gp=gpar(col="grey50", lwd=2)) ## grid.text("That's 96 Percent", ## x=unit(0.5, "cm"), ## y=unit(1, "npc") - unit(1, "lines"), ## just="left", ## gp=gpar(fontface="bold", col="white")) ## grid.draw(heading) ## popViewport(2) ################################################### ### code chunk number 15: image.Rnw:527-615 ################################################### cols <- hcl(seq(0, 240, 120), 80, 70) png("plot.png", bg="grey90") with(iris, { plot(Sepal.Length, Sepal.Width, type="n") grid(lty="solid", lwd=3) points(Sepal.Length, Sepal.Width, bg=cols[Species], pch=21) box() }) dev.off() png("legendplot.png", bg="grey90") with(iris, { plot(Sepal.Length, Sepal.Width, type="n") grid(lty="solid", lwd=3) points(Sepal.Length, Sepal.Width, bg=cols[Species], pch=21) box() legend(6.25, 4.4, legend=levels(Species), pch=21, col="black", pt.bg=cols, bg="transparent", box.lwd=3, cex=1.5) }) dev.off() png("legendbad.png", bg="grey90") with(iris, { plot(Sepal.Length, Sepal.Width, type="n") grid(lty="solid", lwd=3) points(Sepal.Length, Sepal.Width, bg=cols[Species], pch=21) box() legend(6.25, 4.4, legend=levels(Species), pch=21, col="black", pt.bg=cols, bg="white", box.lwd=3, cex=1.5) }) dev.off() png("legendmask.png", bg="grey90") with(iris, { plot(Sepal.Length, Sepal.Width, type="n", ann=FALSE, axes=FALSE) legend(6.25, 4.4, legend=levels(Species), pch=21, col="black", pt.bg="black", bg="black", box.lwd=3, cex=1.5) }) dev.off() png("legendkey.png", bg="grey90") with(iris, { plot(Sepal.Length, Sepal.Width, type="n", ann=FALSE, axes=FALSE) legend(6.25, 4.4, legend=levels(Species), pch=21, col="black", pt.bg=cols, box.lwd=3, cex=1.5) }) dev.off() legendplot <- as.raster(readPNG("legendplot.png")) legendmask <- as.raster(readPNG("legendmask.png")) legendkey <- as.raster(readPNG("legendkey.png")) legendpunch <- legendplot legendpunch[legendmask == "#000000"] <- "transparent" legendfinal <- legendplot legendfinal[legendmask == "#000000"] <- legendkey[legendmask == "#000000"] png("legendpunch.png") grid.rect(gp=gpar(col=NA, fill="grey90")) grid.raster(legendpunch, interpolate=FALSE) dev.off() png("legendfinal.png") grid.rect(gp=gpar(col=NA, fill="grey90")) grid.raster(legendfinal, interpolate=FALSE) dev.off() ################################################### ### code chunk number 16: network ################################################### pc <- readPNG("Cisco/pc.png") hub <- readPNG("Cisco/hub.png") server <- readPNG("Cisco/server.png") printer <- readPNG("Cisco/printer.png") # grid.newpage() grid.curve(.5, .7, .4, .5, curvature=-1) grid.curve(.5, .7, .6, .5, curvature=-1) grid.segments(.4, .5, .2, .5) grid.segments(.4, .5, .4, .2) grid.curve(.6, .5, .8, .7, curvature=1) grid.curve(.61, .5, .8, .4, curvature=1) grid.segments(.6, .5, .6, .2) grid.raster(server, y=.7, width=.07) grid.raster(hub, x=c(.4, .6), width=.1) grid.raster(pc, x=c(.2, .8, .8), y=c(.5, .7, .4), width=.1) grid.raster(printer, x=c(.4, .6), y=.2, width=.12) ################################################### ### code chunk number 17: graph ################################################### set.seed(1) adj <- matrix(sample(0:1,10^2,T,prob=c(0.8,0.2)),10,10) library('qgraph') L <- qgraph(adj,borders=FALSE,vsize=0,labels=F,directed=F)$layout img <- readPNG(system.file("img", "Rlogo.png", package="png")) apply(L,1,function(x)rasterImage(img,x[1]-0.1,x[2]-0.1,x[1]+0.1,x[2]+0.1)) ################################################### ### code chunk number 18: lay (eval = FALSE) ################################################### ## imageLayout <- ## grid.layout(4, 5, ## widths=c(2, 1.5, 2, 1, 2.5), ## heights=c(2.5, .5, 2, 1), ## respect=TRUE) ################################################### ### code chunk number 19: layout ################################################### imageLayout <- grid.layout(4, 5, widths=c(2, 1.5, 2, 1, 2.5), heights=c(2.5, .5, 2, 1), respect=TRUE) margin <- unit(20, "mm") pushViewport(viewport(width=unit(1, "npc") - margin, height=unit(1, "npc") - margin, layout=imageLayout)) for (i in 1:4) { for (j in 1:5) { pushViewport(viewport(layout.pos.col=j, layout.pos.row=i)) grid.rect() popViewport() } } ################################################### ### code chunk number 20: treepos (eval = FALSE) ################################################### ## pushViewport(viewport(layout.pos.col=1, ## layout.pos.row=1)) ## grid.raster(treeMatrix, width=2) ################################################### ### code chunk number 21: tree ################################################### tree <- readPNG("treeThumb.png") treeRaster <- as.raster(tree) treeRGB <- col2rgb(treeRaster) treeMatrix <- t(matrix(rgb(treeRGB[1, ], treeRGB[2, ], treeRGB[3, ], 100, max=255), ncol=dim(tree)[1], nrow=dim(tree)[2])) grid.newpage() imageLayout <- grid.layout(4, 5, widths=c(2, 1.5, 2, 1, 2.5), heights=c(2.5, .5, 2, 1), respect=TRUE) margin <- unit(20, "mm") pushViewport(viewport(width=unit(1, "npc") - margin, height=unit(1, "npc") - margin, layout=imageLayout)) for (i in 1:4) { for (j in 1:5) { pushViewport(viewport(layout.pos.col=j, layout.pos.row=i)) grid.rect() popViewport() } } pushViewport(viewport(layout.pos.col=1, layout.pos.row=1)) grid.raster(treeMatrix, width=2) grid.rect(gp=gpar(lwd=3)) ################################################### ### code chunk number 22: sandpos (eval = FALSE) ################################################### ## pushViewport(viewport(layout.pos.col=1:3, ## layout.pos.row=4)) ## grid.raster(sandMatrix, width=1, height=1.5, ## y=0, just="bottom") ################################################### ### code chunk number 23: sand ################################################### sand <- readPNG("sandThumb.png") sandRaster <- as.raster(sand) sandRGB <- col2rgb(sandRaster) sandMatrix <- t(matrix(rgb(sandRGB[1, ], sandRGB[2, ], sandRGB[3, ], 100, max=255), ncol=dim(sand)[1], nrow=dim(sand)[2])) grid.newpage() imageLayout <- grid.layout(4, 5, widths=c(2, 1.5, 2, 1, 2.5), heights=c(2.5, .5, 2, 1), respect=TRUE) margin <- unit(20, "mm") pushViewport(viewport(width=unit(1, "npc") - margin, height=unit(1, "npc") - margin, layout=imageLayout)) for (i in 1:4) { for (j in 1:5) { pushViewport(viewport(layout.pos.col=j, layout.pos.row=i)) grid.rect() popViewport() } } pushViewport(viewport(layout.pos.col=1:3, layout.pos.row=4)) grid.raster(sandMatrix, width=1, height=1.5, y=0, just="bottom") grid.rect(gp=gpar(lwd=3)) ################################################### ### code chunk number 24: image.Rnw:1112-1114 (eval = FALSE) ################################################### ## library(raster) ## light <- raster("light.tif") ################################################### ### code chunk number 25: image.Rnw:1117-1119 (eval = FALSE) ################################################### ## plot(light, maxpixels=(640*640), ## col="transparent") ################################################### ### code chunk number 26: image.Rnw:1147-1155 (eval = FALSE) ################################################### ## gmap <- GetMap(c(40.78, -4.02), ## zoom=9, size=c(485, 485), ## maptype="satellite", format="png32", ## destfile="gmaptile.png") ## gmaptile <- readPNG("gmaptile.png") ## gmaprange <- XY2LatLon(gmap, ## c(-485/2, 485/2), ## c(-485/2, 485/2)) ################################################### ### code chunk number 27: image.Rnw:1158-1161 (eval = FALSE) ################################################### ## rasterImage(gmaptile, ## gmaprange[1, 2], gmaprange[1, 1], ## gmaprange[2, 2], gmaprange[2, 1]) ################################################### ### code chunk number 28: image.Rnw:1164-1219 ################################################### # Static map from # http://maps.google.com/maps/api/staticmap?center=40.78,-4.02&zoom=9&size=485x485&maptype=satellite&format=png32&sensor=true # NOTE Google's terms of service don't really cover this sort of use # http://www.google.com/permissions/guidelines.html # unless maybe it's put on the web # NOTE that this covers the range ... # Longitude: -4.68841552734375 -3.3563232421875 # Latitude: 40.27533480732468 41.28399850538595 # (see googleMapExtent.html) # Should also be able to calc that using XY2LatLon() in 'RGoogleMaps' (?) gmap <- readPNG("staticmap.png") library(raster) Lon <- -4.02 Lat <- 40.78 Test <-raster("test.tif") pdf("rasterplot.pdf") plot(Test, maxpixels=(640*640)) dev.off() pdf("rastersetup.pdf") # Set up the coordinate system plot(Test, maxpixels=(640*640), col="transparent") dev.off() png("maparrange.png", width=2100, height=2100, res=300) # Set up the coordinate system plot(Test, maxpixels=(640*640), col="transparent") # Draw the google map in the plot region rasterImage(gmap, -4.68841552734375, 40.27533480732468, -3.3563232421875, 41.28399850538595) dev.off() png("mapoverlay.png", width=2100, height=2100, res=300) # Set up the coordinate system plot(Test, maxpixels=(640*640), col="transparent") # Draw the google map in the plot region rasterImage(gmap, -4.68841552734375, 40.27533480732468, -3.3563232421875, 41.28399850538595) # Redo original plot, WITH semitransparent colours par(new=TRUE) plot(Test, maxpixels=(640*640), col=c("transparent", adjustcolor(colorRampPalette(c("white", "red"))(10), alpha.f=.3))) contour(Test, add=TRUE) dev.off() ################################################### ### code chunk number 29: image.Rnw:1248-1256 (eval = FALSE) ################################################### ## par(new=TRUE) ## colorPalette <- ## colorRampPalette(c("white", "red")) ## plot(light, maxpixels=(640*640), ## col=c("transparent", ## adjustcolor(colorPalette(10), ## alpha.f=.3))) ## contour(light, add=TRUE)