Dividere la trama del violino con ggplot2

Mi piacerebbe creare un grafico della densità del violino diviso usando ggplot, come il quarto esempio in questa pagina della documentazione di Seaborn.

Ecco alcuni dati:

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

Posso tracciare violini schivati ​​come questo:

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

inserisci la descrizione dell'immagine qui

Ma è difficile confrontare visivamente le larghezze in diversi punti nelle distribuzioni side-by-side. Non sono stato in grado di trovare esempi di violini divisi in ggplot – è ansible?

Ho trovato una soluzione grafica di base R ma la funzione è piuttosto lunga e voglio evidenziare le modalità di distribuzione, che sono facili da aggiungere come livelli aggiuntivi in ​​ggplot, ma sarà più difficile da fare se ho bisogno di capire come modificare quella funzione.

Oppure, per evitare di manipolare le densità, potresti estendere il ggplot2 di ggplot2 in questo modo:

 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, ...)) } 

E usa il nuovo geom_split_violin questo modo:

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

inserisci la descrizione dell'immagine qui

È ansible raggiungere questo risultato calcolando in anticipo le densità e quindi tracciare i poligoni. Vedi sotto per un’idea approssimativa. Non dovrebbe essere troppo difficile scrivere questo in una funzione.

Ottieni densità

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

Capovolgi e compensa le densità per i gruppi

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

Tracciare

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

Risultato

inserisci la descrizione dell'immagine qui