[R] packGrob and dynamic resizing

[baptiste auguie]

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.murrell at 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 at 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
> paul at stat.auckland.ac.nz
> http://www.stat.auckland.ac.nz/~paul/
>