[英]Shift legend into empty facets of a faceted plot in ggplot2
Consider the following plot:考虑以下情节:
library(ggplot2)
p <- ggplot(diamonds,
aes(x = carat, fill = cut)) +
geom_density(position = "stack") +
facet_wrap(~ color)
The facet_wrap
function wraps a sequence of faceted panels into a roughly rectangular display of nrow
rows and ncol
columns.所述facet_wrap
函数包装方位面板的序列插入的大致矩形的显示nrow
行和ncol
列。 However, depending on the data, the actual number of panels is often a few panels short of nrow * ncol
, which leaves a chunk of wasted space in the plot.然而,根据数据,面板的实际数量通常比nrow * ncol
少几个面板,这会在图中留下一大块浪费的空间。
If the plot includes legend(s), the situation is exacerbated, because now we have even more wasted space due to the legend, whether it's on the right (default legend position), or one of the other three directions.如果情节包含图例,则情况会恶化,因为现在我们由于图例而浪费了更多空间,无论是在右侧(默认图例位置),还是在其他三个方向之一。
To save space, I would like to shift the legend(s) into the space created by unfilled facets.为了节省空间,我想将图例移动到由未填充的刻面创建的空间中。
The following works as a space-saving measure, but the legend is anchored to a corner of the plot area, with potentially a lot of space left on one side, creating an imbalanced look:以下是一种节省空间的措施,但图例固定在绘图区域的一角,可能在一侧留下大量空间,从而造成不平衡的外观:
p +
theme(legend.position = c(1, 0),
legend.justification = c(1, 0))
Shifting a legend towards the centre of the blank space area by manually adjusting the legend.position
/ legend.justification
values is a matter of trial and error, and difficult to scale if one has many faceted plots to work on.通过手动调整legend.position
/ legend.justification
值将图例移向空白区域的中心是一个反复试验的问题,如果有许多分面图要处理,则难以缩放。
In summary, I want a method that:总之,我想要一种方法:
This is a recurring use case for me, and I've decided to post it along with my working solution here in case anyone else finds it useful.这对我来说是一个反复出现的用例,我决定将它与我的工作解决方案一起发布在这里,以防其他人发现它有用。 I haven't seen this scenario asked/answered elsewhere on Stack Overflow.我还没有看到这种情况下问/堆栈溢出别处回答。 If anyone has, please leave a comment and I'll be happy to answer there instead or have this marked as a duplicate, as the case may be.如果有人有,请发表评论,我很乐意在那里回答或将其标记为重复,视情况而定。
The following is an extension to an answer I wrote for a previous question about utilising the space from empty facet panels, but I think it's sufficiently different to warrant its own space.以下是我为上一个关于利用空分面面板空间的问题所写的答案的扩展,但我认为这足以保证自己的空间。
Essentially, I wrote a function that takes a ggplot/grob object converted by ggplotGrob()
, converts it to grob if it isn't one, and digs into the underlying grobs to move the legend grob into the cells that correspond to the empty space.本质上,我编写了一个函数,该函数接受由ggplotGrob()
转换的ggplot/grob对象,如果它不是一个,则将其转换为ggplotGrob()
,并深入研究底层 grobs 以将图例 grob 移动到与空白区域对应的单元格中.
Function :功能:
library(gtable)
library(cowplot)
shift_legend <- function(p){
# check if p is a valid object
if(!"gtable" %in% class(p)){
if("ggplot" %in% class(p)){
gp <- ggplotGrob(p) # convert to grob
} else {
message("This is neither a ggplot object nor a grob generated from ggplotGrob. Returning original plot.")
return(p)
}
} else {
gp <- p
}
# check for unfilled facet panels
facet.panels <- grep("^panel", gp[["layout"]][["name"]])
empty.facet.panels <- sapply(facet.panels, function(i) "zeroGrob" %in% class(gp[["grobs"]][[i]]))
empty.facet.panels <- facet.panels[empty.facet.panels]
if(length(empty.facet.panels) == 0){
message("There are no unfilled facet panels to shift legend into. Returning original plot.")
return(p)
}
# establish extent of unfilled facet panels (including any axis cells in between)
empty.facet.panels <- gp[["layout"]][empty.facet.panels, ]
empty.facet.panels <- list(min(empty.facet.panels[["t"]]), min(empty.facet.panels[["l"]]),
max(empty.facet.panels[["b"]]), max(empty.facet.panels[["r"]]))
names(empty.facet.panels) <- c("t", "l", "b", "r")
# extract legend & copy over to location of unfilled facet panels
guide.grob <- which(gp[["layout"]][["name"]] == "guide-box")
if(length(guide.grob) == 0){
message("There is no legend present. Returning original plot.")
return(p)
}
gp <- gtable_add_grob(x = gp,
grobs = gp[["grobs"]][[guide.grob]],
t = empty.facet.panels[["t"]],
l = empty.facet.panels[["l"]],
b = empty.facet.panels[["b"]],
r = empty.facet.panels[["r"]],
name = "new-guide-box")
# squash the original guide box's row / column (whichever applicable)
# & empty its cell
guide.grob <- gp[["layout"]][guide.grob, ]
if(guide.grob[["l"]] == guide.grob[["r"]]){
gp <- gtable_squash_cols(gp, cols = guide.grob[["l"]])
}
if(guide.grob[["t"]] == guide.grob[["b"]]){
gp <- gtable_squash_rows(gp, rows = guide.grob[["t"]])
}
gp <- gtable_remove_grobs(gp, "guide-box")
return(gp)
}
Result :结果:
library(grid)
grid.draw(shift_legend(p))
Nicer looking result if we take advantage of the empty space's direction to arrange the legend horizontally:如果我们利用空白空间的方向水平排列图例,效果会更好:
p.new <- p +
guides(fill = guide_legend(title.position = "top",
label.position = "bottom",
nrow = 1)) +
theme(legend.direction = "horizontal")
grid.draw(shift_legend(p.new))
Some other examples:其他一些例子:
# example 1: 1 empty panel, 1 vertical legend
p1 <- ggplot(economics_long,
aes(date, value, color = variable)) +
geom_line() +
facet_wrap(~ variable,
scales = "free_y", nrow = 2,
strip.position = "bottom") +
theme(strip.background = element_blank(),
strip.placement = "outside")
grid.draw(shift_legend(p1))
# example 2: 2 empty panels (vertically aligned) & 2 vertical legends side by side
p2 <- ggplot(mpg,
aes(x = displ, y = hwy, color = fl, shape = factor(cyl))) +
geom_point(size = 3) +
facet_wrap(~ class, dir = "v") +
theme(legend.box = "horizontal")
grid.draw(shift_legend(p2))
# example 3: facets in polar coordinates
p3 <- ggplot(mtcars,
aes(x = factor(1), fill = factor(cyl))) +
geom_bar(width = 1, position = "fill") +
facet_wrap(~ gear, nrow = 2) +
coord_polar(theta = "y") +
theme_void()
grid.draw(shift_legend(p3))
Nice Q&A!不错的问答!
I found something similar at this link.我在这个链接上找到了类似的东西。 So, I thought that it would have been a nice addition to your function.所以,我认为这对你的功能来说是一个很好的补充。
More precisely the function reposition_legend()
from lemon
seems to be quite what you needed, except that it doesn't look for the empty spaces.更准确地说,来自lemon
的函数reposition_legend()
似乎正是您所需要的,只是它不寻找空白空间。
I took inspiration from your function to find the names of the empty panels that are passed to reposition_legend()
with the panel
arg.我从您的函数中获得灵感,以查找通过panel
参数传递给reposition_legend()
的空面板的名称。
Example data and libraries:示例数据和库:
library(ggplot2)
library(gtable)
library(lemon)
p <- ggplot(diamonds,
aes(x = carat, fill = cut)) +
geom_density(position = "stack") +
facet_wrap(~ color) +
theme(legend.direction = "horizontal")
Of course, I removed all the checks ( if
cases, which should be the same) just to concentrate on the important stuff.当然,我删除了所有检查( if
情况,应该是相同的)只是为了专注于重要的事情。
shift_legend2 <- function(p) {
# ...
# to grob
gp <- ggplotGrob(p)
facet.panels <- grep("^panel", gp[["layout"]][["name"]])
empty.facet.panels <- sapply(facet.panels, function(i) "zeroGrob" %in% class(gp[["grobs"]][[i]]))
empty.facet.panels <- facet.panels[empty.facet.panels]
# establish name of empty panels
empty.facet.panels <- gp[["layout"]][empty.facet.panels, ]
names <- empty.facet.panels$name
# example of names:
#[1] "panel-3-2" "panel-3-3"
# now we just need a simple call to reposition the legend
reposition_legend(p, 'center', panel=names)
}
shift_legend2(p)
Note that this might still need some tweaking, I just thought it was something worth to be shared.请注意,这可能仍然需要一些调整,我只是认为这是值得分享的。
At the moment the behaviour seems OK, and the function is a few lines shorter.目前行为似乎还可以,并且该功能短了几行。
Other cases.其他情况。
First example:第一个例子:
p1 <- ggplot(economics_long,
aes(date, value, color = variable)) +
geom_line() +
facet_wrap(~ variable,
scales = "free_y", nrow = 2,
strip.position = "bottom") +
theme(strip.background = element_blank(),
strip.placement = "outside")
shift_legend2(p1)
Second example:第二个例子:
p2 <- ggplot(mpg,
aes(x = displ, y = hwy, color = fl, shape = factor(cyl))) +
geom_point(size = 3) +
facet_wrap(~ class, dir = "v") +
theme(legend.box = "horizontal")
#[1] "panel-2-3" "panel-3-3" are the names of empty panels in this case
shift_legend2(p2)
Third example:第三个例子:
p3 <- ggplot(mtcars,
aes(x = factor(1), fill = factor(cyl))) +
geom_bar(width = 1, position = "fill") +
facet_wrap(~ gear, nrow = 2) +
coord_polar(theta = "y") +
theme_void()
shift_legend2(p3)
Complete function:功能齐全:
shift_legend2 <- function(p) {
# check if p is a valid object
if(!(inherits(p, "gtable"))){
if(inherits(p, "ggplot")){
gp <- ggplotGrob(p) # convert to grob
} else {
message("This is neither a ggplot object nor a grob generated from ggplotGrob. Returning original plot.")
return(p)
}
} else {
gp <- p
}
# check for unfilled facet panels
facet.panels <- grep("^panel", gp[["layout"]][["name"]])
empty.facet.panels <- sapply(facet.panels, function(i) "zeroGrob" %in% class(gp[["grobs"]][[i]]),
USE.NAMES = F)
empty.facet.panels <- facet.panels[empty.facet.panels]
if(length(empty.facet.panels) == 0){
message("There are no unfilled facet panels to shift legend into. Returning original plot.")
return(p)
}
# establish name of empty panels
empty.facet.panels <- gp[["layout"]][empty.facet.panels, ]
names <- empty.facet.panels$name
# return repositioned legend
reposition_legend(p, 'center', panel=names)
}
I think lemon::reposition_legend()
identified by @RLave is the most elegant solution.我认为由@RLave 识别的lemon::reposition_legend()
是最优雅的解决方案。 However, it does hinge on knowing the names of empty facets.但是,它确实取决于了解空构面的名称。 I wanted to share a succinct way of finding these, thus proposing yet another version of shift_legend()
:我想分享一种找到这些的简洁方法,因此提出了另一个版本的shift_legend()
:
shift_legend3 <- function(p) {
pnls <- cowplot::plot_to_gtable(p) %>% gtable::gtable_filter("panel") %>%
with(setNames(grobs, layout$name)) %>% purrr::keep(~identical(.x,zeroGrob()))
if( length(pnls) == 0 ) stop( "No empty facets in the plot" )
lemon::reposition_legend( p, "center", panel=names(pnls) )
}
The R package patchwork
offers an elegant solution when combining multiple plots (slightly different than a single facetted ggplot). R 包patchwork
在组合多个绘图时提供了一个优雅的解决方案(与单个分面 ggplot 略有不同)。 If one has three ggplot objects, p1, p2, p3, then the syntax is very straightforward:如果有三个 ggplot 对象,p1、p2、p3,那么语法非常简单:
+
operator, "add" the plots together in facets使用+
运算符,将图“添加”到构面中guide_area()
command, specify which facet should contain the guide使用guide_area()
命令,指定哪个方面应该包含指南plot_layout(guides = 'collect')
.如果所有三个图都具有相同的图例,请通过命令plot_layout(guides = 'collect')
告诉 patchwork “收集”图例来节省空间。See the code below for the essential syntax and the link below for a fully reproducible example.有关基本语法,请参阅下面的代码,有关完全可重现的示例,请参阅下面的链接。
library(patchwork)
# guide_area() puts legend in empty fourth facet
p1 + p2 + p3 + guide_area() +
plot_layout(guides = 'collect')
https://patchwork.data-imaginist.com/articles/guides/layout.html#controlling-guides https://patchwork.data-imaginist.com/articles/guides/layout.html#controlling-guides
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.