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

RuReady · September 4, 2018, 9:40pm

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 · September 5, 2018, 11:42am

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:

github.com

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


      
          # Tag
          tag <- element_render(theme, "plot.tag", plot$labels$tag, margin_y = TRUE, margin_x = TRUE)
          tag_height <- grobHeight(tag)
          tag_width <- grobWidth(tag)

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

github.com/tidyverse/ggplot2

Add tag label for adding identifier to plot

tidyverse:master ← thomasp85:label-tag

opened 07:30PM - 17 Jan 18 UTC

thomasp85

+335 -4

As per discussions on twitter, this PR adds a `tag` label alongside `title`, `su…btitle`, and `caption`. It is placed in the upper left corner in its own row and column between the margin and the title/x-label. The tag name is chosen over `label` as the `labs()` function indicate that “label” is a catchall term for all types of titles. The default theming is like this: ```r ggplot(mtcars) + geom_point(aes(disp, mpg)) + labs(tag = 'A', title = 'test') ``` ![tag](https://user-images.githubusercontent.com/1775316/35062710-5802fdde-fbc5-11e7-9387-6bac0cdd41fe.png) The size is slightly larger than the title and the margin is chosen so that it is well separated from the main parts of the plot. In general this is based on my own taste and is up for discussion.

RuReady · September 5, 2018, 5:10pm

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

baptiste · September 5, 2018, 6:01pm

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 · September 5, 2018, 8:57pm

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 · September 6, 2018, 6:41am

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 · September 6, 2018, 7:33am

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 · September 6, 2018, 8:01am

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 · September 6, 2018, 4:13pm

That did it. Thanks!

RuReady · September 6, 2018, 5:02pm

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"