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的{{3}}小插图。

我要按结果划分数据，然后使用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))

^{由"shared legends"（v0.2.1）于2018-10-25创建}

在x轴上添加嵌套/分组级别

3 个答案: