Diagtwig de violín dividido con ggplot2

Me gustaría crear una gráfica de densidad de violín dividida usando ggplot, como el cuarto ejemplo en esta página de la documentación nacida.

Aquí hay algunos datos:

set.seed(20160229) my_data = data.frame( y=c(rnorm(1000), rnorm(1000, 0.5), rnorm(1000, 1), rnorm(1000, 1.5)), x=c(rep('a', 2000), rep('b', 2000)), m=c(rep('i', 1000), rep('j', 2000), rep('i', 1000)) ) 

Puedo trazar violines esquivados así:

 library('ggplot2') ggplot(my_data, aes(x, y, fill=m)) + geom_violin() 

enter image description here

Pero es difícil comparar visualmente los anchos en diferentes puntos de las distribuciones lado a lado. No he podido encontrar ejemplos de violines divididos en ggplot. ¿Es posible?

Encontré una solución de gráficos base R pero la función es bastante larga y quiero resaltar los modos de distribución, que son fáciles de agregar como capas adicionales en ggplot, pero será más difícil si necesito descubrir cómo editar esa función.

O bien, para evitar manipular las densidades, podría ampliar ggplot2 de ggplot2 de esta manera:

 GeomSplitViolin <- ggproto("GeomSplitViolin", GeomViolin, draw_group = function(self, data, ..., draw_quantiles = NULL){ data <- transform(data, xminv = x - violinwidth * (x - xmin), xmaxv = x + violinwidth * (xmax - x)) grp <- data[1,'group'] newdata <- plyr::arrange(transform(data, x = if(grp%%2==1) xminv else xmaxv), if(grp%%2==1) y else -y) newdata <- rbind(newdata[1, ], newdata, newdata[nrow(newdata), ], newdata[1, ]) newdata[c(1,nrow(newdata)-1,nrow(newdata)), 'x'] <- round(newdata[1, 'x']) if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) { stopifnot(all(draw_quantiles >= 0), all(draw_quantiles <= 1)) quantiles <- ggplot2:::create_quantile_segment_frame(data, draw_quantiles) aesthetics <- data[rep(1, nrow(quantiles)), setdiff(names(data), c("x", "y")), drop = FALSE] aesthetics$alpha <- rep(1, nrow(quantiles)) both <- cbind(quantiles, aesthetics) quantile_grob <- GeomPath$draw_panel(both, ...) ggplot2:::ggname("geom_split_violin", grid::grobTree(GeomPolygon$draw_panel(newdata, ...), quantile_grob)) } else { ggplot2:::ggname("geom_split_violin", GeomPolygon$draw_panel(newdata, ...)) } }) geom_split_violin <- function (mapping = NULL, data = NULL, stat = "ydensity", position = "identity", ..., draw_quantiles = NULL, trim = TRUE, scale = "area", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { layer(data = data, mapping = mapping, stat = stat, geom = GeomSplitViolin, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list(trim = trim, scale = scale, draw_quantiles = draw_quantiles, na.rm = na.rm, ...)) } 

Y usa el nuevo geom_split_violin siguiente manera:

 ggplot(my_data, aes(x, y, fill=m)) + geom_split_violin() 

enter image description here

Puede lograr esto calculando las densidades usted mismo de antemano, y luego trazando polígonos. Vea a continuación una idea aproximada. No debería ser demasiado difícil escribir esto en una función.

Obtener densidades

 library(dplyr) pdat <- my_data %>% group_by(x, m) %>% do(data.frame(loc = density(.$y)$x, dens = density(.$y)$y)) 

Volúmenes y densidades de compensación para los grupos

 pdat$dens <- ifelse(pdat$m == 'i', pdat$dens * -1, pdat$dens) pdat$dens <- ifelse(pdat$x == 'b', pdat$dens + 1, pdat$dens) 

Ttwig

 ggplot(pdat, aes(dens, loc, fill = m, group = interaction(m, x))) + geom_polygon() + scale_x_continuous(breaks = 0:1, labels = c('a', 'b')) + ylab('density') + theme_minimal() + theme(axis.title.x = element_blank()) 

Resultado

enter image description here