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 ______________________________________________ R-help@r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide http://www.R-project.org/posting-guide.html and provide commented, minimal, self-contained, reproducible code.