public
Last active

implementing grid.arrange using gtable

  • Download Gist
gtable_arrange.r
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
gtable_arrange <- function(..., grobs=list(), as.table=TRUE,
top = NULL, bottom = NULL,
left = NULL, right = NULL, draw=TRUE){
require(gtable)
# alias
gtable_add_grobs <- gtable_add_grob
dots <- list(...)
params <- c("nrow", "ncol", "widths", "heights",
"respect", "just", "z") # TODO currently ignored
layout.call <- intersect(names(dots), params)
params.layout <- dots[layout.call]
if(is.null(names(dots)))
not.grobnames <- FALSE else
not.grobnames <- names(dots) %in% layout.call
if(!length(grobs))
grobs <- dots[! not.grobnames ]
## figure out the layout
n <- length(grobs)
nm <- n2mfrow(n)
if(is.null(params.layout$nrow) & is.null(params.layout$ncol))
{
params.layout$nrow = nm[1]
params.layout$ncol = nm[2]
}
if(is.null(params.layout$nrow))
params.layout$nrow = ceiling(n/params.layout$ncol)
if(is.null(params.layout$ncol))
params.layout$ncol = ceiling(n/params.layout$nrow)
if(is.null(params.layout$widths))
params.layout$widths <- unit(rep(1, params.layout$ncol), "null")
if(is.null(params.layout$heights))
params.layout$heights <- unit(rep(1,params.layout$nrow), "null")
 
positions <- expand.grid(row = seq_len(params.layout$nrow),
col = seq_len(params.layout$ncol))
if(as.table) # fill table by rows
positions <- positions[order(positions$row),]
positions <- positions[seq_along(grobs), ] # n might be < ncol*nrow
## build the gtable, similar steps to gtable_matrix
gt <- gtable(name="table")
gt <- gtable_add_cols(gt, params.layout$widths)
gt <- gtable_add_rows(gt, params.layout$heights)
gt <- gtable_add_grobs(gt, grobs, t = positions$row,
l = positions$col)
## titles given as strings are converted to text grobs
if (is.character(top))
top <- textGrob(top)
if (is.character(bottom))
bottom <- textGrob(bottom)
if (is.character(right))
right <- textGrob(right, rot = -90)
if (is.character(left))
left <- textGrob(left, rot = 90)
if(!is.null(top)){
gt <- gtable_add_rows(gt, heights=grobHeight(top), 0)
gt <- gtable_add_grobs(gt, top, t=1, l=1, r=ncol(gt))
}
if(!is.null(bottom)){
gt <- gtable_add_rows(gt, heights=grobHeight(bottom), -1)
gt <- gtable_add_grobs(gt, bottom, t=nrow(gt), l=1, r=ncol(gt))
}
if(!is.null(left)){
gt <- gtable_add_cols(gt, widths=grobWidth(left), 0)
gt <- gtable_add_grobs(gt, left, t=1, b=nrow(gt), l=1, r=1)
}
if(!is.null(right)){
gt <- gtable_add_cols(gt, widths=grobWidth(right), -1)
gt <- gtable_add_grobs(gt, right, t=1, b=nrow(gt), l=ncol(gt), r=ncol(gt))
}
if(draw){
grid.newpage()
grid.draw(gt)
}
invisible(gt)
}
tests-gtable_arrange.r
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
gs <- lapply(1:7, function(ii) grobTree(rectGrob(gp=gpar(fill=ii, alpha=0.5)),
textGrob(ii)))
gtable_arrange(ncol=3, grobs=gs)
 
gtable_arrange(ncol=3, grobs=gs, top="test", bottom="bot",
left="left", right="right")
 
 
g <- gtable_arrange(ncol=3, grobs=gs, as.table=FALSE)
 
gtable_add_grobs <- gtable_add_grob # alias
g <- gtable_add_rows(g, unit(1,"line"), pos=0)
g <- gtable_add_grobs(g, lapply(paste("main #", 1:3), textGrob),
t=1, l=1:3)
grid.newpage()
grid.draw(g)
 
require(ggplot2)
grid.newpage()
g <- gtable_arrange(ncol=3, grobs=gs)
g <- gtable_add_grobs(g, textGrob("Annotation"), t=3,l=2,r=3)
grid.draw(g)

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.