Fill transparency with geom_violin

Question

How can increase the alpha of the fill of violin plots but not the alpha of the boundary line?

Changing alpha as an argument to geom_violin() results in both the fill and line changing.

Plot twice, once for the line, once for the fill. – alistaire Jan 12 '16 at 23:30 — alistaire, Jan 12 '16 at 23:30

score 2 · Accepted Answer · answered Jan 13 '16 at 09:04

Here's what can be done if you wish to avoid plotting twice. Since the introduction of the extension mechanism we can easily modify the existing source code to define our own geoms.

First we need to check what's going on in geom_violin. The actual plotting is done with GeomPolygon$draw_panel(newdata, ...). So the trick is to tinker with geom_polygon. The modification required is really simple: in the plotting block

  polygonGrob(munched$x, munched$y, default.units = "native",
    id = munched$group,
    gp = gpar(
      col = alpha(first_rows$colour, first_rows$alpha),
      fill = alpha(first_rows$fill, first_rows$alpha),
      lwd = first_rows$size * .pt,
      lty = first_rows$linetype
    )
  )

just replace colour specification to col = first_rows$colour.

Alright, we're good to go. Just declare our custom geom_violin2, borrowing the code from original source and applying several ad-hoc fixes.

library(grid)
GeomPolygon2 <- ggproto("GeomPolygon2", Geom,
                        draw_panel = function(data, panel_scales, coord) {
                          n <- nrow(data)
                          if (n == 1) return(zeroGrob())
                          munched <- coord_munch(coord, data, panel_scales)
                          munched <- munched[order(munched$group), ]
                          first_idx <- !duplicated(munched$group)
                          first_rows <- munched[first_idx, ]
                          ggplot2:::ggname("geom_polygon",
                                           polygonGrob(munched$x, munched$y, default.units = "native",
                                                       id = munched$group,
                                                       gp = gpar(
                                                         col = first_rows$colour,
                                                         fill = alpha(first_rows$fill, first_rows$alpha),
                                                         lwd = first_rows$size * .pt,
                                                         lty = first_rows$linetype
                                                       )
                                           )
                          )
                        },
                        default_aes = aes(colour = "NA", fill = "grey20", size = 0.5, linetype = 1,
                                          alpha = NA),
                        handle_na = function(data, params) {
                          data
                        },
                        required_aes = c("x", "y"),
                        draw_key = draw_key_polygon
)

`%||%` <- function (a, b) 
{
  if (!is.null(a)) 
    a
  else b
}

GeomViolin2 <- ggproto("GeomViolin", Geom,
                       setup_data = function(data, params) {
                         data$width <- data$width %||%
                           params$width %||% (resolution(data$x, FALSE) * 0.9)
                         plyr::ddply(data, "group", transform,
                                     xmin = x - width / 2,
                                     xmax = x + width / 2
                         )
                       },

                       draw_group = function(self, data, ..., draw_quantiles = NULL) {
                         data <- transform(data,
                                           xminv = x - violinwidth * (x - xmin),
                                           xmaxv = x + violinwidth * (xmax - x)
                         )
                         newdata <- rbind(
                           plyr::arrange(transform(data, x = xminv), y),
                           plyr::arrange(transform(data, x = xmaxv), -y)
                         )
                         newdata <- rbind(newdata, newdata[1,])
                         if (length(draw_quantiles) > 0) {
                           stopifnot(all(draw_quantiles >= 0), all(draw_quantiles <= 1))
                           quantiles <- create_quantile_segment_frame(data, draw_quantiles)
                           aesthetics <- data[
                             rep(1, nrow(quantiles)),
                             setdiff(names(data), c("x", "y")),
                             drop = FALSE
                             ]
                           both <- cbind(quantiles, aesthetics)
                           quantile_grob <- GeomPath$draw_panel(both, ...)
                           ggplot2:::ggname("geom_violin", grobTree(
                             GeomPolygon2$draw_panel(newdata, ...),
                             quantile_grob)
                           )
                         } else {
                           ggplot2:::ggname("geom_violin", GeomPolygon2$draw_panel(newdata, ...))
                         }
                       },
                       draw_key = draw_key_polygon,
                       default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = 0.5,
                                         alpha = NA, linetype = "solid"),
                       required_aes = c("x", "y")
)

geom_violin2 <- function(mapping = NULL, data = NULL, stat = "ydensity",
                         draw_quantiles = NULL, position = "dodge",
                         trim = TRUE, scale = "area",
                         na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
                         ...) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomViolin2,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      trim = trim,
      scale = scale,
      draw_quantiles = draw_quantiles,
      na.rm = na.rm,
      ...
    )
  )
}

Now behold! The colours are questionable, I admit. But you can clearly see that the border is not affected by alpha.

ggplot(mtcars, aes(factor(cyl), mpg)) + 
  geom_violin2(alpha = 0.7, size = 3, colour = "blue", fill = "red")

Fill transparency with geom_violin

1 Answers1