Multicolored title with R

Question

I'd like to add colors to certain words in titles to my graphs. I've been able to find some precedent here. Specifically, I'd like the text that's wrapped in apostrophes (in the output, below) to correspond to the color of their respective bar charts.

Here's how far I've gotten with titles in R before having to export a PDF to Adobe Illustrator or other program.

name <- c("Peter", "Gabriel", "Rachel", "Bradley")
age <- c(34, 13, 28, 0.9)
fake_graph <- family[order(family$age, decreasing = F), ]
fake_graph <- within(fake_graph, {
    bar_color = ifelse(fake_graph$name == "Rachel", "blue", "gray")
})

# Plot creation
library(ggplot2)
fake_bar_charts <- ggplot() +
  geom_bar(
    data = fake_graph,
    position = "identity",
    stat = "identity",
    width = 0.75,
    fill = fake_graph$bar_color,
    aes(x = name, y = age)
    ) +
  scale_x_discrete(limits = fake_graph$name) +
  scale_y_continuous(expand = c(0, 0)) +
  coord_flip() +
  theme_minimal()
family <- data.frame(name, age)

# Add title
library(grid)
library(gridExtra)
grid_title <- textGrob(
  label = "I spend more time with 'Rachel' than\nwith 'other family members.'",
  x = unit(0.2, "lines"),
  y = unit(0.1, "lines"),
  hjust = 0, vjust = 0,
  gp = gpar(fontsize = 14, fontface = "bold")
)
gg <- arrangeGrob(fake_bar_charts, top = grid_title)
grid.arrange(gg)

Output:

This example uses ggplot2 to create bar charts as well as grid and gridExtra for the title functionality, but I'd be willing to work with any solution (preferably with ggplot2 to create the graph itself) that could provide me with the text in quotes to match their respective bar chart colors.

Any other solutions on this site haven't been able to solve this puzzle, but I would love to find a solution for this from within R.

Thank you for any help!

Answer 1

I wrote the label with too honest way. First grob's width decides second grob's x, and so on. I used grobTree() to group them. Because gTree doesn't have own size information, I gave arrangeGrob() an argument padding to keep gTree's space.

library(grid); library(gridExtra); library(ggplot2)

df <- data.frame(name = c("Rachel", "Peter", "Gabriel","Bradley"), age = c(23, 35, 12, 3))
fake_bar_charts <- ggplot(df, aes(x=name, y=age)) + 
  geom_bar(stat="identity", fill = c(rep("gray50",3), "red")) + coord_flip()

grobs <- grobTree(
  gp = gpar(fontsize = 14, fontface = "bold"), 
  textGrob(label = "I spend more time with '", name = "title1",
           x = unit(0.2, "lines"), y = unit(1.4, "lines"), 
           hjust = 0, vjust = 0),
  textGrob(label = "Rachel", name = "title2",
           x = grobWidth("title1") + unit(0.2, "lines"), y = unit(1.4, "lines"),
           hjust = 0, vjust = 0, gp = gpar(col = "red")),
  textGrob(label = "' than", name = "title3",
           x = grobWidth("title1") + grobWidth("title2") + unit(0.2, "lines"), y = unit(1.4, "lines"),
           hjust = 0, vjust = 0),
  textGrob(label = "with '", name = "title4",
           x = unit(0.2, "lines"), y = unit(0.1, "lines"),
           hjust = 0, vjust = 0),
  textGrob(label = "other family members", name = "title5",
           x = grobWidth("title4") + unit(0.2, "lines"), y = unit(0.1, "lines"),
           hjust = 0, vjust = 0, gp = gpar(col = "gray50")),
  textGrob(label = "'.", name = "title6",
           x = grobWidth("title4") + grobWidth("title5") + unit(0.2, "lines"), y = unit(0.1, "lines"),
           hjust = 0, vjust = 0)
)

gg <- arrangeGrob(fake_bar_charts, top=grobs, padding = unit(2.6, "line"))
grid.newpage()
grid.draw(gg)

Answer 2

Here's a first attempt that draws on this answer about how to insert annotations outside of the plot area. The basic idea is to layer on custom text geoms with different colors. I don't find this answer very satisfactory, because (i) the edges of the characters are jagged (the result of overlaying the text on itself multiple times), and (ii) the location of the title needs to be manually specified, but it's a start:

library(ggplot2)
library(grid)

# Convenience function to make text    
tt <- function(text, colour, x, y) {
  annotation_custom(
    grob = textGrob(
      label = text, hjust = 0, gp = gpar(col = colour)),
      xmin = x, xmax = x,
      ymin = y, ymax = y
  )   
}

p <- ggplot(mpg, aes(x = class, fill = ifelse(class == "pickup", "a", "b"))) +
  geom_bar() +
  scale_fill_manual(guide = FALSE, values = c("blue", "grey")) + 
  coord_flip() +
  theme(plot.margin = unit(c(4, 3, 3, 2), units = "lines"))
p <- p +
  tt("I spend more time with 'pickup' than\nwith 'other family members.'",
       "grey", 8.5, 0) +
  tt("I spend more time with 'pickup' than\nwith",
       "black", 8.5, 0) +
  tt("I spend more time with 'pickup'\n",
       "blue", 8.5, 0) +
  tt("I spend more time with\n",
       "black", 8.5, 0)
# Code to override clipping
gt <- ggplot_gtable(ggplot_build(p))
gt$layout$clip[gt$layout$name == "panel"] <- "off"
grid.draw(gt)