Заполнить прозрачность с помощью geom_violin

Question

Как можно увеличить альфа заполнения скрипичных графиков, но не альфа граничной линии?

Изменение альфы в качестве аргумента geom_violin() приводит к изменению как заполнения, так и изменения строки.

Answer 1

Вот что можно сделать, если вы хотите избежать печати дважды. С момента введения extension mechanism мы можем легко изменить существующие source code, чтобы определить наши собственные геометрии.

Сначала нам нужно проверить, что происходит в geom_violin. Фактическое построение выполняется с помощью GeomPolygon$draw_panel(newdata, ...). Таким образом, трюк состоит в том, чтобы возиться с geom_polygon. Модификация требуется очень проста: в черчения блок

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

просто заменить цветовую спецификацию col = first_rows$colour.

Хорошо, мы в порядке. Просто объявите наш заказ geom_violin2, заимствуя код из исходного источника и применяя несколько специальных исправлений.

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

Теперь вот! Я признаю, что цвета сомнительны. Но вы можете ясно видеть, что на границу не влияет alpha.

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