[R] matrix operations on grobs and grid units

[baptiste auguie]

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