In-panel labs

[baptiste]

Just the other day I needed a helper function to polish some plots for a paper: I often have facetted plots without facet strips to save on space, and the editors require a label (a), (b), etc. for each facet, which they see as a sub-figure.

It'd be nice to use your glue framework with this alternative labelling technique (a dummy text layer placed with the panels).

label_facets <- function(p, hjust=-0.5, vjust=1.5, fontface=2, ...){
  
  gb <- ggplot_build(p)
  lay <- gb$layout$panel_layout
  nm <- names(gb$layout$facet$params$rows)
  tags <- cbind(lay, label = paste0("(",letters[lay$PANEL],")"))
  p + geom_text(data=tags, aes(x = -Inf, y=Inf, label=label), ...,
            hjust=hjust, vjust=vjust, fontface=fontface, inherit.aes = FALSE) +
    theme(strip.text = element_blank(), strip.background = element_blank())
}

[jimjam-slam]

I think I understand the visual result you're describing, but maybe not the process you're thinking about using. Do you mean you'd:

• run the plot with facet strips in order to get their positions,
• grab the grobs for the facet strips,
• re-run the plot without strips so that the panels expand, and
• drop the facet strip grobs back in?

[baptiste]

I'll admit I didn't think this through very much... sorry for the confused description. I saw your package and thought it might be a good place to implement a solution for a related problem of tagging facets.

My common use-case is to remove strips and add tags to facets,

Your package is targetting a somewhat different problem, but maybe there could be some overlap where the tag contains the same kind of information as the glued facets strips? Just a thought, feel free to close this issue.

mydf = data.frame(
  x = 1:90,
  y = rnorm(90),
  red = rep(letters[1:3], 30),
  blue = c(rep(1, 30), rep(2, 30), rep(3, 30)))

p <- ggplot(mydf) +
  geom_point(aes(x = x, y = y)) +
  facet_wrap(
    ~ red + blue)

label_facets <- function(p, hjust=-0.5, vjust=1.5, fontface=2, ...){
  
  gb <- ggplot_build(p)
  lay <- gb$layout$layout
  nm <- names(gb$layout$facet$params$rows)
  tags <- cbind(lay, label = paste0("(",letters[lay$PANEL],")"))
  p + geom_text(data=tags, aes(x = -Inf, y=Inf, label=label), ...,
                hjust=hjust, vjust=vjust, fontface=fontface, inherit.aes = FALSE) +
    theme(strip.text = element_blank(), strip.background = element_blank())
}

egg::ggarrange(p, label_facets(p), ncol=1)

[jimjam-slam]

No, that's okay! I was just looking around for alternate ways to solve the problem and saw that at least one other person has taken a similar approach as you (use a dummy geom_text in lieu of facet labels).

I'd certainly prefer to find a solution that respects the semantic function of the facet labels, but if that's not possible then maybe this approach is the best way to make it happen 🙂

[jimjam-slam]

ggplot2 v3 also appears to have a new tag argument in labs(), which seems designed to tackle a similar problem for the entire plot.

[baptiste]

yeah, I was a bit involved the tags discussion; maybe I should have pushed the per-facet option at the time.

I suggested a couple of times making things like facet strips customisable in their gtable positioning, so that you could place e.g. the facet strip at a custom position within panels etc. but I don't think it'll ever gain traction among ggplot2 developers.

[jimjam-slam]

That seems like a shame given I see you can now choose whether strips go between the axis and the panel as well as choosing the side they sit on. I understand being opinionated about defaults, but if you're allowing customisability, I don't see a massive difference between that and allowing them inside the panel (except, perhaps, that the existing options still allocate space for the strips, rather than overlaying them).

[jimjam-slam]

Maybe a ggplot2 extension could achieve this as well?

[jimjam-slam]

So, I need to really sit down with this on the weekend a bit more, but I've been poking around the ggplot2 code and I'm wondering if creating modified facet classes is the way to do this. There's a lot going on, but as far as I can tell the draw_panel method in facet-wrap.r (around line 320) and facet-grid-.r (around line 368) start to consider the presence of strips w.r.t. facet panel dimensions. It's possible an alternate implementation could ignore this consideration, provided the labels were drawn on top of the panels and not underneath.

On the plus side, this would mean that facet labels could still be themed in the existing way. On the downside, this is a massively overengineered solution and changes in the facetting system in future versions of ggplot2 could mess it up.

[jimjam-slam]

Another downside: implementing it for facet_grid would probably be a bad idea, since moving labels into the facets on the side would risk making it look like the labels only applied to them, instead of the entire row/column. I'm wondering if maybe we should just implement both, since this is a small package and it doesn't matter too much if the API has a couple of different approaches to the same problem 😄

[jimjam-slam]

Okay, I'm following the Extending ggplot2 vignette to try to sketch out how this would work subclassing facet_wrap. My progress—which is really just the skeleton of a subclass and some notes about what I can try—are over on the feature-overlay branch
.

[jimjam-slam]

I'm about 3/4 of the way on the 'make a new facet spec' approach: the strips end up inside their respective panels, but due to this problem (I think), the strips are centre-justified:

library(stickylabeller)
ggplot(mtcars) +
  geom_point(aes(x = mpg, y = gear)) +
  facet_wrap_overlay(~ carb) +
  theme(strip.background = element_rect(fill = '#ff000080'))

This is what the two functions look like in facet_wrap.r:

weave_tables_col <- function(table, table2, col_shift, col_width, name, z = 1, clip = "off") {
  panel_col <- panel_cols(table)$l
  panel_row <- panel_rows(table)$t
  for (i in rev(seq_along(panel_col))) {
    col_ind <- panel_col[i] + col_shift
    table <- gtable_add_cols(table, col_width[i], pos = col_ind)
    if (!missing(table2)) {
      table <- gtable_add_grob(table, table2[, i], t = panel_row, l = col_ind + 1, clip = clip, name = paste0(name, "-", seq_along(panel_row), "-", i), z = z)
    }
  }
  table
}

weave_tables_row <- function(table, table2, row_shift, row_height, name, z = 1, clip = "off") {
  panel_col <- panel_cols(table)$l
  panel_row <- panel_rows(table)$t
  for (i in rev(seq_along(panel_row))) {
    row_ind <- panel_row[i] + row_shift
    table <- gtable_add_rows(table, row_height[i], pos = row_ind)
    if (!missing(table2)) {
      table <- gtable_add_grob(table, table2[i, ], t = row_ind + 1, l = panel_col, clip = clip, name = paste0(name, "-", seq_along(panel_col), "-", i), z = z)
    }
  }
  table
}

Inside that loop, I'm essentially commenting out the gtable_add_rows (or cols) step, so the labels get added directly to the panels. Following the advice in the linked issue, I'm now trying to create a row of wrapper rectGrobs with the specified justifications, add the strips to those, then add the wrappers to the panels. I'm hooooping I won't need the panel dimensions for this.

[baptiste]

Cool, thanks for working on this.
Justification was never on the agenda for gtable, but kohske once wrote this draft for various workaround strategies (now 6 years old, and was a draft proposal, some things will have changed).

https://rpubs.com/kohske/815

IIRC for a gtable within a gtable, use the vp argument to justify. All this should be compatible with npc units so probably no need to worry about panel dimensions.

[jimjam-slam]

Awesome 😁 I have the strip backgrounds going to the top (or bottom) successfully by moving the actual strip height from the parent gTree to the strip background rectGrob, using unit(1, 'npc') for the parent height and justifying the rectGrob. No need for additional dummy grobs.

The text is proving trickier, though, as the textGrob doesn't have a height, and it's wrapped in another gTree (a "titleGrob" gTree). I was hoping to use a similar strategy, making sure everything just expands to parent width, but no luck so far. I'll have a crack at the vp arguments 😄

[jimjam-slam]

Okay, this isn't quite ready for prime-time, but it's getting there 😄

p = ggplot(mtcars) +
  geom_point(aes(x = mpg, y = gear)) +
  facet_wrap_overlay(~ carb, labeller = label_glue('({.l}) carb is {carb}')) +
  theme_grey(base_size = 10) +
  theme(
    strip.background = element_rect(fill = alpha('black', 0.5)),
    strip.text = element_text(colour = 'white', hjust = 0, vjust = 1.15)) +
  labs(
    title = 'Overlay facet titles in ggplot2 with stickylabeller!',
    subtitle = 'The facet_wrap_overlay function prints labels over the panels')

I got a bit frustrated with not being able to make things work with the text justification, so I ended up just doing the maths on its position. Maybe that can be fixed up in time 😁 But for now, it works with strip.placement == c('top') or 'left'; 'bottom' is missing the panels and 'right' is off somewhere else altogether 😆 I'll do some more tweaking to get those going soon!