Fill transparency with geom_violin - r

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.

Answer 1

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