gtable tests

gtable_test.r

# gtable tests

```{r setup, include=FALSE}
knit_hooks$set(optipng = hook_optipng)
```


```{r}
library(devtools)
dev_mode()
load_all('~/Dropbox/Projects/gtable')
```


Craete an empty frame for use later:

```{r}
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

```{r, width=4, height=4, tidy=FALSE, optipng=''}
# 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

```{r, width=4, height=4, tidy=FALSE, optipng=''}
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

```{r, width=4, height=4, tidy=FALSE, optipng=''}
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

```{r, width=4, height=4, tidy=FALSE, optipng=''}
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

```{r, width=4, height=4, tidy=FALSE, optipng=''}

# 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)
```


*****
# gtable in gtable, with justification defined by viewport

```{r, width=4, height=4, tidy=FALSE, optipng=''}

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"))
gtc <- editGrob(gtc, vp =  viewport(y = 0, just = "bottom", height = gtable_height(gtc)))


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)
```



```{r, width=4, height=4, tidy=FALSE, optipng=''}
# boxes alone
grid.newpage()
grid.draw(gtc)
```



# gtable on top of gtable

Both gtables are the same size, 4x4cm. One is centered; the other is bottom-justified.

```{r, width=4, height=4, tidy=FALSE, optipng=''}
grid.newpage()
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"))
grid.draw(gtf)

gs <- lapply(1:4, function(x) rectGrob(width = unit(x/2, "cm"), height = unit(x/2, "cm"),
                                       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"),
                    vp = viewport(y = 0, height = gtable_height(gt), just = "bottom"))

grid.draw(gt)
```




*****
# gtable in gtable, with some text, and justification defined by viewport

```{r, width=4, height=4, tidy=FALSE, optipng=''}

gsc <- list(textGrob("First cell", rot = 90),
            rectGrob(width = unit(1, "cm"), height = unit(1, "cm"),
              gp = gpar(fill = rainbow(4)[3])),
            textGrob("Third cell", rot = 90),
            rectGrob(width = unit(1, "cm"), height = unit(1, "cm"),
              gp = gpar(fill = rainbow(4)[4])))

gtc <- gtable_matrix("gtc", matrix(gsc, nrow = 2),
                     widths = unit(rep(1, 2), "cm"),
                     heights = unit.c(grobHeight(gsc[[1]]), grobHeight(gsc[[2]])))

gtc <- editGrob(gtc, vp =  viewport(y = 0, just = "bottom", height = gtable_height(gtc)))


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)
```