r - R：gtable 和 ggplot 对象之间的可靠转换。如何在ggplot_build（）之后使lemon :: reposition_legend（）工作？

Question

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

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

这一切都很好，我使用lemon::reposition_legend()它并且它有效。

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

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

在下面查看我的 MWE。

首先，我加载我需要的包，并根据对这个问题shift_legend()的回答定义一个函数（使用）。reposition_legend()

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对象（根据函数文档，它也可以接受作为输入）。

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

在这里我得到这个错误：

reposition_legend(p, "center", panel = names(pnls)) 中的错误：参数中没有给出图例，或者无法从图中提取图例。

我再次尝试将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列中，并相应地对数据框进行子集化以仅显示显着的比较。在那里我可以完全控制，并且可以根据显着性改变比较的颜色，哪个组的平均值更高等等。

不久前我在这里问过这个问题，自从我完善了这个并将其包装成一个函数以来。

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

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

score 6 · Accepted Answer

我已经根据 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)

^{由reprex 包（v0.3.0）于 2020-02-19 创建}

r - R：gtable 和 ggplot 对象之间的可靠转换。如何在ggplot_build（）之后使lemon :: reposition_legend（）工作？

1 回答 1

Related

Reference