r - R barplot の 1 つのバーをバイオリンプロットに置き換えます

Question

特定のパラメータセットの棒グラフを使用して、3 つのモデルの結果を比較しています。2 つのモデルの中央値と信頼区間しかないため、棒グラフが必要です。各グループの 3 番目のバーをバイオリンプロット (各グループのモデル 3 パラメーターの周辺事後分布を表示) に置き換えるかオーバーレイしたいと思います。ベース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))

私が抱えている主な問題は次のとおりです。

バイオリンプロットグロブを基礎となるバープロットに合わせます (基本的に推測を使用して数値を確認しました)。
最初のグラフにのみy軸を持ちながら、各グラフのプロット領域を同じに保ちます

score 0 · Accepted Answer

m3 の 2 つのエラーバーを垂直方向と水平方向に揃えたいようです。

水平方向の配置 - さまざまな軸要素を空白に設定する方法がうまく機能しません。軸に小さなスペースが残っています。p2 の gtable からプロットパネルを選択し、それを p1 に挿入する方が簡単だと思います。

垂直方向の配置 - ymin と ymax を -Inf と Inf に設定すると、2 つのプロットの制限が同じであれば、垂直方向の配置が処理されます。ヴァイオリンプロットのエラーバーの色を赤に変更して、アライメント (またはミスアライメント) を見やすくしました。

3 つのプロットパネルの幅を同じにする - print_list[[1]] から軸のマテリアルを取り除き、3 つのパネルの幅を unit(1, "npc") にします。また、プロットパネルは print_list[[2]] と print_list[[3]] から選択できるため、軸要素を空白にする必要はありません。gtable を使用してレイアウトを設定する方が簡単だと思います。

また、geom_errorbar には美学がないため、警告メッセージが表示されます。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)

r - R barplot の 1 つのバーをバイオリン プロットに置き換えます

1 に答える 1

Related

Reference

r - R barplot の 1 つのバーをバイオリンプロットに置き換えます