我有这些因素
require(ggplot2)
names(table(diamonds$cut))
# [1] "Fair" "Good" "Very Good" "Premium" "Ideal"
Run Code Online (Sandbox Code Playgroud)
我希望在图例中可视地划分为两组(也表示组名称):
"第一组" - >"公平","好"
和
"第二组" - >"非常好","高级","理想"
从这个情节开始
ggplot(diamonds, aes(color, fill=cut)) + geom_bar() +
guides(fill=guide_legend(ncol=2)) +
theme(legend.position="bottom")
Run Code Online (Sandbox Code Playgroud)
我想得到
(注意第二栏/组中"非常好"滑落)
eip*_*i10 25
您可以通过在图例中添加虚拟因子级别并将其颜色设置为白色,将"非常好"类别移动到图例的第二列,以便无法看到它.在下面的代码中,我们在"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")
Run Code Online (Sandbox Code Playgroud)
更新:我希望有更好的方法为图例中的每个组添加标题,但我现在唯一可以选择的选择是使用grobs,这总是让我头疼.下面的代码改编自这个SO问题的答案.它增加了两个文本凹凸,每个标签一个,但标签必须手工定位,这是一个巨大的痛苦.还必须修改绘图的代码以为图例创建更多空间.此外,即使我已关闭所有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)
Run Code Online (Sandbox Code Playgroud)
这是结果:
这会将标题添加到图例的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)
Run Code Online (Sandbox Code Playgroud)
按照@ 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())
Run Code Online (Sandbox Code Playgroud)
我之后介绍一些空格"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())
Run Code Online (Sandbox Code Playgroud)
在这种情况下,通过删除将标题保留在此版本中可能是有意义的 legend.title=element_blank()
使用cowplot
,您只需要分别构造图例,然后将它们缝合在一起即可。它确实需要使用scale_fill_manual
来确保颜色在整个图上匹配,并且还有很多空间可以摆放图例的位置等。
保存要使用的颜色(此处使用RColorBrewer
)
cut_colors <-
setNames(brewer.pal(5, "Set1")
, levels(diamonds$cut))
Run Code Online (Sandbox Code Playgroud)
制作基本情节- 不带图例:
full_plot <-
ggplot(diamonds, aes(color, fill=cut)) + geom_bar() +
scale_fill_manual(values = cut_colors) +
theme(legend.position="none")
Run Code Online (Sandbox Code Playgroud)
制作两个单独的图,仅限于我们想要的组中的切割。我们不打算绘制这些图。我们将使用它们生成的图例。请注意,我使用此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")
Run Code Online (Sandbox Code Playgroud)
最后,使用将地块和图例缝合在一起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)
)
Run Code Online (Sandbox Code Playgroud)
这个问题已经有几年了,但是自从提出这个问题后出现了新的软件包,可以在这里提供帮助。
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")
Run Code Online (Sandbox Code Playgroud)
2)relayer的relayer(在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:")
Run Code Online (Sandbox Code Playgroud)
我认为水平图例在这里看起来更好一些,因为它不会占用太多空间,但是如果您想要两个并排的垂直图例,请使用此行代替guides
标记为 ##的行:
guides(fill = guide_legend(order = 1, ncol = 1),
fill2 = guide_legend(ncol = 1)) +
Run Code Online (Sandbox Code Playgroud)
归档时间: |
|
查看次数: |
17459 次 |
最近记录: |