R：gtable 和 ggplot 对象之间的可靠转换。如何让 lemon::reposition_legend() 在 ggplot_build() 之后工作？
R: Reliable conversion between gtable and ggplot objects. How to make lemon::reposition_legend() work after ggplot_build()?
我手头有一个非常复杂的案例 ggplot2。我尝试使用下面的 iris 数据用 MWE 来举例说明它。
我只有分面的箱线图，想移动图例以获取空分面的 space。
一切都很好，我使用 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 之后），图例采用空面 space。
但现在我需要使用 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.
我再次尝试使用 ggplotify::as.ggplot() 将 gtable 对象转换为 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
第一个命令打开了一个新的绘图window，这是不需要的。
第二个命令产生这个：
> 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
这看起来与我在 P 中修改的 data 数据框完全不同...任何线索在哪里可以找到它，如果可能的话，现在在 P2 中？
编辑 2
只是让您看到我现实生活中的箱线图示例，了解为什么修改 ggplot_build(P)$data 对我很重要。
无法仅显示与 geom_signif() 的显着成对比较。
我所做的是使用 geom_signif() 和虚拟文本来填充我可以在 ggplot_build(P)$data[[3]] 访问的注释数据框，然后将我的实际重要性值添加到 $annotation 列，并相应地对数据框进行子集以仅显示重要的比较。我有完全的控制权，可以根据显着性改变比较的颜色，哪个组的平均值更高等等。
我刚才问过这个问题，自从我完善了它并将它包装成一个函数后。
如您所见，这与我的 shift_legend 函数冲突，因为我似乎没有找到访问 data 数据框的方法...
这是我目前为止的真实生活数据，我将图例放在底部，但最好是它采用空面 space，尤其是因为我有这样的情况有更多的空面。
我已根据 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()
现在，我们的绘图右侧仍然会有空白 space，我们不想要，因此我们在右侧应用负垫：
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 package (v0.3.0)
于 2020-02-19 创建
我手头有一个非常复杂的案例 ggplot2。我尝试使用下面的 iris 数据用 MWE 来举例说明它。
我只有分面的箱线图，想移动图例以获取空分面的 space。
一切都很好，我使用 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 之后），图例采用空面 space。
但现在我需要使用 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.
我再次尝试使用 ggplotify::as.ggplot() 将 gtable 对象转换为 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
第一个命令打开了一个新的绘图window，这是不需要的。
第二个命令产生这个：
> 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
这看起来与我在 P 中修改的 data 数据框完全不同...任何线索在哪里可以找到它，如果可能的话，现在在 P2 中？
编辑 2
只是让您看到我现实生活中的箱线图示例，了解为什么修改 ggplot_build(P)$data 对我很重要。
无法仅显示与 geom_signif() 的显着成对比较。
我所做的是使用 geom_signif() 和虚拟文本来填充我可以在 ggplot_build(P)$data[[3]] 访问的注释数据框，然后将我的实际重要性值添加到 $annotation 列，并相应地对数据框进行子集以仅显示重要的比较。我有完全的控制权，可以根据显着性改变比较的颜色，哪个组的平均值更高等等。
我刚才问过这个问题
如您所见，这与我的 shift_legend 函数冲突，因为我似乎没有找到访问 data 数据框的方法...
这是我目前为止的真实生活数据，我将图例放在底部，但最好是它采用空面 space，尤其是因为我有这样的情况有更多的空面。
我已根据 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()
现在，我们的绘图右侧仍然会有空白 space，我们不想要，因此我们在右侧应用负垫：
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 package (v0.3.0)
于 2020-02-19 创建