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))

Answer 1

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)

Answer 2

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)}

Answer 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