我有这些因素
require(ggplot2)
names(table(diamonds$cut))
# [1] "Fair" "Good" "Very Good" "Premium" "Ideal"
我想在图例中直观地分为两组（同时表示组名）：
"First group" -> "Fair", "Good"
和
"Second group" -> "Very Good", "Premium", "Ideal"
从这个情节开始
ggplot(diamonds, aes(color, fill=cut)) + geom_bar() +
guides(fill=guide_legend(ncol=2)) +
theme(legend.position="bottom")
我想得到
（注意“非常好”在第二列/组中滑落）
【问题讨论】：
您可以将“非常好”类别转移到图例的第二列，方法是在图例中添加一个虚拟因子级别并将其颜色设置为白色，使其不可见。在下面的代码中，我们在“Good”和“Very Good”之间添加了一个空白因子级别，所以现在我们有六个级别。然后，我们使用scale_fill_manual 将这个空白级别的颜色设置为“白色”。 drop=FALSE 强制 ggplot 保持图例中的空白级别。可能有一种更优雅的方式来控制 ggplot 放置图例值的位置，但至少这样可以完成工作。
diamonds$cut = factor(diamonds$cut, levels=c("Fair","Good"," ","Very Good",
"Premium","Ideal"))
ggplot(diamonds, aes(color, fill=cut)) + geom_bar() +
scale_fill_manual(values=c(hcl(seq(15,325,length.out=5), 100, 65)[1:2],
"white",
hcl(seq(15,325,length.out=5), 100, 65)[3:5]),
drop=FALSE) +
guides(fill=guide_legend(ncol=2)) +
theme(legend.position="bottom")
更新：我希望有更好的方法来为图例中的每个组添加标题，但我现在唯一能想到的选择是诉诸 grobs，这总是给我头疼。下面的代码改编自this SO question 的答案。它添加了两个文本 grobs，每个标签一个，但标签必须手动定位，这是一个巨大的痛苦。该图的代码也必须进行修改，以便为图例创造更多空间。此外，即使我关闭了所有 grobs 的剪裁，标签仍然被图例 grob 剪裁。您可以将标签放置在剪切区域之外，但它们离图例太远了。我希望真正知道如何使用 grobs 的人可以解决这个问题，并更普遍地改进下面的代码（@baptiste，你在吗？）。
library(gtable)
p = ggplot(diamonds, aes(color, fill=cut)) + geom_bar() +
scale_fill_manual(values=c(hcl(seq(15,325,length.out=5), 100, 65)[1:2],
"white",
hcl(seq(15,325,length.out=5), 100, 65)[3:5]),
drop=FALSE) +
guides(fill=guide_legend(ncol=2)) +
theme(legend.position=c(0.5,-0.26),
plot.margin=unit(c(1,1,7,1),"lines")) +
labs(fill="")
# Add two text grobs
p = p + annotation_custom(
grob = textGrob(label = "First\nGroup",
hjust = 0.5, gp = gpar(cex = 0.7)),
ymin = -2200, ymax = -2200, xmin = 3.45, xmax = 3.45) +
annotation_custom(
grob = textGrob(label = "Second\nGroup",
hjust = 0.5, gp = gpar(cex = 0.7)),
ymin = -2200, ymax = -2200, xmin = 4.2, xmax = 4.2)
# Override clipping
gt <- ggplot_gtable(ggplot_build(p))
gt$layout$clip <- "off"
grid.draw(gt)
结果如下：
【讨论】：
使用cowplot，您只需要分别构建图例，然后将它们缝合在一起。它确实需要使用scale_fill_manual 来确保整个绘图的颜色匹配，并且有很多空间可以摆弄图例位置等。
保存要使用的颜色（此处使用RColorBrewer）
cut_colors <-
setNames(brewer.pal(5, "Set1")
, levels(diamonds$cut))
制作基础图 -- 没有图例：
full_plot <-
ggplot(diamonds, aes(color, fill=cut)) + geom_bar() +
scale_fill_manual(values = cut_colors) +
theme(legend.position="none")
制作两个单独的图，仅限于我们想要的分组内的切割。我们不打算绘制这些；我们将使用它们生成的图例。请注意，我使用dplyr 是为了便于过滤，但这并不是绝对必要的。如果您要为两个以上的组执行此操作，那么使用split 和lapply 生成图列表而不是手动生成图可能是值得的。
for_first_legend <-
diamonds %>%
filter(cut %in% c("Fair", "Good")) %>%
ggplot(aes(color, fill=cut)) + geom_bar() +
scale_fill_manual(values = cut_colors
, name = "First Group")
for_second_legend <-
diamonds %>%
filter(cut %in% c("Very Good", "Premium", "Ideal")) %>%
ggplot(aes(color, fill=cut)) + geom_bar() +
scale_fill_manual(values = cut_colors
, name = "Second Group")
最后，使用plot_grid 将情节和图例缝合在一起。请注意，我在运行剧情之前使用了theme_set(theme_minimal())，以获得我个人喜欢的主题。
plot_grid(
full_plot
, plot_grid(
get_legend(for_first_legend)
, get_legend(for_second_legend)
, nrow = 1
)
, nrow = 2
, rel_heights = c(8,2)
)
【讨论】：
mycolors <- unlist(list(colorspace::qualitative_hcl(length(mydata$col1),"Dynamic"), colorspace::qualitative_hcl(length(mydata$col2),"Dark 3"))) 和 mycolorsfilter<-setNames(mycolors,unlist(list(mydata$col1,mydata$col2))) 用于匹配命名列表的过滤器，以及用于每组图例 + scale_fill_manual(values =mycolorsfilter)。这是一个饼图中的两个geom_arc_bar() 饼图，第一个饼图带有aes(fill=col1)，第二个饼图带有aes(fill=col2)，但数据具有相同的数据框。
按照@eipi10的思路，可以将标题的名称添加为标签，带有white的值：
diamonds$cut = factor(diamonds$cut, levels=c("Title 1 ","Fair","Good"," ","Title 2","Very Good",
"Premium","Ideal"))
ggplot(diamonds, aes(color, fill=cut)) + geom_bar() +
scale_fill_manual(values=c("white",hcl(seq(15,325,length.out=5), 100, 65)[1:2],
"white","white",
hcl(seq(15,325,length.out=5), 100, 65)[3:5]),
drop=FALSE) +
guides(fill=guide_legend(ncol=2)) +
theme(legend.position="bottom",
legend.key = element_rect(fill=NA),
legend.title=element_blank())
我在"Title 1 " 之后引入了一些空格来分隔列并改进设计，但可能会有增加空间的选项。
唯一的问题是我不知道如何更改“标题”标签的格式（我尝试了bquote 或expression，但没有成功）。
根据您尝试的图表，图例的右对齐可能是更好的选择，而且这个技巧看起来更好（恕我直言）。它将图例一分为二，更好地利用了空间。您所要做的就是将ncol 改回1，并将"bottom" (legend.position) 改回"right"：
diamonds$cut = factor(diamonds$cut, levels=c("Title 1","Fair","Good"," ","Title 2","Very Good","Premium","Ideal"))
ggplot(diamonds, aes(color, fill=cut)) + geom_bar() +
scale_fill_manual(values=c("white",hcl(seq(15,325,length.out=5), 100, 65)[1:2],
"white","white",
hcl(seq(15,325,length.out=5), 100, 65)[3:5]),
drop=FALSE) +
guides(fill=guide_legend(ncol=1)) +
theme(legend.position="bottom",
legend.key = element_rect(fill=NA),
legend.title=element_blank())
在这种情况下，通过删除 legend.title=element_blank() 将标题保留在此版本中可能是有意义的
【讨论】：
这会将标题添加到图例的 gtable。它使用@eipi10 的技术将“非常好”类别移动到图例的第二列（谢谢）。
该方法从图中提取图例。图例的 gtable 可以被操纵。在这里，额外的一行被添加到 gtable 中，并且标题被添加到新行中。然后将图例（经过一些微调）放回情节中。
library(ggplot2)
library(gtable)
library(grid)
diamonds$cut = factor(diamonds$cut, levels=c("Fair","Good"," ","Very Good",
"Premium","Ideal"))
p = ggplot(diamonds, aes(color, fill = cut)) +
geom_bar() +
scale_fill_manual(values =
c(hcl(seq(15, 325, length.out = 5), 100, 65)[1:2],
"white",
hcl(seq(15, 325, length.out = 5), 100, 65)[3:5]),
drop = FALSE) +
guides(fill = guide_legend(ncol = 2, title.position = "top")) +
theme(legend.position = "bottom",
legend.key = element_rect(fill = "white"))
# Get the ggplot grob
g = ggplotGrob(p)
# Get the legend
leg = g$grobs[[which(g$layout$name == "guide-box")]]$grobs[[1]]
# Set up the two sub-titles as text grobs
st = lapply(c("First group", "Second group"), function(x) {
textGrob(x, x = 0, just = "left", gp = gpar(cex = 0.8)) } )
# Add a row to the legend gtable to take the legend sub-titles
leg = gtable_add_rows(leg, unit(1, "grobheight", st[[1]]) + unit(0.2, "cm"), pos = 3)
# Add the sub-titles to the new row
leg = gtable_add_grob(leg, st,
t = 4, l = c(2, 6), r = c(4, 8), clip = "off")
# Add a little more space between the two columns
leg$widths[[5]] = unit(.6, "cm")
# Move the legend to the right
leg$vp = viewport(x = unit(.95, "npc"), width = sum(leg$widths), just = "right")
# Put the legend back into the plot
g$grobs[[which(g$layout$name == "guide-box")]] = leg
# Draw the plot
grid.newpage()
grid.draw(g)
【讨论】：
这个问题已经有几年的历史了，但是自从提出这个问题以来，出现了一些新的软件包，可以在这里提供帮助。
1) ggnewscale 此 CRAN 包提供 new_scale_fill 以便在出现后的任何填充几何图形都获得单独的比例。
library(ggplot2)
library(dplyr)
library(ggnewscale)
cut.levs <- levels(diamonds$cut)
cut.values <- setNames(rainbow(length(cut.levs)), cut.levs)
ggplot(diamonds, aes(color)) +
geom_bar(aes(fill = cut)) +
scale_fill_manual(aesthetics = "fill", values = cut.values,
breaks = cut.levs[1:2], name = "First Grouop:") +
new_scale_fill() +
geom_bar(aes(fill2 = cut)) %>% rename_geom_aes(new_aes = c(fill = "fill2")) +
scale_fill_manual(aesthetics = "fill2", values = cut.values,
breaks = cut.levs[-(1:2)], name = "Second Group:") +
guides(fill=guide_legend(order = 1)) +
theme(legend.position="bottom")
2) 中继器 relayer (on github) 包允许定义新的美学，因此我们在这里绘制了两次条形图，一次使用fill 美学，一次使用fill2 美学，生成一个每个使用 scale_fill_manual 的单独图例。
library(ggplot2)
library(dplyr)
library(relayer)
cut.levs <- levels(diamonds$cut)
cut.values <- setNames(rainbow(length(cut.levs)), cut.levs)
ggplot(diamonds, aes(color)) +
geom_bar(aes(fill = cut)) +
geom_bar(aes(fill2 = cut)) %>% rename_geom_aes(new_aes = c(fill = "fill2")) +
guides(fill=guide_legend(order = 1)) + ##
theme(legend.position="bottom") +
scale_fill_manual(aesthetics = "fill", values = cut.values,
breaks = cut.levs[1:2], name = "First Grouop:") +
scale_fill_manual(aesthetics = "fill2", values = cut.values,
breaks = cut.levs[-(1:2)], name = "Second Group:")
我认为这里的水平图例看起来更好一些，因为它不占用太多空间，但是如果您想要两个并排的垂直图例，请使用这条线代替标有 ## 的 guides 线：
guides(fill = guide_legend(order = 1, ncol = 1),
fill2 = guide_legend(ncol = 1)) +
【讨论】：
感谢您的示例，在我看来，这似乎回答了我的问题。
但是，当我将它与 geom_sf 一起使用时，它会返回错误。
这是一个可重现的例子：
nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE) %>%
mutate(var_test=case_when(AREA<=0.05~"G1",
AREA<=0.10~"G2",
AREA>0.10~"G3"))
ggplot(nc,aes(x=1)) +
geom_bar(aes(fill = var_test))+
scale_fill_manual(aesthetics = "fill", values = c("#ffffa8","#69159e","#f2794d"),
breaks = c("G1","G2"), name = "First Group:") +
new_scale_fill() +
geom_bar(aes(fill2 = var_test)) %>% rename_geom_aes(new_aes = c(fill = "fill2")) +
scale_fill_manual(aesthetics = "fill2", values = c("#ffffa8","#69159e","#f2794d"),
breaks = c("G3"), name = "Second Group:")
不适用于 geom_sf
ggplot(nc,aes(x=1)) +
geom_sf(aes(fill = var_test))+
scale_fill_manual(aesthetics = "fill", values = c("#ffffa8","#69159e","#f2794d"),
breaks = c("G1","G2"), name = "First Group:") +
new_scale_fill() +
geom_sf(aes(fill2 = var_test)) %>% rename_geom_aes(new_aes = c(fill = "fill2")) +
scale_fill_manual(aesthetics = "fill2", values = c("#ffffa8","#69159e","#f2794d"),
breaks = c("G3"), name = "Second Group:")
Error: Can't add `o` to a ggplot object.
Run `rlang::last_error()` to see where the error occurred.
感谢您的帮助。
【讨论】：