问题描述
此page显示了如何使用ggplot
函数来处理guide_legend
的多个图例,例如顺序,标题颜色。我想知道是否可以单独修改每个图例的背景颜色。谢谢!
ggplot(mpg,aes(displ,cty)) +
# I tired to use legend.background and a list of colors in fill to individually change the color,but is it not working
theme(legend.background=element_rect(fill=c('brown','grey','whie'))) +
geom_point(aes(size = hwy,colour = cyl,shape = drv)) +
guides(
colour = guide_colourbar(order = 1),# title.theme allows individual adjustment of title color,I wonder if similar can be done for legend background color
shape = guide_legend(order = 2,title.theme = element_text(color='green')),size = guide_legend(order = 3,label.theme=element_text(color='red'))
)
解决方法
我认为无法将多种颜色发送到legend.background
。如果这对您确实很重要,那么您可能需要在最后的情节中破解这些怪胎。这是一个无需使用任何外部程序包即可完成的小功能:
recolor_legends <- function(gg_plot,col)
{
p2 <- ggplotGrob(gg_plot)
grobs <- p2$grobs[which(p2$layout$name == "guide-box")][[1]]$grobs
legends <- grobs[sapply(grobs,function(x) any(grepl("grobs",names(x))))]
bgs <- lapply(legends,function(x) {
x$grobs[x$layout$name == "background"][[1]]
})
bgs <- mapply(function(x,y) {x$gp$fill <- y; x},bgs,col,SIMPLIFY = FALSE)
legends <- mapply(function(x,y){
x$grobs[x$layout$name == "background"][[1]] <- y; x
},legends,SIMPLIFY = FALSE)
grobs[sapply(grobs,names(x))))] <- legends
p2$grobs[which(p2$layout$name == "guide-box")][[1]]$grobs <- grobs
plot(p2)
}
所以假设我有以下情节:
p <- ggplot(mpg,aes(displ,cty)) +
geom_point(aes(size = hwy,colour = cyl,shape = drv)) +
guides(
colour = guide_colourbar(order = 1),shape = guide_legend(order = 2,title.theme = element_text(color = 'green')),size = guide_legend(order = 3,label.theme = element_text(color = 'red'))
)
p
我可以做
recolor_legends(p,c("red","blue","green"))
,
这是一种实现方式,但是有点令人费解(基于this excellent post):
# Some data
df <- data.frame(
x = 1:10,y = 1:10,colour = factor(sample(1:3,10,replace = TRUE)),size = factor(sample(1:3,replace = TRUE)))
library(ggplot2)
library(gridExtra)
library(gtable)
library(grid)
### Step 1
# Draw a plot with the colour legend
(p1 <- ggplot(data = df,aes(x=x,y=y)) +
geom_point(aes(colour = colour)) +
theme_bw() +
theme(legend.position = "top",legend.background = element_rect(fill = "lightsteelblue")))
# Extract the colour legend - leg1
leg1 <- gtable_filter(ggplot_gtable(ggplot_build(p1)),"guide-box")
### Step 2
# Draw a plot with the shape legend
(p2 <- ggplot(data = df,y=y)) +
geom_point(aes(shape = size)) +
theme_bw() +
theme(legend.background = element_rect(fill = "lightseagreen")))
# Extract the shape legend - leg2
leg2 <- gtable_filter(ggplot_gtable(ggplot_build(p2)),"guide-box")
# Step 3
# Draw a plot with no legends - plot
(plot <- ggplot(data = df,y=y)) +
geom_point(aes(shape = size,colour = colour)) +
theme_bw() +
theme(legend.position = "none"))
### Step 4
# Arrange the three components (plot,leg1,leg2)
# The two legends are positioned outside the plot:
# one at the top and the other to the side.
plotNew <- arrangeGrob(leg1,plot,heights = unit.c(leg1$height,unit(1,"npc") - leg1$height),ncol = 1)
plotNew <- arrangeGrob(plotNew,leg2,widths = unit.c(unit(1,"npc") - leg2$width,leg2$width),nrow = 1)
grid.newpage()
grid.draw(plotNew)
# OR,arrange one legend at the top and the other inside the plot.
plotNew <- plot +
annotation_custom(grob = leg2,xmin = 7,xmax = 10,ymin = 0,ymax = 4)
plotNew <- arrangeGrob(leg1,plotNew,"npc") - leg1$height),ncol = 1)
grid.newpage()
grid.draw(plotNew)
,
您还可以使用较低级别的grid
函数来编辑相关的grob。如果p
是您的问题中的情节:
library(grid)
# allow the ggplot grobs to be seen by `grid` package functions
g = grid.force(ggplotGrob(p))
# grab the names of the guide grobs,to be used in gPath in `editGrob`
nms = grep("^guides",grid.ls(g,print=FALSE)$name,value=TRUE)
# edit the guide grobs by passing a vector of colours to `gpar`
for(i in seq_along(nms))
g = editGrob(g,gPath("guide-box",nms[[i]],"background"),grep=TRUE,gp = gpar(fill=c("red","green")[i]))
grid.newpage(); grid.draw(g)
哪个给
,基于Allan的回答,我增强了功能,以便按键的背景颜色现在是透明的。
ggplot.legends.recolor.fx <- function(gg_plot,col) {
p2 <- ggplotGrob(gg_plot)
grobs <- p2$grobs[which(p2$layout$name == "guide-box")][[1]]$grobs
legends <- grobs[sapply(grobs,SIMPLIFY = FALSE)
bgs <- mapply(function(x,y) {x$gp$alpha <- y; x},0.3,SIMPLIFY = FALSE)
# background color for the keys are changed to transparent below:
key.bgs <- lapply(legends,function(x) {
x$grobs[grepl('key.*bg',x$layout$name)]
})
key.bgs <- lapply(key.bgs,function(z) {
z <- mapply(function(x,z,SIMPLIFY = FALSE)})
legends <- mapply(function(x,y){
x$grobs[grepl('key.*bg',x$layout$name)] <- y; x
},key.bgs,SIMPLIFY = FALSE)
grobs[sapply(grobs,names(x))))] <- legends
p2$grobs[which(p2$layout$name == "guide-box")][[1]]$grobs <- grobs
plot(p2)
}