Thank you Paul, I was convinced I tried this option but I obviously didn't!
In ?packGrob, the user is warned that packing grobs can be slow. In
order to quantify this, I made the following comparison of 3
functions,
- table1 uses frameGrob and packGrob
- table2 uses frameGrob but calculates the sizes manually and uses placeGrob
- table3 creates a grid.layout and draws the grobs in the different viewports.
The three functions have (almost) the same output, but the timing does
differ quite substantially !
system.time(table1(content))
# user system elapsed
# 126.733 2.414 135.450
system.time(table2(content))
# user system elapsed
# 22.387 0.508 24.457
system.time(table3(content))
# user system elapsed
# 4.868 0.124 5.695
A few questions:
- why should the placeGrob approach of table2 be 5 times slower than
table3 (pushing viewports) ?
- if so, what are the merits of using a frameGrob over creating a
layout "manually"?
- can one add some padding to the content placed with a placeGrob approach?
Best regards,
baptiste
The code follows below,
sessionInfo()
R version 2.9.2 (2009-08-24)
i386-apple-darwin8.11.1
locale:
en_GB.UTF-8/en_GB.UTF-8/C/C/en_GB.UTF-8/en_GB.UTF-8
attached base packages:
[1] stats graphics grDevices utils datasets grid methods
[8] base
############### code starts #######
library(grid)
# a few helping functions
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]])
}))
}
textii <- function(d, gp=gpar(), name="row-label-"){
function(ii)
textGrob(label=d[ii], gp=gp, name=paste(name, ii, sep=""))
}
# create a list of text grobs from a data.frame
makeContent <- function(d){
content <- as.character(unlist(c(d)))
makeOneLabel <- textii(d=content, gp=gpar(col="blue"), name="content-label-")
lg <- lapply(seq_along(content), makeOneLabel)
list(lg=lg, nrow=nrow(d), ncol=ncol(d))
}
#### the comparison starts here ####
## table1 uses grid.pack
table1 <- function(content){
gcells = frameGrob(name="table.cells",
layout = grid.layout(content$nrow, content$ncol))
label.ind <- 1 # index running accross labels
for (ii in seq(1, content$ncol, 1)) {
for (jj in seq(1, content$nrow, 1)) {
gcells = packGrob(gcells, content$lg[[label.ind]], row=jj,
col=ii,
dynamic=TRUE)
label.ind <- label.ind + 1
}
}
grid.draw(gTree(children=gList(gcells)))
}
## table2 uses grid.place
table2 <- function(content){
padding <- unit(4, "mm")
lg <- content$lg
## retrieve the widths and heights of all textGrobs (including some zeroGrobs)
wg <- lapply(lg, grobWidth) # list of grob widths
hg <- lapply(lg, grobHeight) # list of grob heights
## concatenate this units
widths.all <- do.call(unit.c, wg) # all grob widths
heights.all <- do.call(unit.c, hg) #all grob heights
## matrix-like operations on units to define the table layout
widths <- colMax.units(widths.all, content$ncol) # all column widths
heights <- rowMax.units(heights.all, content$nrow) # all row heights
gcells = frameGrob(name="table.cells",
layout = grid.layout(content$nrow, content$ncol,
width=widths+padding, height=heights+padding))
label.ind <- 1 # index running accross labels
for (ii in seq(1, content$ncol, 1)) {
for (jj in seq(1, content$nrow, 1)) {
gcells = placeGrob(gcells, content$lg[[label.ind]], row=jj,
col=ii)
label.ind <- label.ind + 1
}
}
grid.draw(gTree(children=gList(gcells)))
}
## table3 uses grid.layout
table3 <- function(content){
padding <- unit(4, "mm")
lg <- content$lg
## retrieve the widths and heights of all textGrobs (including some zeroGrobs)
wg <- lapply(lg, grobWidth) # list of grob widths
hg <- lapply(lg, grobHeight) # list of grob heights
## concatenate this units
widths.all <- do.call(unit.c, wg) # all grob widths
heights.all <- do.call(unit.c, hg) #all grob heights
## matrix-like operations on units to define the table layout
widths <- colMax.units(widths.all, content$ncol) # all column widths
heights <- rowMax.units(heights.all, content$nrow) # all row heights
cells = viewport(name="table.cells", layout =
grid.layout(content$nrow, content$ncol,
width=widths+padding, height=heights+padding) )
pushViewport(cells)
label.ind <- 1 # index running accross labels
## loop over columns and rows
for (ii in seq(1, content$ncol, 1)) {
for (jj in seq(1, content$nrow, 1)) {
## push a viewport for cell (ii,jj)
pushViewport(vp=viewport( layout.pos.row=jj, layout.pos.col=ii))
grid.draw( lg[[label.ind]]) # draw the text
upViewport()
label.ind <- label.ind + 1
}
}
upViewport()
}
content <- makeContent(head(iris))
# uncomment for timing
# content <- makeContent(iris)
pdf("test-layout.pdf", height=45)
system.time(table1(content))
# user system elapsed
# 126.733 2.414 135.450
grid.newpage()
system.time(table2(content))
# user system elapsed
# 22.387 0.508 24.457
grid.newpage()
system.time(table3(content))
# user system elapsed
# 4.868 0.124 5.695
dev.off()
############### code ends #######
#system("open test-layout.pdf")
2009/9/25 Paul Murrell <p.murr...@auckland.ac.nz>:
> Hi
>
>
> baptiste auguie wrote:
>>
>> Dear all,
>>
>> I'm trying to follow an old document to use Grid frames,
>>
>> Creating Tables of Text Using grid
>> Paul Murrell
>> July 9, 2003
>>
>> As a minimal example, I wrote this,
>>
>> gf <- grid.frame(layout = grid.layout(1, 1), draw = TRUE)
>> label1 <- textGrob("test", x = 0, just = "left", name="test")
>>
>> gf=placeGrob(gf, rectGrob(), row = 1, col = 1)
>> gf=packGrob(gf, label1, row = 1, col = 1)
>
>
> You need 'dynamic=TRUE' in the call to packGrob() if you want the automatic
> updating.
>
> Paul
>
>
>> grid.draw(gf)
>>
>> grid.edit("test", label = "longer text", grep=T)
>>
>> I'm a bit lost here, as I was expecting the frame to be automatically
>> adjusted to fit the new text.
>>
>> Can anyone point me in the right direction?
>>
>> 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.
>
> --
> Dr Paul Murrell
> Department of Statistics
> The University of Auckland
> Private Bag 92019
> Auckland
> New Zealand
> 64 9 3737599 x85392
> p...@stat.auckland.ac.nz
> http://www.stat.auckland.ac.nz/~paul/
>
______________________________________________
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.
