Dear list,
As a minimal test of a more complex grid layout, I'm trying to find a
clean and efficient way to arrange text grobs in a rectangular layout.
The labels may be expressions, or text with a fontsize different of
the default, which means that the cell sizes should probably be
calculated using grobWidth() and grobHeight() as opposed to simpler
stringWidth() and stringHeight(). (Correct?).
The input of this function is a vector of labels, which are arranged
into a matrix layout. Below is my current version, followed by a few
questions.
e = expression(alpha,"testing very large width", hat(beta),
integral(f(x)*dx, a, b))
rowMax.units <- function(u, nrow){ # rowMax with a fake matrix of units
matrix.indices <- matrix(seq_along(u), nrow=nrow)
do.call(unit.c, lapply(seq(1, nrow), function(ii) {
max(u[matrix.indices[ii, ]])
}))
}
colMax.units <- function(u, ncol){ # colMax with a fake matrix of units
matrix.indices <- matrix(seq_along(u), ncol=ncol)
do.call(unit.c, lapply(seq(1, ncol), function(ii) {
max(u[matrix.indices[, ii]])
}))
}
makeTableGrobs <- function(e, ncol, nrow,
just = c("center", "center"),
gpar.text = gpar(col="black", cex=1),
gpar.fill = gpar(fill = "grey95", col="white",
lwd=1.5)) {
n <- length(e) # number of labels
stopifnot(!n%%2) # only rectangular layouts
if(missing(ncol) & missing(nrow)){
nm <- n2mfrow(n) # pretty default layout
ncol = nm[1]
nrow = nm[2]
}
makeOneLabel <- function(label.ind){
textGrob(label=e[label.ind], gp=gpar.text,
name=paste("cells-label-",label.ind, sep=""))
}
lg <- lapply(seq_along(e), makeOneLabel) # list of grobs
wg <- lapply(lg, grobWidth) # list of grob widths
hg <- lapply(lg, grobHeight) # list of grob heights
widths.all <- do.call(unit.c, wg)
heights.all <- do.call(unit.c, hg)
widths <- colMax.units(widths.all, ncol)
heights <- rowMax.units(heights.all, nrow)
gcells = frameGrob(name="table.cells", vp = "cells",
layout = grid.layout(nrow, ncol, just=just,
widths = widths,
heights = heights) )
label.ind <- 1 # index running for the vector of labels
for (ii in seq(1, ncol, 1)) {
for (jj in seq(1, nrow, 1)) {
gcells = placeGrob(gcells, rectGrob(gp=gpar.fill,
name=paste("cells-fill-r",ii,
"-c",jj,sep="")),
row=jj, col=ii)
text.grob.ij = textGrob(label=e[label.ind],
gp=gpar.text, name=paste("cells-label-r",ii,
"-c",jj,sep=""))
gcells = placeGrob(gcells, text.grob.ij, row=jj, col=ii)
label.ind <- label.ind + 1
}
}
gList( gcells)
}
# tests
vp = viewport(name="cells")
grid.draw(gTree(children=makeTableGrobs(e), childrenvp=vp))
grid.newpage()
grid.draw(gTree(children=makeTableGrobs(e, 1, 4), childrenvp=vp))
grid.newpage()
grid.draw(gTree(children=makeTableGrobs(e, 4, 1), childrenvp=vp))
This works as expected, however I would like some advice before going
any further,
- because this layout seems quite common, would it make sense to
provide methods for the following objects? (i) a matrix of grobs; (ii)
a matrix of units; (iii) cbind, rbind, rowMax, colMax methods for a
matrix of units.
- is there a better, recommended way to achieve the same thing?
(examples would be great)
Any other comments are very welcome.
Best regards,
baptiste
A few amendments might make this improved code more readable,
e = expression(alpha,"testing very large width", hat(beta),
integral(f(x)*dx, a, b))
library(grid)
rowMax.units <- function(u, nrow){ # rowMax with a fake matrix of units
?matrix.indices <- matrix(seq_along(u), nrow=nrow)
?do.call(unit.c, lapply(seq(1, nrow), function(ii) {
? max(u[matrix.indices[ii, ]])
?}))
}
colMax.units <- function(u, ncol){ # colMax with a fake matrix of units
?matrix.indices <- matrix(seq_along(u), ncol=ncol)
?do.call(unit.c, lapply(seq(1, ncol), function(ii) {
? max(u[matrix.indices[, ii]])
?}))
}
makeTableGrobs <- function(e, ncol, nrow, equal.width = F, equal.height=F,
just = c("center", "center"),
? ? ? ?gpar.text = gpar(col="black", cex=1),
? ? ? ?gpar.fill = gpar(fill = "grey95", col="white",
lwd=1.5)) {
n <- length(e) # number of labels
stopifnot(!n%%2) # only rectangular layouts
if(missing(ncol) & missing(nrow)){
nm <- n2mfrow(n) ? ? ?# pretty default layout
ncol = nm[1]
nrow = nm[2]
}
makeOneLabel <- function(label.ind){
textGrob(label=e[label.ind], gp=gpar.text,
name=paste("cells-label-",label.ind, sep=""))
}
makeOneCell <- function(label.ind){
rectGrob(gp=gpar.fill, name=paste("cells-fill-",label.ind,
sep=""))
}
?lg <- lapply(seq_along(e), makeOneLabel) # list of text grobs
?lf <- lapply(seq_along(e), makeOneCell) # list of rect grobs
?wg <- lapply(lg, grobWidth) # list of grob widths
?hg <- lapply(lg, grobHeight) # list of grob heights
?widths.all <- do.call(unit.c, wg) # all grob widths
?heights.all <- do.call(unit.c, hg) ? ?#all grob heights
?widths <- colMax.units(widths.all, ncol) # all column widths
?heights <- rowMax.units(heights.all, nrow) # all row heights
?if(equal.width)
? ?widths <- rep(max(widths), length(widths))
?if(equal.height)
? ?heights <- rep(max(heights), length(heights))
?gcells = frameGrob(name="table.cells", vp = "cells",
? ?layout = grid.layout(nrow, ncol, just=just,
? ? ?widths = widths, heights = heights) )
?label.ind <- 1 ? # index running accross labels
?for (ii in seq(1, ncol, 1)) {
? ?for (jj in seq(1, nrow, 1)) {
? ? ?gcells = placeGrob(gcells, lf[[label.ind]], row=jj, col=ii)
? ? ?gcells = placeGrob(gcells, lg[[label.ind]], row=jj, col=ii)
? ? ?label.ind <- label.ind + 1
? ?}
?}
?gl = gList( gcells)
?gl
}
# tests
vp = viewport(name="cells")
g1 <- gTree(children=makeTableGrobs(e), childrenvp=vp)
g2 <- gTree(children=makeTableGrobs(e, 4, 1), childrenvp=vp)
g3 <- gTree(children=makeTableGrobs(e, 1, 4), childrenvp=vp)
g4 <- gTree(children=makeTableGrobs(e, equal.w=T), childrenvp=vp)
g5 <- gTree(children=makeTableGrobs(e, equal.h=T), childrenvp=vp)
g6 <- gTree(children=makeTableGrobs(e, equal.h=T, equal.w=T), childrenvp=vp)
source("http://gridextra.googlecode.com/svn-history/r21/trunk/R/arrange2.r")
# wrapper around grid.layout and grid.draw
arrange2(g1, g2, g3, g4, g5, g6, main="Testing different fitting
arrangements")
This works as expected, however I would like some advice before going
any further,
- because this layout seems quite common, would it make sense to
provide methods for the following objects? (i) a matrix of grobs; (ii)
a matrix of units; (iii) cbind, rbind, rowMax, colMax methods for a
matrix of units.
- is there a better, recommended way to achieve the same thing?
(examples would be great)
Any comments and suggestions are very welcome.
Best regards,
baptiste