Хорошо, поэтому я нашел другое решение, немного более удобное для моих нужд. Ниже приведены функции и библиотеки, необходимые для моего решения. Основная функция - это грубая адаптация grid::grid.show.layout и содержит множество ненужных функций. Хотя решение teunbrand является элегантным и легко понять, что оно правильное, оно требует визуализации графика. Мое решение возвращает списки с единицами измерения для каждого элемента сюжета (атм также визуализирует вещи, но их можно удалить).
Некоторые определения функций
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 запускает решение 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