R replace one bar in barplot with violin plot

Question

I am comparing the results of 3 models using a barplot for a certain set of parameters. The barplot is necessary because I only have the medians and credible intervals for 2 of the models. I would like to replace or overlay the 3rd bar for each group with a violin plot (showing the marginal posterior for the Model 3 parameter for each group). I'm happy to use base R, ggplot or anything else that works!

A simplified version of what I have tried so far is below:

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

The main problems I'm having are:

• aligning the violin plot grob with the underlying bar plot (I basically used guess and check on the numbers)

• keeping the plot area of each graph the same whilst only having a y axis on the first one

Answer 1

It appears that you want the two errorbars in m3 to align, vertically and horizontally.

Horizontal alignment - Your method of setting various axis elements to blank doesn't quite work - there is a small space remaining in the axis. I find it easier to select the plot panel from p2's gtable, then insert that into p1.

Vertical alignment - setting ymin and ymax to -Inf and Inf should take care of vertical alignment, providing the limits for the two plots are the same. I've changed the colour of the errorbars in the violin plot to red so that it is easier to see the alignment (or misalignment).

Getting the widths of the three plot panels to be the same - strip off the axis material from print_list[[1]], then make the widths of the three panel be unit(1, "npc"). Also, you can select the plot panel from print_list[[2]] and print_list[[3]], and so there is no need for setting axis elements to blank. I find it easier to set up the layout using gtable.

Also, you get a warning message because geom_errorbar does not have a y aesthetic. And, at m3, you get a line at y=0 because the bar height is set to zero. If you don't want the line, set the bar height to 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)