问题
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?
回答1:
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).
回答2:
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
来源：https://stackoverflow.com/questions/58391881/r-convert-grid-units-of-layout-object-to-native