R barplot의 막대 하나를 바이올린 플롯으로 바꾸십시오.

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

주요 문제는 다음과 같습니다

• (나는 기본적으로 추측을 사용하고 번호 확인)

• 유지 기본 막대 그래프와 바이올린 플롯 GROB 정렬 각 그래프의 플롯 영역은 첫 번째 축에만 y 축을 갖는 반면 동일 함

Answer 1

m3의 두 오류 막대를 세로 및 가로로 정렬해야합니다.

수평 정렬 - 다양한 축 요소를 공백으로 설정하는 방법이 제대로 작동하지 않습니다. 축에 작은 공간이 남아 있습니다. 나는 p2의 gtable에서 플롯 패널을 선택하는 것이 더 쉽다는 것을 알았고 p1에 그것을 삽입했다.

세로 정렬 - yIn 및 ymax를 -Inf로 설정하고 Inf가 두 개의 플롯에 대한 제한이 동일하면 수직 정렬을 처리해야합니다. 바이올린 플롯의 오차 막대 색상을 빨간색으로 변경하여 정렬 (또는 정렬 불일치)을보기가 더 쉽습니다.

세 개의 플롯 패널의 폭을 동일하게 설정 - print_list [[1]]에서 축 재료를 제거한 다음 세 패널의 너비를 단위 (1, "npc")로 지정하십시오. 또한 print_list [[2]] 및 print_list [[3]]에서 플롯 패널을 선택할 수 있으므로 축 요소를 비워 둘 필요가 없습니다. gtable을 사용하여 레이아웃을 쉽게 설정할 수 있습니다.

또한 geom_errorbar에는 미적 효과가 없으므로 경고 메시지가 표시됩니다. 그리고 m3에서 막대 높이가 0으로 설정되어 있기 때문에 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)