R将布局对象的网格单元转换为本机

R convert grid units of layout object to native

我的问题与 Convert units from npc to native using grid in R 有点相关。

我试图找出某些绘图元素在 ggplot2 对象(轴、主绘图等)中的位置。我找到了以下代码:

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)

我需要的所有信息都必须在名为 l 的布局对象中。然而,这个对象的高度和宽度相当奇怪。它们通常为零,即使布局有一些吸引人的地方!我调整了 grid:::grid.show.layout 以打印其绘图的尺寸:

# 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)
}

运行 foo(l) 打印:

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

奇怪的是,用browser单步执行函数显示i = 7, j = 5 打印了中心最大的矩形,但尺寸是0cm, 0cm!原始单位(分别为 1null、1null)。

所以我的问题是,如何获取 npc/本地单位中矩形的大小/坐标?我很高兴遍历整个结构,但我想将每个矩形的单位转换为合理的单位。理想情况下,我为每个布局元素获取 grid.rect 在 npc 或设备的本机单位中绘制的四个角的位置。

有什么想法吗?

很抱歉没有完全回答你的问题,但我有一些评论可能会提供信息。 null 单位与 0cm0inch 单位不同。 null 单位是一种占位符值:首先放置所有具有其他单位的东西,然后将剩余的 space 分配给 null 个单位 object。这种划分一次发生在一个级别,因此 parent object 中的 null 单位与 child object 中的单位的解释不同。

实际 null 单位对应的内容在绘图之前是未知的:您会注意到,如果您在图形设备中调整绘图的大小,轴标题和其他元素通常保持相同大小,而面板的大小会根据 window.

的大小进行调整

对于所有其他目的,例如转换为其他单位,它们具有 zero-width/zero-height,因为首先计算其他所有内容,这解释了为什么在函数中转换这些单位时会发现零单位。

因此,除非您有精确的、预定义的绘图尺寸,否则您无法知道 'null' 单位是多少。

编辑:你的评论很有道理,我试图找出一种方法来报告以 null 单位定义的面板 grob 的确切宽度和高度,但它依赖于首先绘制绘图,所以这不是先验值。

# 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)

现在,每次绘制绘图时,您都会在控制台中看到一条文本,说明实际尺寸的绝对单位(相对于面板的原点)。

好的,所以我想出了另一个解决方案,它更适合我的需要。在我的解决方案所需的函数和库下方。 main 函数是 grid::grid.show.layout 的粗略改编,包含很多不必要的功能。虽然 teunbrand 的解决方案很优雅并且很容易看出它是正确的,但它确实需要一个来渲染图形。我的解决方案 returns 列出了每个绘图元素的单位(atm 它也呈现东西但可以被剥离)。

一些函数定义

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)
}

实际 运行 teunbrand 的解决方案和我的:

# 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