将 geom_text 中的图例文本颜色与符号匹配

Question

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.

Answer 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[[1]][[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 <- g.b[[1]][[1]][["grobs"]][grepl("label", g.b[[1]][[1]]$layout$name)]

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

           g.b[[1]][[1]][["grobs"]][grepl("label", g.b[[1]][[1]]$layout$name)][[i]][["children"]][[1]][["children"]][[1]]$gp$col <- lg[[i]]$gp$col

           }

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

         grid.draw(g)

         invisible(g)
   }

Plot

gglabcol(p1)

Answer 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.

Answer 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")

Answer 4

Here's a solution that uses ggtext and avoids editing grobs directly. (It does involve extracting the colors from the plot, but the subsequent steps are more user-friendly.)

# Original code, but with a stripped-down call to `scale_color_hue` (since
# we're going to replace it).
library(ggplot2)
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(breaks=c("one", "two"))

# Load the `ggtext` library, which lets us style (parts of) text labels.
library(ggtext)
# Build the plot so we can extract the colors that were actually used.  (If you
# supply colors manually instead, this step isn't necessary.)
g1 = ggplot_build(p1)
# Add a scale with labels that are colored appropriately, using <span> tags.
# Also specify that legend labels should be processed with `element_markdown`.
p1 +
  scale_color_hue(name = "colors should match",
                  breaks = c("one", "two"),
                  labels = paste("<span style='color:",
                                 unname(unlist(unique(g1$data[[1]]["colour"]))),
                                 "'>",
                                 c("should be pink", "should be blue"),
                                 "</span>",
                                 sep = "")) +
  theme(legend.text = element_markdown())

Answer 5

This answer is based on the answers given by Mike H. from the question here and by user20650 from this question.

To get the colours:

  pGrob <- ggplotGrob(p1)
  g.b   <- pGrob[["grobs"]][[which(pGrob$layout$name=="guide-box")]]
  l     <- g.b[[1]][[1]][["grobs"]]
  # get grobs for legend symbols (extract colour)
  lg    <- l[sapply(l, function(i) grepl("GRID.text", i))]
  clr   <- mapply(FUN=function(x){x$gp$col},x=lg)

Then use the following methods

   gb  <- which(grepl("guide-box", pGrob$layout$name))
   gb2 <- which(grepl("guides", pGrob$grobs[[gb]]$layout$name))
   label_text <- which(grepl("label",pGrob$grobs[[gb]]$grobs[[gb2]]$layout$name))

   pGrob$grobs[[gb]]$grobs[[gb2]]$grobs[label_text] <- 
   mapply(FUN = function(x, y) {x[["children"]][[1]][["children"]][[1]]$gp <- gpar(col =y); return(x)},
          x =   pGrob$grobs[[gb]]$grobs[[gb2]]$grobs[label_text],
          y =  clr, SIMPLIFY = FALSE)

After it, you will get the same output file

grid.draw(pGrob)

I am providing this answer because in the second chunk of the code, the argument, which is assigned to x$gp in mapply function, should be a gpar object. That is a mistake in Mike H. 's answer and I am fixing it.

Thank you.