Match legend text color in geom_text to symbol

问题:

I am trying to color match the text of the legend to the color of text produced by a factored variable using geom_text. Here is a minimal working example:

df <- data.frame(a=rnorm(10),b=1:10,c=letters[1:10],d=c("one","two"))
p1 <-ggplot(data=df,aes(x=b,y=a))
p1 <- p1 + geom_text(aes(label = c, color=d, fontface="bold"))
p1 <- p1 + scale_color_hue(name="colors should match",breaks=c("one", "two"),
                 labels=c("should be pink", "should be blue"))
p1

I am sure its a simple fix. Any suggestions or reference to prior posts would help. I did not find anything specific to this.

回答1:

Following on from joran's comment above, you can edit the grobs directly. This is a rather ugly bit of code so apologies [there will be a much more elegant way to do this using grid commands - and hopefully someone will post].

library(grid)

gglabcol <- 
   function(plot1) 

         {
         g <- ggplotGrob(plot1)

         # legend grobs
         g.b <- g[["grobs"]][[which(g$layout$name=="guide-box")]]
         l <- g.b[["grobs"]][[1]][["grobs"]]

         # get grobs for legend symbols (extract colour)
         lg <- l[sapply(l, function(i) grepl("GRID.text", i))]

         # get grobs for legend labels 
         lb <- l[sapply(l, function(i) grepl("guide.label", i))]

         # get change colour of labels to colour of symbols
         for(i in seq_along(lg)) {

           lb[[i]]$gp$col <-  lg[[i]]$gp$col

           g.b[["grobs"]][[1]][["grobs"]][sapply(g.b[["grobs"]][[1]][["grobs"]],
                          function(i) grepl("guide.label", i))][[i]] <- lb[[i]]
           }

         # overwrite original legend
         g[["grobs"]][[which(g$layout$name=="guide-box")]] <- g.b

         grid.draw(g)

         invisible(g)
     }

Plot

gglabcol(p1)

回答2:

Sometimes it is easier to edit a grob using grid's editing functions - if the names of the relevant grobs can be found. In this case, they can be found, and the edit is straightforward - change colour of label from black to red or blue.

library(ggplot2)
library(grid)

df <- data.frame(a=rnorm(10),b=1:10,c=letters[1:10],d=c("one","two"))
p1 <-ggplot(data=df,aes(x=b,y=a))
p1 <- p1 + geom_text(aes(label = c, color=d, fontface="bold"))
p1 <- p1 + scale_color_hue(name="colors should match",breaks=c("one", "two"),
                 labels=c("should be salmon", "should be sky blue"))
p1

# Get the ggplot grob
g <- ggplotGrob(p1)

# Check out the grobs
grid.ls(grid.force(g))

Look through the list of grobs. The grobs we want to edit are towards the bottom of the list, in the 'guide-box' set of grobs - with names that begin with "label". There are two grobs:

label-3-3.4-4-4-4
label-4-3.5-4-5-4

# Get names of 'label' grobs.
names.grobs <- grid.ls(grid.force(g))$name 
labels <- names.grobs[which(grepl("label", names.grobs))]

# Get the colours
# The colours are the same as the colours of the plotted points.
# These are available in the ggplot build data.
gt <- ggplot_build(p1)
colours <- unique(gt$data[[1]][, "colour"])

# Edit the 'label' grobs - change their colours
# Use the `editGrob` function
for(i in seq_along(labels)) {
    g <- editGrob(grid.force(g), gPath(labels[i]), grep = TRUE,  
         gp = gpar(col = colours[i]))
}

# Draw it
grid.newpage()
grid.draw(g)

What if it was required that the keys be points rather than letters? It could be useful because the 'a' is a symbol in the plot, and it is a symbol in the legend key. This is not a simple edit, like above. I need a point grob to take the place of the text grob. I draw grobs in viewports, but if I can find the names of the relevant viewports, it should be straightforward to make the change.

# Find the names of the relevant viewports
current.vpTree()  # Scroll out to the right to find he relevant 'key' viewports.

viewport[key-4-1-1.5-2-5-2], viewport[key-3-1-1.4-2-4-2],

# Well, this is convenient. The names of the viewports are the same 
# as the names of the grobs (see above). 
# Easy enough to get the names from the 'names.grobs' list (see above). 
# Get the names of 'key' viewports(/grobs)
keys <- names.grobs[which(grepl("key-[0-9]-1-1", names.grobs))]

# Insert points grobs into the viewports:
#    Push to the viewport;
#    Insert the point grob;
#    Pop the viewport.
for(i in seq_along(keys)) {
   downViewport(keys[i])
   grid.points(x = .5, y = .5, pch = 16, gp = gpar(col = colours[i]))
   popViewport()
}
popViewport(0)

# I'm not going to worry about removing the text grobs. 
# The point grobs are large enough to hide them. 

plot = grid.grab()
grid.newpage()
grid.draw(plot)

Update

Taking account of @user20650 's advice to change the legend key (see the comment below):

p1 <-ggplot(data=df,aes(x=b,y=a))
p1 <- p1 + geom_text(aes(label = c, color=d, fontface="bold"))
p1 <- p1 + scale_color_hue(name="colors should match",breaks=c("one", "two"),
                 labels=c("should be salmon", "should be sky blue"))

GeomText$draw_key <- function (data, params, size) { 
   pointsGrob(0.5, 0.5, pch = 16, 
   gp = gpar(col = alpha(data$colour, data$alpha), 
   fontsize = data$size * .pt)) }

p1

Then proceed as before to change the colour of the legend text.

回答3:

The colors in the plot are the same as the colors in the legend, but the legend fontface remains plain even when you set the plot symbol fontface to bold (or italic). I'm not sure if this is an oversight in the design of ggplot2 or the intended behavior. For some colors, the bold fontface looks more saturated than the plain fontface, making it seem like a different color.

In any case here's a kludge that's a lot easier than messing with grobs, but that might get you what you want. Use geom_text with the plain fontface, but do it two or three times in a row (or more), so you'll get overplotting. This will make both the symbols and the legend appear similar to bold fontface, because both will be overplotted, and the legend symbols will always look the same as the plot symbols.

Here's an example:

library(ggplot2)
library(gridExtra)

# Original plot (with larger font size)
p1 <- ggplot(data=df) +
  geom_text(aes(x=b, y=a, label=c, color=d), fontface='bold', size=8)
p1 <- p1 + scale_color_hue(name="colors should match",breaks=c("one", "two"),
                              labels=c("should be pink", "should be blue")) +
           ggtitle("Original Plot with Bold Symbols and Plain Legend")

# New version with overplotting. (You don't need to specify 'plain' fontface. 
# I've just included that to emphasize what the code is doing.)
p1.overplot <- ggplot(data=df) +
  geom_text(aes(x=b, y=a, label=c, color=d), fontface='plain', size=8) +
  geom_text(aes(x=b, y=a, label=c, color=d), fontface='plain', size=8) +
  geom_text(aes(x=b, y=a, label=c, color=d), fontface='plain', size=8)
p1.overplot <- p1.overplot + 
  scale_color_hue(name="colors should match",
                  breaks=c("one", "two"),
                  labels=c("should be pink", "should be blue")) +
  ggtitle("Both symbols and legend are overplotted 3 times")