gtable tests

library(devtools)
dev_mode()

## Dev mode: ON

load_all("~/Dropbox/Projects/gtable")

## Loading gtable

Craete an empty frame for use later:

gtf <- gtable_matrix("gtf", matrix(rep(list(rectGrob(gp = gpar(fill = "grey95"))), 
    4), nrow = 2), widths = unit(rep(4, 2), "cm"), heights = unit(rep(4, 2), 
    "cm"))

Default

# List of 4 grobs
gs <- lapply(1:4, function(x) rectGrob(width = unit(x/2, "cm"), height = unit(x/2, "cm"),
                                       gp = gpar(fill = rainbow(4)[x])))

# Put them in a gtable matrix
gt <- gtable_matrix("gt", matrix(gs, nrow = 2), 
                    widths = unit(rep(4, 2), "cm"), heights = unit(rep(4, 2), "cm"))

grid.newpage()
grid.draw(gtf)
grid.draw(gt)

Justification by setting just in grobs

gs <- lapply(1:4, function(x) rectGrob(width = unit(x/2, "cm"), height = unit(x/2, "cm"),
                                       y = 0, just = "bottom",
                                       gp = gpar(fill = rainbow(4)[x])))
gt <- gtable_matrix("gt", matrix(gs, nrow = 2), 
                    widths = unit(rep(4, 2), "cm"), heights = unit(rep(4, 2), "cm"))

grid.newpage()
grid.draw(gtf)
grid.draw(gt)

Justifcation by setting vp in grobs

gs <- lapply(1:4, function(x) 
  rectGrob(width = unit(x/2, "cm"), height = unit(x/2, "cm"),
           gp = gpar(fill = rainbow(4)[x]),
           vp = viewport(y = 0, just = "bottom", height = unit(x/2, "cm"))))

gt <- gtable_matrix("gt", matrix(gs, nrow = 2), 
                    widths = unit(rep(4, 2), "cm"), heights = unit(rep(4, 2), "cm"))

grid.newpage()
grid.draw(gtf)
grid.draw(gt)

Justification by wrapping each grob in a gTree

gs <- lapply(1:4, function(x) 
  gTree(children = gList(rectGrob(width = unit(x/2, "cm"), height = unit(x/2, "cm"),
                                  gp = gpar(fill = rainbow(4)[x]),
                                  vp = viewport(height = unit(x/2, "cm"), y = 0, just = "bottom")))))

gt <- gtable_matrix("gt", matrix(gs, nrow = 2), 
                    widths = unit(rep(4, 2), "cm"), heights = unit(rep(4, 2), "cm"))

grid.newpage()
grid.draw(gtf)
grid.draw(gt)

gtable inside a gtable - FAIL

# Make the smaller gtable
gsc <- lapply(1:4, function(x) rectGrob(width = unit(1, "cm"), height = unit(1, "cm"),
                                        gp = gpar(fill = rainbow(4)[x])))
gtc <- gtable_matrix("gtc", matrix(gsc, nrow = 2),
                     widths = unit(rep(1, 2), "cm"), heights = unit(rep(1, 2), "cm"))

# Make the larger gtable and put the smaller one in it
gs <- lapply(1:3, function(x) rectGrob(width = unit(x/2, "cm"), height = unit(x/2, "cm"),
                                       gp = gpar(fill = rainbow(4)[x])))
gs[[4]] <- gtc
gt <- gtable_matrix("gt", matrix(gs, nrow = 2), 
                    widths = unit(rep(4, 2), "cm"), heights = unit(rep(4, 2), "cm"))

grid.newpage()
grid.draw(gtf)

grid.draw(gt)

## Error: 'parent' must be a viewport and 'children' must be a 'vpList' in
## 'vpTree'

gtable in gtable, with justification defined by viewport - FAIL

gsc <- lapply(1:4, function(x) rectGrob(width = unit(1, "cm"), height = unit(1, "cm"),
                                        gp = gpar(fill = rainbow(4)[x])))
gtc <- gtable_matrix("gtc", matrix(gsc, nrow = 2),
                     widths = unit(rep(1, 2), "cm"), heights = unit(rep(1, 2), "cm"),
                     vp = viewport(y = 0, just = "bottom", height = sum(gtc$heights)))
gtc$just <- "bottom"


gs <- lapply(1:3, function(x) rectGrob(width = unit(x/2, "cm"), height = unit(x/2, "cm"),
                                       gp = gpar(fill = rainbow(4)[x])))

gs[[4]] <- gtc
gt <- gtable_matrix("gt", matrix(gs, nrow = 2), 
                    widths = unit(rep(4, 2), "cm"), heights = unit(rep(4, 2), "cm"))
grid.newpage()
grid.draw(gtf)

grid.draw(gt)

## Error: 'parent' must be a viewport and 'children' must be a 'vpList' in
## 'vpTree'