r - 将图例转换为 ggplot2 中多面图的空白面
问题描述
考虑以下情节:
library(ggplot2)
p <- ggplot(diamonds,
aes(x = carat, fill = cut)) +
geom_density(position = "stack") +
facet_wrap(~ color)
该facet_wrap
函数将一系列多面面板包装成大致矩形的nrow
行和ncol
列显示。但是,根据数据,实际面板数通常少几个面板nrow * ncol
,这会在绘图中留下一大块浪费的空间。
如果情节包括图例,情况会更加恶化,因为现在我们由于图例而浪费了更多空间,无论它是在右侧(默认图例位置),还是其他三个方向之一。
为了节省空间,我想将图例转移到由未填充的方面创建的空间中。
以下是一种节省空间的措施,但图例固定在情节区域的一角,一侧可能留有大量空间,从而产生不平衡的外观:
p +
theme(legend.position = c(1, 0),
legend.justification = c(1, 0))
legend.position
通过手动调整/值将图例移向空白区域的中心legend.justification
是一个反复试验的问题,如果要处理许多多面图,则很难缩放。
总之,我想要一种方法:
- 将多面图的图例移动到由于空面而创建的空间中。
- 结果是一个相当漂亮的情节。
- 很容易自动化处理许多情节。
这对我来说是一个反复出现的用例,我决定将它与我的工作解决方案一起发布在这里,以防其他人发现它有用。我还没有在 Stack Overflow 的其他地方看到过这种情况。如果有人有,请发表评论,我很乐意在那里回答或将其标记为重复,视情况而定。
解决方案
以下是我为之前关于利用空面面板空间的问题写的答案的扩展,但我认为它足够不同以保证它自己的空间。
本质上,我编写了一个函数,该函数接受由 转换的ggplot/grob对象ggplotGrob()
,如果不是,则将其转换为 grob,然后深入挖掘底层 grobs 以将图例 grob 移动到对应于空白空间的单元格中。
功能:
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)
}
结果:
library(grid)
grid.draw(shift_legend(p))
如果我们利用空白空间的方向水平排列图例,效果会更好:
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))
其他一些例子:
# 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))
推荐阅读
- javascript - mwc.js 和 mwc.esm.js 有什么区别?
- android - 在 Flutter 应用程序的源代码管理中隐藏 Google Maps API 密钥
- android - 如何使用太多的 Completable 方法执行顺序操作
- sql - 从另一个数据库执行时的查询性能问题
- php - Laravel 找不到使用 laravel-db2 的 ibm db2 驱动程序
- jsf - 如何从 WebSocket 类访问托管 Bean
- javascript - 如何向 actions.order.create paypal 集成添加更多属性
- reactjs - React setState 在提交输入表单后不更新状态
- azure-maps - Azure Maps - 检测缩放方向
- xamarin.forms - 如何在 xamarin Forms 中监控蓝牙设备连接状态?