很好的问答！
我在this 链接上发现了类似的东西。所以，我认为这对你的功能来说会是一个很好的补充。
更准确地说，来自lemon 的函数reposition_legend() 似乎正是您所需要的，只是它不查找空格。
我从您的函数中获得灵感，以查找使用 panel arg 传递给 reposition_legend() 的空面板的名称。
示例数据和库：
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")
当然，我删除了所有的检查（if case，应该是一样的）只是为了专注于重要的东西。
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)
请注意，这可能仍需要一些调整，我只是认为这是值得分享的东西。
目前行为似乎还可以，并且该函数短了几行。
其他情况。
第一个例子：
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)
第二个例子：
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)
第三个例子：
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)
功能齐全：
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)
}