向 x 轴添加嵌套/分组级别

Question

我希望在 x 轴上添加第二层分组，如下面的结果 A 面板所示。每种估计类型（ITT 与 TOT）应该有两个点对应于标签 3 或 12。

这是我获得所见内容的方法，减去对结果 A 面板的编辑：

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

这是玩具数据：

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

将 x 美学更改为 interaction(time, factor(estimate)) 并添加了合适的离散标签。

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

Answer 2

使用grid.arrange 发布解决方案。我更新了答案，只包含一个图例。

    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 3

这不是一个完美的解决方案，但它可能更具可扩展性。它基于来自cowplot 的"shared legends" 小插图。

我按结果拆分数据，然后使用purrr::imap 列出三个相同的图，而不是单独创建它们或以其他方式硬编码任何东西。然后我使用了 2 个cowplot 函数，一个用于将图例提取为ggplot/gtable 对象，另一个用于构建绘图网格和其他类似绘图的对象。

每个图只针对一个结果完成，time（3 或 12）在 x 轴上，并由 estimate 分面。与您所做的类似，这些方面被伪装成更像字幕。

您可能需要进一步调整一些设计问题。例如，我调整了比例扩展以在组之间进行填充以获得您发布的外观。我将面板边框换成了轴线，以防止在每个绘图的中间出现边框，因为它会在刻面之间绘制 - 可能有更好的方法来做到这一点。

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

列表中的每个图都是：

plot_list[[1]]

提取图例，然后映射到绘图列表以删除它们的图例。

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

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

比我更喜欢手动的一件事是弄乱标签。我选择设置空白标签而不是NULL，因此仍然会有空文本作为占位符，从而保持绘图的大小相同。由于需要删除一些标签，您确实错过了plot_grid 的一个不错的功能，即传入整个绘图列表。

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

然后制作一个额外的网格，将图例添加到右侧并相应地缩放宽度：

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

^{由reprex package (v0.2.1) 于 2018 年 10 月 25 日创建}