Хорошие вопросы и ответы!
Я нашел нечто похожее на этой ссылке.Итак, я подумал, что это было бы хорошим дополнением к вашей функции.
Точнее, функция reposition_legend()
из lemon
, кажется, вполне то, что вам нужно, за исключением того, что онане ищет пустые места.
Я вдохновился вашей функцией, чтобы найти имена пустых панелей, которые передаются в reposition_legend()
с помощью panel
arg.
Примерданные и библиотеки:
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
случаев, которые должны быть одинаковыми), чтобы сконцентрироваться на важных вещах.
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)
![enter image description here](https://i.stack.imgur.com/k31v1.png)
Обратите внимание, что это все еще может потребовать доработки, я просто подумал, что стоит поделиться этим.
На данный момент поведение кажется нормальным, ифункция на несколько строк короче.
Другие случаи.
Первый пример:
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)
![enter image description here](https://i.stack.imgur.com/JeaxM.png)
Второй пример:
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)
![enter image description here](https://i.stack.imgur.com/OaHjl.png)
Третий пример:
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)
![enter image description here](https://i.stack.imgur.com/j7mpU.png)
Полная функция:
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)
}