web-dev-qa-db-fra.com

Split violon plot avec ggplot2

Je voudrais créer un tracé de densité de violon divisé en utilisant ggplot, comme le quatrième exemple sur cette page de la documentation marine.

enter image description here

Voici quelques données:

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

Je peux tracer des violons évités comme ceci:

library('ggplot2')

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

enter image description here

Mais il est difficile de comparer visuellement les largeurs en différents points des distributions côte à côte. Je n'ai pas pu trouver d'exemples de violons séparés dans ggplot - est-ce possible?

J'ai trouvé une solution graphique de base R mais la fonction est assez longue et je veux mettre en évidence les modes de distribution, qui sont faciles à ajouter en tant que couches supplémentaires dans ggplot mais seront plus difficiles à faire si j'ai besoin de comprendre comment modifier cette fonction.

rggplot2violin-plotggproto
34
user102162

Ou, pour éviter de jouer avec les densités, vous pouvez étendre ggplot2's GeomViolin comme ceci:

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

Et utilisez le nouveau geom_split_violin comme ça:

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

enter image description here

41
jan-glx

Note : Je pense que la réponse de jan-glx est bien meilleure, et la plupart des gens devraient l'utiliser à la place.

Vous pouvez y parvenir en calculant vous-même les densités au préalable, puis en traçant des polygones. Voir ci-dessous pour une idée approximative.

Obtenez des densités

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

Inverser et compenser les densités pour les groupes

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

Plot

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

Résultat

enter image description here

42
Axeman