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!

Tweeze

maybe related: #35936819 – Disaccredit

with some code at github.com/baptiste/caption – Disaccredit

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)

Bowe

btw it's not that arrangeGrob doesn't like gTrees, it's just that gTrees don't know their size (the heightDetails method doesn't calculate anything). The usual way around that is to define a custom class that includes a meaningful heightDetails method. – Disaccredit

@Bowe @Disaccredit Very elegant solution! I'm still getting acquainted with grid graphics - is there a way to reduce redundant code entries like hjust and vjust via this method? – Tweeze

Answer 2

A very easy way is to use ggtext

Which is achieved with

library(ggtext) #remotes::install_github("wilkelab/ggtext")

ggplot(iris, aes(Sepal.Length, Sepal.Width, color = Species)) +
  geom_point(size = 3) +
  scale_color_manual(
    name = NULL,
    values = c(setosa = "#0072B2", virginica = "#009E73", versicolor = "#D55E00"),
    labels = c(
      setosa = "<i style='color:#0072B2'>I. setosa</i>",
      virginica = "<i style='color:#009E73'>I. virginica</i>",
      versicolor = "<i style='color:#D55E00'>I. versicolor</i>")
  ) +
  labs(
    title = "**Fisher's *Iris* dataset**  
    <span style='font-size:11pt'>Sepal width vs. sepal length for 
    <span style='color:#0072B2;'>setosa</span>, 
    <span style='color:#D55E00;'>versicolor</span>, and
    <span style='color:#009E73;'>virginica</span>
    </span>",
    x = "Sepal length (cm)", y = "Sepal width (cm)"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_markdown(lineheight = 1.1),
    legend.text = element_markdown(size = 11)
  )

Rainband

Great solution, much less tedious than manually constructing the text Grobs, and the element_markdown specification in theme makes it easy to preserve the default ggplot behavior where the markdown isn't needed. – Jago

Answer 3

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)

Sketch

I'm a big fan of the convenience function. If you set this up to return a textGrob as part of a grobTree then it would certainly reduce the clutter and the text. – Tweeze

Answer 4

Using ggcharts and mdthemes this can be achieved quite easily.

name <- c("Peter", "Gabriel", "Rachel", "Bradley")
age <- c(34, 13, 28, 0.9)
family <- data.frame(name, age, stringsAsFactors = FALSE)

title <- paste(
  "**I spend more time with '<span style=color:'#1F77B4'>Rachel</span>' than",
  "with '<span style=color:'lightgray'>other family members</span>'**",
  sep = "<br>"
)

ggcharts::bar_chart(family, name, age, highlight = "Rachel", bar_color = "#1F77B4") +
  ggtitle(title) +
  mdthemes::md_theme_minimal()

The bar_chart() function from ggcharts creates a horizontal, sorted bar chart by default. Highlighting is built-in with the highlight parameter.

The mdthemes package offers themes that render text as markdown/HTML. Note the ** aroung the title which makes it bold and the <span> tags with CSS to color the words.

Olwen

I wasn’t familiar with the mdthemes package, and I like the approach. Thanks! – Tweeze

@DanKalleward, It's brand new! I only created it two week ago or so. – Olwen

I'm a big fan of the ggcharts package. I don't always have the time to type 45 lines of ggplot2 code to analyze some data. This package fills a void, and I'll definitely pass it along. – Tweeze