add a level of nesting/grouping to x-axis

Question

I'm looking to add a second layer of grouping to the x-axis as show in the panel for Outcome A below. There should be two points for each estimate type (ITT vs TOT) that correspond to the label 3 or 12.

Here's my approach to get what you see, minus the edits to the Outcome A panel:

df %>%
  ggplot(., aes(x=factor(estimate), y=gd, group=interaction(estimate, time), shape=estimate)) +
  geom_point(position=position_dodge(width=0.5)) +
  geom_errorbar(aes(ymin=gd.lwr, ymax=gd.upr), width=0.1,
                position=position_dodge(width=0.5)) +
  geom_hline(yintercept=0) +
  ylim(-1, 1) +
  facet_wrap(~outcome, scales='free', strip.position = "top") +
  theme_bw() +
  theme(panel.grid = element_blank()) +
  theme(panel.spacing = unit(0, "lines"), 
        strip.background = element_blank(),
        strip.placement = "outside")

Here's the toy data:

df <- structure(list(outcome = c("Outcome C", "Outcome C", "Outcome C", 
"Outcome C", "Outcome B", "Outcome B", "Outcome B", "Outcome B", 
"Outcome A", "Outcome A", "Outcome A", "Outcome A"), estimate = c("ITT", 
"ITT", "TOT", "TOT", "ITT", "ITT", "TOT", "TOT", "ITT", "ITT", 
"TOT", "TOT"), time = structure(c(1L, 2L, 1L, 2L, 1L, 2L, 1L, 
2L, 1L, 2L, 1L, 2L), .Label = c("3", "12"), class = "factor"), 
    gd = c(0.12, -0.05, 0.19, -0.08, -0.22, -0.05, -0.34, -0.07, 
    0.02, -0.02, 0.03, -0.03), gd.lwr = c(-0.07, -0.28, -0.11, 
    -0.45, -0.43, -0.27, -0.69, -0.42, -0.21, -0.22, -0.33, -0.36
    ), gd.upr = c(0.31, 0.18, 0.5, 0.29, 0, 0.17, 0.01, 0.27, 
    0.24, 0.19, 0.38, 0.3)), class = "data.frame", row.names = c(NA, 
-12L))

possible duplicate ? https://stackoverflow.com/questions/44616530/axis-labels-on-two-lines-with-nested-x-variables-year-below-months — Mike, Oct 25 '18 at 19:40
Possible duplicate of [Multirow axis labels with nested grouping variables](https://stackoverflow.com/questions/18165863/multirow-axis-labels-with-nested-grouping-variables) — iod, Oct 25 '18 at 19:42
Thanks, @iod. I came across that answer, but I posted thinking there might be a better way given all the development on ggplot since 2010. — Eric Green, Oct 25 '18 at 19:44
Thanks, @Mike. In the example you pointed to there is only 1 faceting term, but I think I'd need to use at least 2 since I already facet on `outcome`. The results don't look quite right. — Eric Green, Oct 25 '18 at 19:50
No problem, what I would do is split your graphs by outcome and then use `grid.arrange` to put them back together — Mike, Oct 25 '18 at 20:00
Just btw, you could consider removing all the visual fluff (e.g., all `theme` calls) and superfluous data (e.g., most of the dataframe was not needed) from your question next time to speed up understanding :-) — Roman, Oct 25 '18 at 20:02
@EricGreen I updated my answer to remove duplicate legends, hope it helps! — Mike, Oct 28 '18 at 23:19
Thanks Roman, Mike, and camille for thinking through this problem and posting great ideas. I think people will find value in each approach. — Eric Green, Oct 29 '18 at 17:48

score 3 · Answer 1 · answered Oct 25 '18 at 19:59

3

Changed x aesthetic to interaction(time, factor(estimate)) and added a fitting discrete labels.

df %>%
  ggplot(., aes(x = interaction(time, factor(estimate)),                   # relevant
                y = gd, group = interaction(estimate, time), 
                shape = estimate)) +
  geom_point(position = position_dodge(width = 0.5)) +
  geom_errorbar(aes(ymin = gd.lwr, ymax = gd.upr), width = 0.1,
                position = position_dodge(width = 0.5)) +
  geom_hline(yintercept = 0) +
  ylim(-1, 1) +
  facet_wrap(~outcome, scales = 'free', strip.position = "top") +
  theme_bw() +
  theme(panel.grid = element_blank()) +
  theme(panel.spacing = unit(0, "lines"), 
        strip.background = element_blank(),
        strip.placement = "outside") +
  scale_x_discrete(labels = c("3\nITT", "12\nITT", "3\nTOT", "12\nTOT"))   # relevant

answered Oct 25 '18 at 19:59

Roman

4,744
2
16
58

Thanks. @Roman. Helpful insight about the modification to `x`. Interesting approach with the discrete labels. Is it the case that if I wanted to have only one "ITT" and one "TOT" label (centered) for each pair of 3/12 points, I would need to use an approach like the one @Mike describes? – Eric Green Oct 25 '18 at 20:09
1

I will probably use your solution in practice because it gets me very close with simple code. Marked a different answer "correct" because it solved the super-label challenge. – Eric Green Oct 29 '18 at 17:50
That's absolutely okay and deserved, I'm happy that it helped! – Roman Oct 29 '18 at 21:25

Mike · Answer 2 · 2018-10-28T23:18:03.333

Posting a solution using grid.arrange. I updated the answer to only include one legend.

    library(dplyr)
    library(ggplot2)

   p1 <- ggplot(filter(df, outcome == "Outcome A"), 
             aes(x = time,                   # relevant
                    y = gd, group = interaction(estimate, time), 
                    shape = estimate)) +
  geom_point(position = position_dodge(width = 0.5)) +
  geom_errorbar(aes(ymin = gd.lwr, ymax = gd.upr), width = 0.1,
                position = position_dodge(width = 0.5)) +
  geom_hline(yintercept = 0) +
  ylim(-1, 1) +
  scale_x_discrete("")+
  facet_wrap(~estimate, scales = 'free_x', strip.position = "bottom") +
  theme_bw() +
  theme(panel.grid = element_blank()) +
  theme(panel.spacing = unit(0, "lines"), 
        strip.background = element_blank(),
        strip.placement = "bottom",
        panel.border = element_rect(fill = NA, color="white")) +
  ggtitle("Outcome A")



p2 <- ggplot(filter(df, outcome == "Outcome B"), 
             aes(x = time,                   # relevant
                 y = gd, group = interaction(estimate, time), 
                 shape = estimate)) +
  geom_point(position = position_dodge(width = 0.5)) +
  geom_errorbar(aes(ymin = gd.lwr, ymax = gd.upr), width = 0.1,
                position = position_dodge(width = 0.5)) +
  geom_hline(yintercept = 0) +
  ylim(-1, 1) +
  scale_x_discrete("")+
  facet_wrap(~estimate, scales = 'free_x', strip.position = "bottom") +
  theme_bw() +
  theme(panel.grid = element_blank()) +
  theme(panel.spacing = unit(0, "lines"), 
        strip.background = element_blank(),
        strip.placement = "bottom",
        panel.border = element_rect(fill = NA, color="white")) +
  ggtitle("Outcome B")

p3 <-  ggplot(filter(df, outcome == "Outcome C"), 
              aes(x = time,                   # relevant
                  y = gd, group = interaction(estimate, time), 
                  shape = estimate)) +
  geom_point(position = position_dodge(width = 0.5)) +
  geom_errorbar(aes(ymin = gd.lwr, ymax = gd.upr), width = 0.1,
                position = position_dodge(width = 0.5)) +
  geom_hline(yintercept = 0) +
  ylim(-1, 1) +
  scale_x_discrete("")+
  facet_wrap(~estimate, scales = 'free_x', strip.position = "bottom") +
  theme_bw() +
  theme(panel.grid = element_blank()) +
  theme(panel.spacing = unit(0, "lines"), 
        strip.background = element_blank(),
        strip.placement = "bottom",
        panel.border = element_rect(fill = NA, color="white")) +
  ggtitle("Outcome C")


#layout matrix for the 3 plots and one legend

lay <- rbind(c(1,2,3,4),c(1,2,3,4),
             c(1,2,3,4),c(1,2,3,4))


g_legend<-function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend)}
#return one legend for plot 
aleg <- g_legend(p1)
gp1 <- p1+ theme(legend.position = "none")
gp2 <- p2+ theme(legend.position = "none")
gp3 <- p3+ theme(legend.position = "none")



gridExtra::grid.arrange(gp1,gp2,gp3,aleg, layout_matrix = lay)

score 1 · Accepted Answer · answered Oct 26 '18 at 02:44

This isn't a perfect solution, but it's perhaps more scaleable. It's based on the "shared legends" vignette from cowplot.

I'm splitting the data by outcomes, then using purrr::imap to make a list of three identical plots, rather than creating them individually or otherwise hardcoding anything. Then I'm using 2 cowplot functions, one to extract the legend as a ggplot/gtable object, and one to build a grid of plots and other plot-like objects.

Each plot is done for just one outcome, with time—either 3 or 12—on the x-axis, and facetted by estimate. Similar to how you did, the facets are disguised to look more like subtitles.

There are some design concerns that you'll probably want to tweak further. For example, I adjusted the scale expansion to make padding between groups to get the look you posted. I traded the panel border for axis lines to keep from having a border in the middle of each plot, since it will draw in between the facets—there might be a better way to do this.

library(tidyverse)

plot_list <- df %>%
  split(.$outcome) %>%
  imap(function(sub_df, outcome_name) {
    ggplot(sub_df, aes(x = as_factor(time), y = gd, shape = estimate)) +
      geom_errorbar(aes(ymin = gd.lwr, ymax = gd.upr), width = 0.1, position = position_dodge(width = 0.5)) +
      geom_point(position = position_dodge(width = 0.5)) +
      geom_hline(yintercept = 0) +
      scale_x_discrete(expand = expand_scale(add = 2)) +
      ylim(-1, 1) +
      facet_wrap(~ estimate, strip.position = "bottom") +
      theme_bw() +
      theme(panel.grid = element_blank(),
            panel.spacing = unit(0, "lines"),
            panel.border = element_blank(),
            axis.line = element_line(color = "black"),
            strip.background = element_blank(),
            strip.placement = "outside", 
            plot.title = element_text(hjust = 0.5)) +
      labs(title = outcome_name)
  })

Each plot in the list is then:

plot_list[[1]]

Extract the legend, then map over the list of plots to remove their legends.

legend <- cowplot::get_legend(plot_list[[1]])

no_legends <- plot_list %>%
  map(~{. + theme(legend.position = "none")})

One thing that was more manual than I would have preferred was messing with the labels. I opted for setting blank labels instead of NULL so there would still be empty text as placeholders, thus keeping the plots the same sizes. Because of needing to remove some labels, you do miss out on one nice feature of plot_grid, which is passing an entire list of plots in.

gridded <- cowplot::plot_grid(
  no_legends[[1]] + labs(x = ""),
  no_legends[[2]] + labs(y = ""),
  no_legends[[3]] + labs(x = "", y = ""),
  nrow = 1
)

Then make an additional grid where you add the legend to the right side and scale the widths accordingly:

cowplot::plot_grid(gridded, legend, nrow = 1, rel_widths = c(1, 0.2))

^{Created on 2018-10-25 by the reprex package (v0.2.1)}

On that note, maybe `patchwork` would be more straight-forward? — Roman, Oct 28 '18 at 16:12
Yeah, I thought about `patchwork` since I've been switching some things from `cowplot` to `patchwork`, but wanted to make use of `cowplot::get_legend`. That function is super handy for things like this, and AFAIK `patchwork` doesn't have something similar — camille, Oct 28 '18 at 16:23

add a level of nesting/grouping to x-axis

3 Answers3