R:gtable 和 ggplot 对象之间的可靠转换。如何在 ggplot_build() 之后使lemmon::reposition_legend() 工作？

Question

我手头有一个非常复杂的案例 ggplot2 .我尝试使用 iris 用 MWE 举例说明它数据如下。

我只有方面的箱线图，并且想移动图例以占据空方面的空间。

这一切都很好，我用 lemon::reposition_legend()为此，它的工作原理。

但是，然后我必须修改情节中的一堆东西(即添加重要的测试结果和其他与此问题无关的东西)，我被迫使用 ggplot_build()为此目的，在我的输出图中。

使用后ggplot_build()要修改我的情节，我似乎无法使用 reposition_legend()再成功...

在下面查看我的 MWE。

首先我加载我需要的包，并定义一个 shift_legend()函数(使用 reposition_legend())，基于对 this question 的回答.

library(tidyr)
library(ggplot2)
library(ggplotify)
library(gtable)
library(cowplot)
library(purrr)
library(lemon)
library(grid)
shift_legend <- function(p) {
  pnls <- NULL
  if (class(p)[1] == "gtable") pnls <- p
  else if (class(p)[2] == "ggplot") pnls <- plot_to_gtable(p)
  else stop("Please provide a ggplot or a gtable object")

  pnls <- gtable_filter(pnls, "panel")
  pnls <- setNames(pnls$grobs, pnls$layout$name)
  pnls <- keep(pnls, ~identical(.x, zeroGrob()))

  res <- NULL
  if(length(pnls) > 0) res <- reposition_legend( p, "center", panel=names(pnls) )
  else res <- p
  return(res)
}

然后我加载 iris数据并用 shift_legend() 制作我的情节成功地。

data(iris)
summary(iris)
iris_long <- gather(iris, "Variable", "Value", -Species)
P <- ggplot(iris_long, aes(x=Variable, y=Value)) +
  geom_boxplot(aes(fill=Variable), position=position_dodge(.9)) +
  facet_wrap(.~Species, ncol=2) +
  theme_light() +
  theme(legend.key.size = unit(0.5, "inch"))
out_file_name <- "test.pdf"
pdf(file=out_file_name, height=10, width=10, onefile=FALSE)
print(
  grid.draw(shift_legend(P))
)
dev.off()

这会产生这个输出，直到这里都很好:

请注意，这是我希望能够重现的安排(在使用 ggplot_build 之后)，图例占据空的刻面空间。

但现在我需要使用 ggplot_build()在我的情节中添加和修改内容。之后我可以正常绘图而不使用 reposition_legend() .

P2 <- ggplot_build(P)
#Do a bunch of things here...
out_file_name2 <- "test2.pdf"
pdf.options(reset=TRUE, onefile=FALSE)
pdf(file=out_file_name2, height=10, width=10)
print(
  plot(ggplot_gtable(P2))
)
dev.off()

产生这个:


但我仍然想重新定位图例，所以我尝试使用 reposition_legend()再次转换 ggplot_built对象变成 gtable对象(根据 the function documentation，它也可以接受作为输入)。

out_file_name22 <- "test22.pdf"
pdf.options(reset=TRUE, onefile=FALSE)
pdf(file=out_file_name22, height=10, width=10)
print(
  grid.draw(shift_legend(
    ggplot_gtable(P2)
  ))
)
dev.off()

在这里我得到这个错误:

Error in reposition_legend(p, "center", panel = names(pnls)) : No legend given in arguments, or could not extract legend from plot.

我再次尝试转换 gtable对象变成 ggplot一个使用 ggplotify::as.ggplot() .这次我没有得到任何错误，但是图例没有按预期重新定位......

out_file_name222 <- "test222.pdf"
pdf.options(reset=TRUE, onefile=FALSE)
pdf(file=out_file_name222, height=10, width=10)
print(
  grid.draw(shift_legend(
    as.ggplot(ggplot_gtable(P2))
  ))
)
dev.off()

它产生这个:


请帮忙!

编辑

我尝试按照评论和答案中的建议更改工作流程，但无济于事。

被 P原图，我需要修改的是 ggplot_build(P)$data数据框。

这个数据框看起来像这样:

> ggplot_build(P)$data
[[1]]
      fill ymin lower middle upper ymax           outliers notchupper notchlower x PANEL group ymin_final ymax_final  xmin  xmax weight colour size alpha shape
1  #F8766D  1.2 1.400   1.50 1.575  1.7 1.1, 1.0, 1.9, 1.9  1.5391030  1.4608970 1     1     1        1.0        1.9 0.625 1.375      1 grey20  0.5    NA    19
2  #7CAE00  0.1 0.200   0.20 0.300  0.4           0.5, 0.6  0.2223446  0.1776554 2     1     2        0.1        0.6 1.625 2.375      1 grey20  0.5    NA    19
3  #00BFC4  4.3 4.800   5.00 5.200  5.8                     5.0893783  4.9106217 3     1     3        4.3        5.8 2.625 3.375      1 grey20  0.5    NA    19
4  #C77CFF  2.9 3.200   3.40 3.675  4.2           4.4, 2.3  3.5061367  3.2938633 4     1     4        2.3        4.4 3.625 4.375      1 grey20  0.5    NA    19
5  #F8766D  3.3 4.000   4.35 4.600  5.1                  3  4.4840674  4.2159326 1     2     1        3.0        5.1 0.625 1.375      1 grey20  0.5    NA    19
6  #7CAE00  1.0 1.200   1.30 1.500  1.8                     1.3670337  1.2329663 2     2     2        1.0        1.8 1.625 2.375      1 grey20  0.5    NA    19
7  #00BFC4  4.9 5.600   5.90 6.300  7.0                     6.0564120  5.7435880 3     2     3        4.9        7.0 2.625 3.375      1 grey20  0.5    NA    19
8  #C77CFF  2.0 2.525   2.80 3.000  3.4                     2.9061367  2.6938633 4     2     4        2.0        3.4 3.625 4.375      1 grey20  0.5    NA    19
9  #F8766D  4.5 5.100   5.55 5.875  6.9                     5.7231705  5.3768295 1     3     1        4.5        6.9 0.625 1.375      1 grey20  0.5    NA    19
10 #7CAE00  1.4 1.800   2.00 2.300  2.5                     2.1117229  1.8882771 2     3     2        1.4        2.5 1.625 2.375      1 grey20  0.5    NA    19
11 #00BFC4  5.6 6.225   6.50 6.900  7.9                4.9  6.6508259  6.3491741 3     3     3        4.9        7.9 2.625 3.375      1 grey20  0.5    NA    19
12 #C77CFF  2.5 2.800   3.00 3.175  3.6      3.8, 2.2, 3.8  3.0837922  2.9162078 4     3     4        2.2        3.8 3.625 4.375      1 grey20  0.5    NA    19
   linetype
1     solid
2     solid
3     solid
4     solid
5     solid
6     solid
7     solid
8     solid
9     solid
10    solid
11    solid
12    solid

我修改了它的方面，如 annotation (不适用于本 MWE)和 colour .

但是，如果按照建议，我尝试改变 P 的图例 之前 使用 ggplot_build()要提取和修改相关信息，我必须执行以下操作:

P2 <- as.ggplot(shift_legend(P))
ggplot_build(P2)$data

第一个命令打开一个新的绘图窗口，这是不希望的。

第二个命令产生这个:

> ggplot_build(P2)$data
[[1]]
  x y PANEL group
1 0 0     1    -1
2 1 1     1    -1

[[2]]
  PANEL group xmin xmax ymin ymax
1     1    -1    0    1    0    1

这看起来不像 data我在 P 中修改的数据框... 任何线索在哪里可以找到它，如果可能的话，在 P2现在？

编辑 2

只是为了让您看到我现实生活中的箱线图示例，了解为什么要修改 ggplot_build(P)$data对我很重要。

无法仅显示与 geom_signif() 的显着成对比较.

我所做的是使用 geom_signif()使用虚拟文本填充我可以访问的注释数据框 ggplot_build(P)$data[[3]] ，然后将我的实际重要性值添加到 $annotation列，并相应地对数据框进行子集化以仅显示重要的比较。在那里我可以完全控制，并且可以根据重要性改变比较的颜色，哪个组的平均值更高，等等。

我之前问过这个问题 here ，从那以后我已经完善了它并将它包装成一个函数。

如您所见，这与我的 shift_legend 冲突函数，因为我似乎没有找到访问 data 的方法数据框...

到目前为止，这是我对现实生活数据的了解，我将图例放在底部，但最好占用空的方面空间，尤其是因为我有更多空方面的情况。

Answer 1

我已经根据来自 OP 的更多信息修改了这个答案。

我们首先加载库并创建绘图。在这个例子中，我添加了一个额外的文本对象层，可以在结果 ggplot_built 中进行操作。对象，因为 OP 要求:

library(tidyr)
library(ggplot2)
library(ggplotify)
library(gtable)
library(cowplot)
library(purrr)
library(lemon)
library(grid)

data(iris)

iris_long   <- gather(iris, "Variable", "Value", -Species)
text_labels <- data.frame(text = "Text", x = 2, y = 3, stringsAsFactors = FALSE)

P <- ggplot(iris_long, aes(x = Variable, y = Value)) +
     geom_boxplot(aes(fill = Variable), position = position_dodge(.9)) +
     geom_text(data = text_labels, aes(x = x, y = y, label = text)) +
     facet_wrap(.~Species, ncol = 2) +
     theme_light() +
     theme(legend.key.size = unit(0.5, "inch"))

现在我们转换为 ggplot_built对象并根据需要对其进行操作。在这里，我们将通过 P2$data[[2]] 手动更改文本的颜色。

# Convert to ggplot_built
P2 <- ggplot_build(P)

# Do stuff with P2$data
P2$data[[2]]$colour <- rep("red", 3)

# We have changed P2 successfully
grid.draw(ggplot_gtable(P2))

现在我们要将图例添加到构面。我们使用 ggplot_gtable 从我们的情节中获取图例的副本。 :

P3 <- reposition_legend(ggplot_gtable(P2), "center", 
                        legend = g_legend(ggplot_gtable(P2)), 
                        panel = "panel-2-2")

然而，这产生了一个新问题:我们有正确放置的图例，但我们也有我们不再想要的旧图例:



然后我们通过找到我们不想要的 grob 并用 zerogrob 覆盖它来解决这个问题:

legend_grob <- which(sapply(P3$grobs, function(x) x$name) == "guide-box")
P3$grobs[[legend_grob]] <- zeroGrob()

现在，我们在绘图的右侧仍然会有一个我们不想要的空白区域，因此我们在右侧应用一个负填充:

P3 <- gtable_add_padding(P3, unit(c(0,-.15, 0, 0), "npc")

现在我们可以用 grid.draw 绘制结果:

grid.newpage()
grid.draw(P3)

请注意，我们保留了手动对 ggplot_built 所做的更改。目的。

所以你的函数来转换 ggplot_built对象变成一个情节，图例移动到方面将是这样的:

legend_as_facet <- function(P2)
{
  # Convert the ggplot_built object to a gtable
  P2       <- ggplot_gtable(P2)

  # Find the name of the panel on the bottom right of the plot
  panels   <- grep("panel", P2$layout$name, value = TRUE)
  panelmat <- sapply(strsplit(panels, "-"), function(x) as.numeric(x[2:3]))
  maxpanel <- paste("panel", max(panelmat[2,]), max(panelmat[2,]), sep = "-")

  # Draw the legend in the bottom right panel
  P3 <- reposition_legend(P2, "center", legend = g_legend(P2), panel = maxpanel)

  # Draw a zero grob in place of the existing legend
  legend_grob <- which(sapply(P3$grobs, function(x) x$name) == "guide-box")
  P3$grobs[[legend_grob]] <- zeroGrob()

  # Apply negative padding to remove the empty space on the right
  P3 <- gtable_add_padding(P3, unit(c(0,-.15, 0, 0), "npc"))

  # Draw the result
  grid.newpage()
  grid.draw(P3)
}

这意味着您的工作流程将是:

P2 <- ggplot_build(P)

# Do stuff with P2$data

legend_as_facet(P2)

创建于 2020-02-19 由 reprex package (v0.3.0)