R用小提琴图替换barplot中的一个小节

Question

我正在使用特定参数集的条形图比较 3 个模型的结果。条形图是必要的，因为我只有 2 个模型的中位数和可信区间。我想用小提琴图替换或覆盖每组的第三条（显示每组模型 3 参数的边际后验）。我很乐意使用 base R、ggplot 或其他任何有效的东西！

到目前为止我尝试过的简化版本如下：

library(ggplot2)
library(plyr)

## Data
params <- paste0("param", 1:3)
medians <- data.frame(value = c(seq(0.1,0.6, by = 0.1), rep(0, 3)),
                      model = rep(c("M1", "M2", "M3"), each = 3),
                      parameter = rep(paste0("param", 1:3), 3))
m3_posterior <- data.frame(value = runif(900, 0.2, 0.7), 
                           model = "M3", 
                           parameter = rep(params, each = 3)) 
m3_stats <- ddply(m3_posterior, .(parameter), summarize,
                 lower = quantile(value, 0.025), 
                 upper = quantile(value, 0.975) ) 
confs <- data.frame(lower = c(seq(0.05, 0.55, by = 0.1), m3_stats$lower),
                    upper = c(seq(0.15, 0.65, by = 0.1), m3_stats$upper),
                    model = rep(c("M1", "M2", "M3"), each = 3),
                    parameter = rep(params, 3))                        

## plotting code
transparent_theme <- theme(
 axis.title.x = element_blank(),
 axis.title.y = element_blank(),
 axis.text.x = element_blank(),
 axis.text.y = element_blank(),
 axis.ticks = element_blank(),
 panel.grid = element_blank(),
 axis.line = element_blank(),
 panel.background = element_rect(fill = "transparent",colour = NA),
 plot.background = element_rect(fill = "transparent",colour = NA))

print_list <- list()
for (param in 1 : length(params)) {
  gg_medians <- subset(medians, parameter == params[param])
  gg_confs <- subset(confs, parameter == params[param])
  gg_post <- subset(m3_posterior, parameter == params[param])

  p1 <- ggplot(gg_medians, aes(model, value)) + 
        geom_bar(stat="identity", fill = "white", colour = "black") +
        geom_errorbar(data = gg_confs, 
                      aes(y=upper, ymax=upper, ymin=lower)) +
        scale_y_continuous(limits=c(0,1)) + labs(x=params[param])

  p2 <- ggplot(gg_post, aes(parameter, value)) +
        geom_violin(width=1.5, fill = NA)+
        transparent_theme +
        geom_errorbar(data = subset(gg_confs, model == "M3"),
            aes(y=upper, ymax=upper, ymin=lower)) +
        scale_y_continuous(limits=c(0,1)) + labs(x=params[param])

  if (param > 1 ) {
    p1 <- p1 + theme(axis.title.y=element_blank(),
                     axis.text.y=element_blank(),
                     axis.ticks.y=element_blank())
    p2 <- p2 + theme(axis.title.y=element_blank(),
               axis.text.y=element_blank(),
               axis.ticks.y=element_blank())
  }
  p2_grob <- ggplotGrob(p2)

  print_list[[param]] <- p1 + annotation_custom(grob = p2_grob, 
                           xmin = 2.5, xmax = 3.5,
                           ymin = -0.0665, ymax = 1.061)
}

lay_out = function(...) {
  x <- list(...)
  n <- max(sapply(x, function(x) max(x[[2]])))
  p <- max(sapply(x, function(x) max(x[[3]])))
  grid::pushViewport(grid::viewport(layout = grid::grid.layout(n, p)))

  for (i in seq_len(length(x))) {
    print(x[[i]][[1]], vp = grid::viewport(
    layout.pos.row = x[[i]][[2]],
    layout.pos.col = x[[i]][[3]]))
  }
}
lay_out(list(print_list[[1]], 1, 1),
    list(print_list[[2]], 1, 2),
    list(print_list[[3]], 1, 3))

我遇到的主要问题是：

• 将小提琴图 grob 与底层条形图对齐（我主要使用猜测和检查数字）

• 保持每个图形的绘图区域相同，而第一个图形只有一个 y 轴

Answer 1

您似乎希望 m3 中的两个误差线垂直和水平对齐。

水平对齐 - 您将各种轴元素设置为空白的方法不太奏效 - 轴中剩余一小块空间。我发现从 p2 的 gtable 中选择绘图面板更容易，然后将其插入 p1。

垂直对齐 - 将 ymin 和 ymax 设置为 -Inf 和 Inf 应该注意垂直对齐，前提是两个图的限制相同。我已将小提琴图中误差条的颜色更改为红色，以便更容易看到对齐（或未对齐）。

使三个绘图面板的宽度相同 - 从 print_list[[1]] 中剥离轴材料，然后使三个面板的宽度为单位（1，“npc”）。此外，您可以从 print_list[[2]] 和 print_list[[3]] 中选择绘图面板，因此无需将轴元素设置为空白。我发现使用 gtable 设置布局更容易。

此外，您会收到一条警告消息，因为 geom_errorbar 没有 y 美感。而且，在 m3 处，您会在 y=0 处得到一条线，因为条形高度设置为零。如果您不想要这条线，请将条形高度设置为 NA。

## Data
library(ggplot2)
library(plyr)
library(gtable)
library(grid)

params <- paste0("param", 1:3)
medians <- data.frame(value = c(seq(0.1,0.6, by = 0.1), rep(NA, 3)),
                      model = rep(c("M1", "M2", "M3"), each = 3),
                      parameter = rep(paste0("param", 1:3), 3))
m3_posterior <- data.frame(value = runif(900, 0.2, 0.7), 
                           model = "M3", 
                           parameter = rep(params, each = 3)) 
m3_stats <- ddply(m3_posterior, .(parameter), summarize,
                 lower = quantile(value, 0.025), 
                 upper = quantile(value, 0.975) ) 
confs <- data.frame(lower = c(seq(0.05, 0.55, by = 0.1), m3_stats$lower),
                    upper = c(seq(0.15, 0.65, by = 0.1), m3_stats$upper),
                    model = rep(c("M1", "M2", "M3"), each = 3),
                    parameter = rep(params, 3))                        

print_list <- list()

for (param in 1 : length(params)) {
  gg_medians <- subset(medians, parameter == params[param])
  gg_confs <- subset(confs, parameter == params[param])
  gg_post <- subset(m3_posterior, parameter == params[param])

  p1 <- ggplot(gg_medians, aes(model)) + 
        geom_bar(aes(y = value), stat="identity", fill = "white", colour = "black") +
        geom_errorbar(data = gg_confs, 
                      aes(ymax=upper, ymin=lower)) +
        scale_y_continuous(limits=c(0,1)) + labs(x=params[param])

  p2 <- ggplot(gg_post, aes(parameter)) +
        geom_violin(aes(y = value), width=1.5, fill = NA) +
        geom_errorbar(data = subset(gg_confs, model == "M3"),
            aes(ymax=upper, ymin=lower), colour = "red") +
        scale_y_continuous(limits=c(0,1)) + labs(x=params[param]) + 
        theme_bw() +
        theme(panel.grid = element_blank(),
              panel.border = element_blank(),
              panel.background = element_rect(fill = "transparent"))

  p2_grob <- ggplotGrob(p2)
  panel = gtable_filter(p2_grob, "panel")   # Select plot panel from p2

  print_list[[param]] <- p1 + annotation_custom(grob = panel,
                           xmin = 2.5, xmax = 3.5,
                           ymin = -Inf, ymax = Inf)      # Put the panel it into p1
}

# From print_list:
#    separate y-axis and panel columns in print_list[[1]]
#    and get panel columns from print_list[[2]] and print_list[[3]]
g1 = ggplotGrob(print_list[[1]])   
axis = g1[, 2:3]                  # Get the y axis
g1 = g1[, -c(1:3)]                # Get the panel & columns to the right for param1
g2 = ggplotGrob(print_list[[2]])
g2 = g2[, -c(1:3)]                # Get the panel & columns to the right for param2
g3 = ggplotGrob(print_list[[3]])
g3 = g3[, -c(1:3)]                # Get the panel & columns to the right for param3

# Set up gtable 5 columns X 1 row
#    5 columns: left margin, width of y axis, width of three panels 
#    1 row
gt = gtable(unit.c(unit(5.5, "pt"), sum(axis$widths), unit(c(1,1,1), "null")), unit(1, "null"))

# Populate the gtable, and draw the plot
gt = gtable_add_grob(gt, list(axis, g1, g2, g3), t = 1, l = 2:5)
grid.newpage()
grid.draw(gt)