heightDetails() gets called before final makeContext() call, yielding incorrect height.

[clauswilke]

In my efforts to write a grob that can word-wrap text, I need the grob to choose its height based on its width. I am encountering problems inserting such a grob into a gtable, because the grob's heightDetails() function is called before the grob is given its final width (i.e., before it is inserted into the table). As a consequence, the final height tends to be off.

Apologies for the somewhat longish reprex. It's the shortest I could make it. Also, I'm not entirely sure whether this is a gtable issue or a grid issue. Pinging @thomasp85 and @pmur002 since they may have input.

library(grid)
library(gtable)
library(rlang)

# a grob that draws a rectangle with fixed aspect ratio;
# chooses height based on width
aspect_grob <- function(asp, fill = "cornsilk") {
  gTree(
    asp = asp,
    fill = fill,
    cl = "aspect_grob"
  )
}

makeContext.aspect_grob <- function(x) {
  ## calculate current width in pt
  if (is.null(x$vp)) {
    width <- convertWidth(unit(1, 'npc'), 'pt', TRUE)
  } else {
    n <- current.vpPath()$n %||% 0
    pushViewport(x$vp)
    width <- convertWidth(unit(1, 'npc'), 'pt', TRUE)
    popViewport(current.vpPath()$n - n)
  }
  height <- x$asp*width

  cat("makeContext() called; width:", width, "height:", height, "\n")
  x$height <- unit(height, "pt")
  x$width <- unit(width, "pt")
  x
}

makeContent.aspect_grob <- function(x) {
  cat("makeContent() called; width:", x$width, "height:", x$height, "\n")

  g <- rectGrob(width = x$width, height = x$height, gp = gpar(fill = x$fill))
  gl <- gList(g)
  setChildren(x, gl)
}

heightDetails.aspect_grob <- function(x) {
  cat("heightDetails() called; height:", x$height, "\n")
  x$height
}

widthDetails.aspect_grob <- function(x) {
  cat("widthDetails() called; width:", x$width, "\n")
  x$width
}

grid.newpage()

asp_g <- aspect_grob(0.5)

gt <- gtable(
  widths = unit.c(unit(1, "in"), unit(1, "null")),
  heights = unit.c(grobHeight(asp_g), unit(1, "null"))
)
gt <- gtable_add_grob(gt, asp_g, t = 1, l = 2)
gt <- gtable_add_grob(gt, rectGrob(gp = gpar(fill = "palegreen")), t = 1, l = 1)
gt <- gtable_add_grob(gt, rectGrob(gp = gpar(fill = "skyblue1")), t = 2, l = 1)
gt <- gtable_add_grob(gt, rectGrob(gp = gpar(fill = "gray70")), t = 2, l = 2)
grid.draw(gt)

#> makeContext() called; width: 505.89 height: 252.945 
#> heightDetails() called; height: 252.945 
#> makeContext() called; width: 505.89 height: 252.945 
#> heightDetails() called; height: 252.945 
#> makeContext() called; width: 433.62 height: 216.81 
#> makeContent() called; width: 433.62 height: 216.81

^{Created on 2019-08-16 by the reprex package (v0.3.0)}

The problem is that the top right rectangle doesn't completely fill the available space. Its height is too small given its width. Looking at the debugging output that gets printed, we see that the final height details were based on a width of 505.89, but the final width upon drawing time is only 433.62. That causes the height of the cell to be off (too large).

[clauswilke]

This problem seems to be a fundamental limitation of how grid layouts work. Below is a reprex that recreates the same problem with just grid layout functions. Conceptually, what would be needed is that the heights are calculated only after the widths have been set, and that doesn't seem to be possible with the current API.

library(grid)
library(gtable)
library(rlang)

# a grob that draws a rectangle with fixed aspect ratio;
# chooses height based on width
aspect_grob <- function(asp, fill = "cornsilk", vp = NULL) {
  gTree(
    asp = asp,
    fill = fill,
    vp = vp,
    cl = "aspect_grob"
  )
}

makeContext.aspect_grob <- function(x) {
  ## calculate current width in pt
  if (is.null(x$vp)) {
    width <- convertWidth(unit(1, 'npc'), 'pt', TRUE)
  } else {
    n <- current.vpPath()$n %||% 0
    pushViewport(x$vp)
    width <- convertWidth(unit(1, 'npc'), 'pt', TRUE)
    popViewport(current.vpPath()$n - n)
  }
  height <- x$asp*width

  cat("makeContext() called; width:", width, "height:", height, "\n")
  x$height <- unit(height, "pt")
  x$width <- unit(width, "pt")
  x
}

makeContent.aspect_grob <- function(x) {
  cat("makeContent() called; width:", x$width, "height:", x$height, "\n")

  g <- rectGrob(width = x$width, height = x$height, gp = gpar(fill = x$fill))
  gl <- gList(g)
  setChildren(x, gl)
}

heightDetails.aspect_grob <- function(x) {
  cat("heightDetails() called; height:", x$height, "\n")
  x$height
}

widthDetails.aspect_grob <- function(x) {
  cat("widthDetails() called; width:", x$width, "\n")
  x$width
}

draw_rect <- function(fill, r, c) {
  grid.draw(
    rectGrob(
      gp = gpar(fill = fill),
      vp = viewport(layout.pos.row = r, layout.pos.col = c)
    )
  )
}

grid.newpage()

asp_g <- aspect_grob(0.5, vp = viewport(layout.pos.row = 1, layout.pos.col = 2))

lt <- grid.layout(
  2, 2, 
  widths = unit.c(unit(1, "in"), unit(1, "null")),
  heights = unit.c(grobHeight(asp_g), unit(1, "null"))
)
pushViewport(viewport(layout = lt))
#> makeContext() called; width: 505.89 height: 252.945 
#> heightDetails() called; height: 252.945 
#> makeContext() called; width: 505.89 height: 252.945 
#> heightDetails() called; height: 252.945
grid.draw(asp_g)
#> makeContext() called; width: 433.62 height: 216.81 
#> makeContent() called; width: 433.62 height: 216.81
draw_rect(fill = "palegreen", r = 1, c = 1)
draw_rect(fill = "skyblue1", r = 2, c = 1)
draw_rect(fill = "gray70", r = 2, c = 2)

^{Created on 2019-08-19 by the reprex package (v0.3.0)}

[pmur002]

Sorry, have not had time to take a close look, but this (limitation of grid) sounds right. Layout widths and heights are calculated at the same time because, for example, if respect=TRUE, they are related to each other.