STATS 787
Grid Graphics

Reminders

  • Class Rep

Grid Graphics

  • R package {grid}
library(grid)

grid.rect()

grid.rect(width=.1, height=.2)

grid.segments(0, .5, 1, .5)
grid.rect(width=.1, height=.2, just="bottom")

grid.rect(x=1:3/4, y=0, width=.1, height=c(.2, .6, .4), just="bottom")

grid.rect(x=1:3/4, y=0, width=.1, height=c(.2, .6, .4), just="bottom",
          gp=gpar(lwd=3, fill="grey"))

grid.rect(x=1:3/4, y=0, width=.1, height=c(.2, .6, .4), just="bottom",
          gp=gpar(lwd=3, fill=2:4))

grid.rect(x=1:3/4, y=0, height=c(.2, .6, .4), just="bottom",
          width=unit(1, "in"),
          gp=gpar(lwd=3, fill=2:4))

grid.rect(x=unit(1:3/4, "npc"), y=unit(0, "npc"),
          height=unit(c(.2, .6, .4), "npc"), width=unit(1, "in"),
          just="bottom",
          gp=gpar(lwd=3, fill=2:4))

pushViewport(viewport(width=.8, height=.8))
grid.rect(gp=gpar(col="grey"))
grid.rect(x=1:3/4, y=0, height=c(.2, .6, .4), just="bottom",
          width=unit(1, "in"),
          gp=gpar(lwd=3, fill=2:4))
upViewport()

bars <- rectGrob(x=1:3/4, y=0, height=c(.2, .6, .4), 
                 width=unit(1, "in"), just="bottom",
                 gp=gpar(lwd=3, fill=2:4))
labels <- textGrob(letters[1:3], 1:3/4, y=unit(-1, "lines"))

pushViewport(viewport(width=.8, height=.8))
grid.rect(gp=gpar(col="grey"))
grid.draw(bars)
grid.draw(labels)
upViewport()

plot <- grobTree(bars, labels,
                 textGrob("A Bar Plot!", 
                          x=0, y=unit(1, "npc") + unit(1, "lines"),
                          just="left"))

pushViewport(viewport(width=.8, height=.8))
grid.rect(gp=gpar(col="grey"))
grid.draw(plot)
upViewport()

vp <- viewport(width=.8, height=.8, 
               yscale=c(0, 100))
bars <- rectGrob(x=1:3/4, y=0, 
                 height=unit(c(20, 60, 40), "native"),
                 width=unit(1, "in"), just="bottom",
                 gp=gpar(lwd=3, fill=2:4))
ticks <- segmentsGrob(0, unit(seq(0, 100, 20), "native"),
                      1, unit(seq(0, 100, 20), "native"),
                      gp=gpar(col="grey"))
tickLabels <- textGrob(seq(0, 100, 20),
                       x=unit(-1, "lines"),
                       y=unit(seq(0, 100, 20), "native"))
plot <- grobTree(labels, ticks, tickLabels, bars, 
                 textGrob("A Bar Plot!", 
                          x=0, y=unit(1, "npc") + unit(1, "lines"),
                          just="left"))

pushViewport(vp)
grid.rect(gp=gpar(col="grey"))
grid.draw(plot)
upViewport()

library(ggplot2)
gg <- ggplot(mtcars) +
    geom_point(aes(disp, mpg))
grid.newpage()
pushViewport(viewport(x=0, width=.5, just="left"))
print(gg, newpage=FALSE)

grid.newpage()
pushViewport(viewport(x=0, width=.5, just="left"))
print(gg, newpage=FALSE)
upViewport()
pushViewport(viewport(x=.5, width=.5, just="left"))
grid.raster(jpeg::readJPEG("Dino_246_GT.jpg"))

https://commons.wikimedia.org/wiki/File:Dino_246_GT_%2824627987921%29.jpg

library(gggrid)
dino <- rasterGrob(jpeg::readJPEG("Dino_246_GT.jpg"))
ggplot(mtcars) +
    grid_panel(dino) +
    geom_point(aes(disp, mpg))

library(gggrid)
car <- grobTree(dino,
                rectGrob(gp=gpar(col=NA, fill=rgb(1,1,1,.8))))
ggplot(mtcars) +
    grid_panel(car) +
    geom_point(aes(disp, mpg))

library(gggrid)
point <- function(data, coords) {
    rasterGrob(jpeg::readJPEG("Dino_246_GT.jpg"),
               coords$x, coords$y, width=.1)
}
ggplot(mtcars) +
    grid_panel(point, aes(disp, mpg))

grad <- radialGradient(rgb(0, 0, 0, c(1,0)))
blob <- function(x, y) {
    vp <- viewport(x, y, width=.1, height=.1,
                   mask=rectGrob(gp=gpar(col=NA, fill=grad)))
    rasterGrob(jpeg::readJPEG("Dino_246_GT.jpg"), vp=vp)
}
point <- function(data, coords) {
    do.call(grobTree, mapply(blob, coords$x, coords$y, SIMPLIFY=FALSE))
}

ggplot(mtcars) +
    grid_panel(point, aes(disp, mpg))

makeContent.blob <- function(x) {
    vp1 <- viewport(width=unit(1, "snpc"), height=unit(1, "snpc"))
    vp2 <- viewport()
    mask <- grobTree(defineGrob(rectGrob(gp=gpar(col=NA, fill=grad)),
                                name="blobmask", vp=vp1),
                     useGrob("blobmask", vp=vp2))
    vp <- viewport(x$x, x$y, width=.1, height=.1, mask=mask)
    car <- rasterGrob(jpeg::readJPEG("Dino_246_GT.jpg"), vp=vp)
    setChildren(x, gList(car))
} 
blob <- function(x, y) {
    gTree(x=x, y=y, cl="blob")
}
point <- function(data, coords) {
    do.call(grobTree, mapply(blob, coords$x, coords$y, SIMPLIFY=FALSE))
}

ggplot(mtcars) +
    grid_panel(point, aes(disp, mpg))