3

My problem is somewhat related to Convert units from npc to native using grid in R .

I'm trying to figure out the location of certain plot elements start in a ggplot2 object (axes, main plot, etc). I found the following code:

rm(list = ls())
library(ggplot2)
library(grid)
library(gtable)

# a dummy plot
g <- ggplot(cars, aes(x = speed, y = dist)) + 
  geom_point()
g

# a layout of each element
obj <- ggplotGrob(g)
l <- gtable:::gtable_layout(obj)
grid:::grid.show.layout(l)

All the information I need must be in the layout object called l. However, the heights and widths of this objects are rather odd. They are often zero, even though there is something draw for the layout! I tweaked grid:::grid.show.layout to print the sizes of what it's drawing:

# aside from sprintf and cat a copy of grid:::grid.show.layout
foo <- function(l, newpage = TRUE, vp.ex = 0.8, bg = "light grey", 
                cell.border = "blue", cell.fill = "light blue", cell.label = TRUE, 
                label.col = "blue", unit.col = "red", vp = NULL, ...) {
  if (!grid:::is.layout(l)) 
    stop("'l' must be a layout")
  if (newpage) 
    grid.newpage()
  if (!is.null(vp)) 
    pushViewport(vp)
  grid.rect(gp = gpar(col = NULL, fill = bg))
  vp.mid <- viewport(0.5, 0.5, vp.ex, vp.ex, layout = l)
  pushViewport(vp.mid)
  grid.rect(gp = gpar(fill = "white"))
  gp.red <- gpar(col = unit.col)
  objs <- matrix(list(), l$nrow, l$ncol)

  unitType <- "cm"
  for (i in 1L:l$nrow) for (j in 1L:l$ncol) {

    h <- convertX(x = l$heights[i, top = FALSE], unitTo = unitType)
    w <- convertY(x = l$widths[j, top = FALSE], unitTo = unitType)
    s1 <- sprintf("s1: i = %d, j = %d, height = %s, width = %s\n", i, j, h, w)
    cat(s1)

    vp.inner <- viewport(layout.pos.row = i, layout.pos.col = j)
    pushViewport(vp.inner)

    # an attempt so save the drawn objects
    objs[[i, j]] <- grid.rect(gp = gpar(col = cell.border, fill = cell.fill))
    if (cell.label) 
      grid.text(paste0("(", i, ", ", j, ")"), gp = gpar(col = label.col))
    if (j == 1) 
      grid.text(format(l$heights[i, top = FALSE], ...), 
                gp = gp.red, just = c("right", "centre"), x = unit(-0.05, 
                                                                   "inches"), y = unit(0.5, "npc"), rot = 0)
    if (i == l$nrow) 
      grid.text(format(l$widths[j, top = FALSE], ...), 
                gp = gp.red, just = c("centre", "top"), x = unit(0.5, 
                                                                 "npc"), y = unit(-0.05, "inches"), rot = 0)
    if (j == l$ncol) 
      grid.text(format(l$heights[i, top = FALSE], ...), 
                gp = gp.red, just = c("left", "centre"), x = unit(1, 
                                                                  "npc") + unit(0.05, "inches"), y = unit(0.5, 
                                                                                                          "npc"), rot = 0)
    if (i == 1) 
      grid.text(format(l$widths[j, top = FALSE], ...), 
                gp = gp.red, just = c("centre", "bottom"), x = unit(0.5, 
                                                                    "npc"), y = unit(1, "npc") + unit(0.05, "inches"), 
                rot = 0)
    popViewport()
  }
  popViewport()
  if (!is.null(vp)) 
    popViewport()
  return(objs)
}

Running foo(l) prints:

s1: i = 1, j = 1, height = 0.193302891933029cm, width = 0.193302891933029cm
...
s1: i = 7, j = 5, height = 0cm, width = 0cm
...
s1: i = 12, j = 9, height = 0.193302891933029cm, width = 0.193302891933029cm

The weird thing is, stepping through the function withbrowser shows that i = 7, j = 5 prints the biggest rectangle in the center, yet the size is 0cm, 0cm! The original units (were 1null, 1null).

So my question is, How do I obtain the sizes/ coordinates of the rectangles in npc/ native units? I'm perfectly happy iterating through the entire structure, but I would like to convert the units of each rectangle into something sensible. Ideally, I obtain for each layout element the position of the four corners drawn by grid.rect in npc or native units of the device.

Any ideas?

Vandenman
  • 3,046
  • 20
  • 33

2 Answers2

4

Sorry for not completely answering your question, but I have a few comments that could be informative. null units are not the same as 0cm or 0inch units. null units are kind of a placeholder value: first place everything that has other units, then divide the remaining space among null unit objects. This division occurs at one level at a time, so null units in a parent object are interpreted differently than those in a child object.

What actual null units correspond to is not known until the plot is drawn: you can notice if you resize your plot in the graphics device, that axes titles and other elements typically remain the same size whereas the size of your panel adjusts to the size of the window.

For all other purposes, such as conversion to other units, they have zero-width/zero-height because everything else is calculated first, explaining why you find zero units if you convert these in your function.

Hence, unless you have exact, predefined dimensions for your plot you cannot know what the 'null' units will be.

EDIT: Your comment makes sense, and I tried to figure out a way to report the exact width and height of the panel grob defined in null units, but it relies of drawing the plot first, so it's not an a priori value.

# Assume g is your plot
gt <- ggplotGrob(g)
is_panel <- grep("panel", gt$layout$name)
# Re-class the panel to a custom class
class(gt$grobs[[is_panel]]) <- c("size_reporter", class(gt$grobs[[is_panel]]))

# The grid package calls makeContent just before drawing, so we can put code 
# here that reports the size
makeContent.size_reporter <- function(x) {
  print(paste0("width: ", convertWidth(x$wrapvp$width, "cm")))
  print(paste0("height: ", convertHeight(x$wrapvp$height, "cm")))
  x
}

grid.newpage(); grid.draw(gt)

Now, everytime you draw the plot, you'll get a text in the console that says what the actual dimensions are in absolute units (relative to the origin of the panel).

teunbrand
  • 33,645
  • 4
  • 37
  • 63
  • Thanks for the reply! Luckily, in my use case the exact dimensions of the graphics device are known (i.e., I know there will be `png(width, height)` before the calling this). I read here https://stat.ethz.ch/R-manual/R-devel/library/grid/doc/grid.pdf about the `null` type and I think it should be possible to obtain a conversion to `npc`. – Vandenman Oct 15 '19 at 12:48
  • The problem is probably not converting it to `npc` because any viewport has 1x1 width/height expressed in npc. I've added some code which could allow you to figure out what the dimensions of the panel are. Feel free to adapt the code to inches if you are so inclined. – teunbrand Oct 15 '19 at 18:43
  • Thanks, the edit is extremely helpful! I did take another route in the end (see my own answer) but your solution is very elegant (and an easy way to check that my solution returns the correct numbers). – Vandenman Oct 16 '19 at 07:57
1

Okay so I came up with another solution that is slightly more convenient for my needs. Below the functions and libraries needed for my solution. Thes main function is a rough adaptation of grid::grid.show.layout and contains a lot of unnecessary functionality. Although teunbrand's solution is elegant and it's easy to see that it is correct, it does require one to render the graph. My solution returns lists with units for each plot element (atm it also renders stuff but that could be stripped).

Some function definitions

rm(list = ls())
library(ggplot2)
library(grid)
library(gtable)

# functions for alternative solution
isUnitNull <- function(x) endsWith(as.character(x), "null")
getUnitValue <- function(x) sapply(x, `[[`, 1L)

computeUnit <- function(u, all, type = c("width", "height")) {

  type <- match.arg(type)
  if (isUnitNull(u)) {
    # current unit is null
    notNull <- !isUnitNull(all)
    unew <- unit(1, "npc") - sum(all[notNull])
    if (sum(!notNull) > 1L) {
      # other units in the same row/ column also have unit null
      valU <- getUnitValue(u)
      valAll <- getUnitValue(all[!notNull])
      prop <- valU / sum(valAll)
      unew <- prop * unew
    }
  } else {
    unew <- u
  }

  if (type == "width") {
    ans <- convertWidth(unew, "npc")
  } else {
    ans <- convertHeight(unew, "npc")
  }
  return(ans)
}

convertObj <- function(obj, target) {
  return(list(
    x      = convertX(obj$x,           target), 
    y      = convertY(obj$y,           target), 
    width  = convertWidth(obj$width,   target), 
    height = convertHeight(obj$height, target),
    x0     = convertX(obj$x0,          target), 
    x1     = convertX(obj$x1,          target), 
    y0     = convertY(obj$y0,          target), 
    y1     = convertY(obj$y1,          target)
  ))
}

getCornersInPixels <- function(obj, pngWidth, pngHeight) {
  getUnitValue(obj[-(1:4)]) * c(pngWidth, pngWidth, pngHeight, pngHeight)
}

grid.show.layout.modified <- function(l, newpage = TRUE, vp.ex = 0.8, bg = "light grey", 
                                      cell.border = "blue", cell.fill = "light blue", cell.label = TRUE, 
                                      label.col = "blue", unit.col = "red", vp = NULL, targetUnit = "native", 
                                      drawNew = TRUE, ...) {
  if (!grid:::is.layout(l)) 
    stop("'l' must be a layout")
  if (newpage) 
    grid.newpage()
  if (!is.null(vp)) 
    pushViewport(vp)
  grid.rect(gp = gpar(col = NULL, fill = bg))
  vp.mid <- viewport(0.5, 0.5, vp.ex, vp.ex, layout = l)
  pushViewport(vp.mid)
  grid.rect(gp = gpar(fill = "white"))
  gp.red <- gpar(col = unit.col)
  objs <- matrix(list(), l$nrow, l$ncol)

  oldWW <- NULL
  oldHH <- NULL
  totalHeight <- unit(1, "npc")
  prevI <- 1
  for (i in 1L:l$nrow) for (j in 1L:l$ncol) {

    vp.inner <- viewport(layout.pos.row = i, layout.pos.col = j)
    pushViewport(vp.inner)

    grid.rect(gp = gpar(col = cell.border, fill = cell.fill))
    if (cell.label) 
      grid.text(paste0("(", i, ", ", j, ")"), gp = gpar(col = label.col))
    if (j == 1) 
      grid.text(format(l$heights[i, top = FALSE], ...), 
                gp = gp.red, just = c("right", "centre"), x = unit(-0.05, 
                                                                   "inches"), y = unit(0.5, "npc"), rot = 0)
    if (i == l$nrow) 
      grid.text(format(l$widths[j, top = FALSE], ...), 
                gp = gp.red, just = c("centre", "top"), x = unit(0.5, 
                                                                 "npc"), y = unit(-0.05, "inches"), rot = 0)
    if (j == l$ncol) 
      grid.text(format(l$heights[i, top = FALSE], ...), 
                gp = gp.red, just = c("left", "centre"), x = unit(1, 
                                                                  "npc") + unit(0.05, "inches"), y = unit(0.5, 
                                                                                                          "npc"), rot = 0)
    if (i == 1) 
      grid.text(format(l$widths[j, top = FALSE], ...), 
                gp = gp.red, just = c("centre", "bottom"), x = unit(0.5, 
                                                                    "npc"), y = unit(1, "npc") + unit(0.05, "inches"), 
                rot = 0)
    popViewport()

    hh <- computeUnit(l$height[i, top = FALSE], l$height, "height")
    ww <- computeUnit(l$width[j, top = FALSE], l$width, "width")
    if (j == 1L)
      totalWidth <- unit(0, "npc")
    if (i != prevI)
      totalHeight <- totalHeight - oldHH[length(oldHH)]

    x <- totalWidth + 0.5 * ww
    y <- totalHeight - 0.5 * hh
    x0 <- x - 0.5 * ww
    x1 <- x + 0.5 * ww
    y0 <- y - 0.5 * hh
    y1 <- y + 0.5 * hh
    if (drawNew) {
      grid.points(x, y, gp = gpar(cex = .75, fill = scales::alpha("orange", .5), col = "orange"))
      grid.points(x = unit.c(x0, x0, x1, x1), y = unit.c(y0, y1, y0, y1), gp = gpar(cex = .75, fill = scales::alpha("purple", .5), col = "purple"))
      grid.rect(x = x,
                y = y,
                width = ww, height = hh,
                gp = gpar(col = "green", fill = "transparent")
      )
    }
    totalWidth  <- totalWidth + ww
    oldWW <- if (length(oldWW) == 0L) ww else grid::unit.c(oldWW, ww)
    oldHH <- if (length(oldHH) == 0L) hh else grid::unit.c(oldHH, hh)
    prevI <- i
    obj <- list(x = x, y = y, width = ww, height = hh,
                x0 = x0, x1 = x1, y0 = y0, y1 = y1)
    objs[[i, j]] <- convertObj(obj, targetUnit)
  }
  popViewport()
  if (!is.null(vp)) 
    popViewport()
  return(objs)
}

Actuall run teunbrand's solution and mine:

# dummy plot
g <- ggplot(cars, aes(x = speed, y = dist)) + geom_point()

# the two lines below are only necessary so that the example is run with the same device. They should return the same numbers everywhere (although I didn't test multiple machines).
graphics.off()
dev.new(width = 300, height = 400)

### solution by teunbrand
gt <- ggplotGrob(g)
is_panel <- grep("panel", gt$layout$name)
# Re-class the panel to a custom class
class(gt$grobs[[is_panel]]) <- c("size_reporter", class(gt$grobs[[is_panel]]))

# The grid package calls makeContent just before drawing, so we can put code 
# here that reports the size
makeContent.size_reporter <- function(x, unit = "cm") {
  print(paste0("width: ",  convertWidth(x$wrapvp$width,   "cm")))
  print(paste0("height: ", convertHeight(x$wrapvp$height, "cm")))
  x
}
grid.newpage(); grid.draw(gt)
#[1] "width: 15.9234321988375cm"
# [1] "height: 8.36221461187215cm"

### alternative solution
ans2 <- grid.show.layout.modified(gtable:::gtable_layout(gt), vp.ex = 1, targetUnit = "cm")
ans2[[7, 5]][c("width", "height")] # identical to what was printed by makeContent.size_reporter
# $width
# [1] 15.9234321988375cm
# $height
# [1] 8.36221461187215cm
Vandenman
  • 3,046
  • 20
  • 33