How to automatically add text annotations or tags outside of faceted plots?

[RuReady]

I'm looking for a way to add some text (a, b, c, I, II, etc.) outside of the strips of a faceted plot. I know it would be possible to use annotate or geom_text to add text inside each facet but I'd prefer not to do so because sometimes the text can overlap the data.

This is the desired output. Any help would be appreciated!

Reproducible code with made-up data

library(ggplot2)

dat1 <- structure(list(Year = structure(c(1L, 2L, 3L, 1L, 2L, 3L, 1L, 
                  2L, 3L, 1L, 2L, 3L), .Label = c("2001", "2002", "2003"), class = "factor"), 
                      Company = structure(c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 
                      4L, 4L, 4L), .Label = c("AAA", "BBB", "CCC", "DDD"), class = "factor"), 
                      Rank = c(1, 5, 2, 3, 4, 3, 2, 2, 5, 4, 3, 1), Rank_rev = c(5, 
                      1, 4, 3, 2, 3, 4, 4, 1, 2, 3, 5), Group = structure(c(1L, 
                      1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Group1", 
                      "Group2"), class = "factor")), row.names = c(NA, -12L), class = c("tbl_df", 
                  "tbl", "data.frame"))

company <- ggplot(dat1, aes(x = Year, y = Rank_rev)) +
  facet_grid(Group ~ Company, space = "free", scales = "free", switch = 'y') +
  geom_col(aes(fill = Company)) +
  geom_text(
    aes(x = Year, y = Rank_rev,
        label = Rank),
    nudge_y = 0.5,
    size = 5,
    hjust = 0.5,
    color = "black") +
  scale_fill_brewer(palette = "Set2") +
  scale_x_discrete(expand = c(0, 0)) +
  scale_y_continuous(expand = expand_scale(mult = c(0, 0.1))) +
  theme_bw() +
  theme(axis.text.y = element_blank(), 
        strip.placement = "outside") +
  theme(legend.position = "bottom")
company

[mara]

The closest thing to what you're describing that comes to mind is the tag argument added in ggplot2 3.0.0. However, as that's for individual charts (and a faceted plot is basically one big chart by default), I'm not 100% sure the approach would work in the way you've depicted it in your initial plot.

Here's a reprex with just a single tag added:

suppressPackageStartupMessages(library(tidyverse))
dat1 <- structure(list(Year = structure(c(1L, 2L, 3L, 1L, 2L, 3L, 1L, 
                                          2L, 3L, 1L, 2L, 3L), .Label = c("2001", "2002", "2003"), class = "factor"), 
                       Company = structure(c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 
                                             4L, 4L, 4L), .Label = c("AAA", "BBB", "CCC", "DDD"), class = "factor"), 
                       Rank = c(1, 5, 2, 3, 4, 3, 2, 2, 5, 4, 3, 1), Rank_rev = c(5, 
                                                                                  1, 4, 3, 2, 3, 4, 4, 1, 2, 3, 5), Group = structure(c(1L, 
                                                                                                                                        1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Group1", 
                                                                                                                                                                                                "Group2"), class = "factor")), row.names = c(NA, -12L), class = c("tbl_df", 
                                                                                                                                                                                                                                                                  "tbl", "data.frame"))

company <- ggplot(dat1, aes(x = Year, y = Rank_rev)) +
  facet_grid(Group ~ Company, space = "free", scales = "free", switch = 'y') +
  geom_col(aes(fill = Company)) +
  geom_text(
    aes(x = Year, y = Rank_rev,
        label = Rank),
    nudge_y = 0.5,
    size = 5,
    hjust = 0.5,
    color = "black") +
  labs(tag = "A") +
  scale_fill_brewer(palette = "Set2") +
  scale_x_discrete(expand = c(0, 0)) +
  scale_y_continuous(expand = expand_scale(mult = c(0, 0.1))) +
  theme_bw() +
  theme(axis.text.y = element_blank(), 
        strip.placement = "outside") +
  theme(legend.position = "bottom")
company

Created on 2018-09-05 by the reprex package (v0.2.0.9000).

The plot-build.R source code might give you a better sense of how the tag position is calculated layout-wise:

tidyverse/ggplot2/blob/1c09bae2aa24320bcb4891c664cccc16efc86a8a/R/plot-build.r#L245-L248

The thread from the addition of the tag element might also be helpful:

Add tag label for adding identifier to plot

[RuReady]

Thank @mara ! Tag is useful. Too bad it can only be added to 1 place on the plot

[baptiste]

inspired by egg::tag_facet,

tag_facet2 <-  function(p, open="(", close = ")",
         tag_pool = letters,
         x = 0, y = 0.5,
         hjust = 0, vjust = 0.5, 
         fontface = 2, ...){
  
  gb <- ggplot_build(p)
  lay <- gb$layout$layout
  nm <- names(gb$layout$facet$params$rows)
  
  tags <- paste0(open,tag_pool[unique(lay$COL)],close)
  
  tl <- lapply(tags, grid::textGrob, x=x, y=y,
               hjust=hjust, vjust=vjust, gp=grid::gpar(fontface=fontface))
  
  g <- ggplot_gtable(gb)
  g <- gtable::gtable_add_rows(g, grid::unit(1,"line"), pos = 0)
  lm <- unique(g$layout[grepl("panel",g$layout$name), "l"])
  g <- gtable::gtable_add_grob(g, grobs = tl, t=1, l=lm)
  grid::grid.newpage()
  grid::grid.draw(g)
}

tag_facet2(company)

[RuReady]

That looks great!

Can you make it work for the tags on the right hand side (I, II, ...) too? Can you explain your function a bit more? My knowledge of grid and gtable is very limited

Thanks!

[baptiste]

Here's an extended version,

tag_facet2 <-  function(p, open=c("(",""), close = c(")","."),
         tag_fun_top = function(i) letters[i],
         tag_fun_right = utils::as.roman,
         x = c(0,0), y = c(0.5, 1),
         hjust = c(0,0), vjust = c(0.5,1), 
         fontface = c(2,2), ...){
  
  gb <- ggplot_build(p)
  lay <- gb$layout$layout
  nm <- names(gb$layout$facet$params$rows)
  
  tags_top <- paste0(open[1],tag_fun_top(unique(lay$COL)),close[1])
  tags_right <- paste0(open[2],tag_fun_right(unique(lay$ROW)),close[2])
  
  tl <- lapply(tags_top, grid::textGrob, x=x[1], y=y[1],
               hjust=hjust[1], vjust=vjust[1], gp=grid::gpar(fontface=fontface[1], ...))
  rl <- lapply(tags_right, grid::textGrob, x=x[2], y=y[2],
               hjust=hjust[2], vjust=vjust[2], gp=grid::gpar(fontface=fontface[2],...))
  
  
  g <- ggplot_gtable(gb)
  g <- gtable::gtable_add_rows(g, grid::unit(1,"line"), pos = 0)
  l <- unique(g$layout[grepl("panel",g$layout$name), "l"])
  g <- gtable::gtable_add_grob(g, grobs = tl, t=1, l=l)
  
  g <- gtable::gtable_add_cols(g, grid::unit(2,"line"), pos = -1)
  t <- unique(g$layout[grepl("panel",g$layout$name), "t"])
  g <- gtable::gtable_add_grob(g, grobs = rl, t=t, l=ncol(g))
  
  grid::grid.newpage()
  grid::grid.draw(g)
}

tag_facet2(company)

[RuReady]

Awesome work! Really appreciate your help!

One last question, how can I put the 'I., II., ' in between the plot and the legend if legend.position is set to right instead of bottom?

Thanks!

company <- ggplot(dat1, aes(x = Year, y = Rank_rev)) +
  facet_grid(Group ~ Company, space = "free", scales = "free", switch = 'y') +
  geom_col(aes(fill = Company)) +
  geom_text(
    aes(x = Year, y = Rank_rev,
        label = Rank),
    nudge_y = 0.5,
    size = 5,
    hjust = 0.5,
    color = "black") +
  scale_fill_brewer(palette = "Set2") +
  scale_x_discrete(expand = c(0, 0)) +
  scale_y_continuous(expand = expand_scale(mult = c(0, 0.1))) +
  theme_bw() +
  theme(axis.text.y = element_blank(), 
        strip.placement = "outside") +
  theme(legend.position = "right")

tag_facet3(company)

[baptiste]

for fine-tuning you'll have to explore the arguments of the various gtable functions and how they relate to the ggplot layout (ie where in the gtable to add columns/rows for new grobs and spacers).

tag_facet2 <-  function(p, open=c("(",""), close = c(")","."),
         tag_fun_top = function(i) letters[i],
         tag_fun_right = utils::as.roman,
         x = c(0,0), y = c(0.5, 1),
         hjust = c(0,0), vjust = c(0.5,1), 
         fontface = c(2,2), ...){
  
  gb <- ggplot_build(p)
  lay <- gb$layout$layout
  
  tags_top <- paste0(open[1],tag_fun_top(unique(lay$COL)),close[1])
  tags_right <- paste0(open[2],tag_fun_right(unique(lay$ROW)),close[2])
  
  tl <- lapply(tags_top, grid::textGrob, x=x[1], y=y[1],
               hjust=hjust[1], vjust=vjust[1], gp=grid::gpar(fontface=fontface[1], ...))
  rl <- lapply(tags_right, grid::textGrob, x=x[2], y=y[2],
               hjust=hjust[2], vjust=vjust[2], gp=grid::gpar(fontface=fontface[2],...))
  
  
  g <- ggplot_gtable(gb)
  g <- gtable::gtable_add_rows(g, grid::unit(1,"line"), pos = 0)
  l <- unique(g$layout[grepl("panel",g$layout$name), "l"])
  g <- gtable::gtable_add_grob(g, grobs = tl, t=1, l=l)
  
  wm <- do.call(grid::unit.pmax, lapply(rl, grid::grobWidth))
  g <- gtable::gtable_add_cols(g, wm, pos = max(l))
  t <- unique(g$layout[grepl("panel",g$layout$name), "t"])
  g <- gtable::gtable_add_grob(g, grobs = rl, t=t, l=max(l) + 1)
  g <- gtable::gtable_add_cols(g, unit(2,"mm"), pos = max(l))
  
  grid::grid.newpage()
  grid::grid.draw(g)
}

[RuReady]

That did it. Thanks!

[RuReady]

I modify your function to allow choosing which facets for tagging

tag_facet_flex <- function(p, position = 'both', 
                           open = c("(", ""), close = c(")", ")"),
                           tag_fun_top = function(i) letters[i],
                           tag_fun_right = utils::as.roman,
                           x = c(0, 0), y = c(0.5, 1),
                           hjust = c(0, 0), vjust = c(0.5, 1),
                           fontface = c(1, 1), ...) {
  
  gb <- ggplot_build(p)
  lay <- gb$layout$layout  
  
  if (grepl(position, 'top')) {
    
    lay <- gb$layout$layout
    
    tags_top <- paste0(open[1], tag_fun_top(unique(lay$COL)), close[1])
    
    tl <- lapply(tags_top, grid::textGrob,
                 x = x[1], y = y[1],
                 hjust = hjust[1], vjust = vjust[1], 
                 gp = grid::gpar(fontface = fontface[1], ...)
    )
    
    g <- ggplot_gtable(gb)
    g <- gtable::gtable_add_rows(g, grid::unit(1, "line"), pos = 0)
    lm <- unique(g$layout[grepl("panel", g$layout$name), "l"])
    g <- gtable::gtable_add_grob(g, grobs = tl, t = 1, l = lm)
    
  } else if (grepl(position, 'right')) {
    
    tags_right <- paste0(open[2], tag_fun_right(unique(lay$ROW)), close[2])
    
    rl <- lapply(tags_right, grid::textGrob,
                 x = x[2], y = y[2],
                 hjust = hjust[2], vjust = vjust[2], 
                 gp = grid::gpar(fontface = fontface[2], ...)
    )
    
    g <- ggplot_gtable(gb)
    l <- unique(g$layout[grepl("panel", g$layout$name), "l"])
    
    wm <- do.call(grid::unit.pmax, lapply(rl, grid::grobWidth))
    g <- gtable::gtable_add_cols(g, wm, pos = max(l))
    t <- unique(g$layout[grepl("panel", g$layout$name), "t"])
    g <- gtable::gtable_add_grob(g, grobs = rl, t = t, l = max(l) + 1)
    g <- gtable::gtable_add_cols(g, unit(2, "mm"), pos = max(l))

  } else {
    
    print('Use default tagging option: both top and right sides')
    
    tags_top <- paste0(open[1], tag_fun_top(unique(lay$COL)), close[1])
    tags_right <- paste0(open[2], tag_fun_right(unique(lay$ROW)), close[2])
    
    tl <- lapply(tags_top, grid::textGrob,
                 x = x[1], y = y[1],
                 hjust = hjust[1], vjust = vjust[1], 
                 gp = grid::gpar(fontface = fontface[1], ...)
    )
    
    rl <- lapply(tags_right, grid::textGrob,
                 x = x[2], y = y[2],
                 hjust = hjust[2], vjust = vjust[2], 
                 gp = grid::gpar(fontface = fontface[2], ...)
    )
    
    g <- ggplot_gtable(gb)
    g <- gtable::gtable_add_rows(g, grid::unit(1, "line"), pos = 0)
    l <- unique(g$layout[grepl("panel", g$layout$name), "l"])
    g <- gtable::gtable_add_grob(g, grobs = tl, t = 1, l = l)
    
    wm <- do.call(grid::unit.pmax, lapply(rl, grid::grobWidth))
    g <- gtable::gtable_add_cols(g, wm, pos = max(l))
    t <- unique(g$layout[grepl("panel", g$layout$name), "t"])
    g <- gtable::gtable_add_grob(g, grobs = rl, t = t, l = max(l) + 1)
    g <- gtable::gtable_add_cols(g, unit(2, "mm"), pos = max(l))
  }
  
  if (!is.null(g)) {
    grid::grid.newpage()
    grid::grid.draw(g)    
  }
  
  return(g)
  
}

Testing

company_top   <- tag_facet_flex(company, position = 'top')

company_right <- tag_facet_flex(company, position = 'right')

company_both  <- tag_facet_flex(company, position = 'both')
#> [1] "Use default tagging option: both top and right sides"