genomewalker
4/26/2017 - 7:52 PM

From http://sahir.moosvi.com/2017-01-22-data_does_not_lie/

# somewhat hackish solution to:
# https://twitter.com/EamonCaddigan/status/646759751242620928
# based mostly on copy/pasting from ggplot2 geom_violin source:
# https://github.com/hadley/ggplot2/blob/master/R/geom-violin.r
# altered minorly to allow directionality of density plot
# 

library(ggplot2)
library(dplyr)


"%||%" <- function(a, b) {
  if (!is.null(a)) a else b
}


#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
GeomFlatViolin <-
  ggproto("GeomFlatViolin", Geom,
          
          setup_data = function(data, params) {
          data$width <- data$width %||%
          params$width %||% (resolution(data$x, FALSE) * 0.9)
            
          ## (3) Here we take the value the user givss and determines which direction the user wants.
          if (params$direction == 1) { 
               direction <-  +1
          } else if (params$direction == 2) {
               direction <-  -1
          }
            
            # ymin, ymax, xmin, and xmax define the bounding rectangle for each group
          data %>%
            group_by(group) %>%
            mutate(ymin = min(y),
                   ymax = max(y),
                   xmin = x,
                   ## (4) Now we can multiply by the direction to change it.
                   xmax = x + (direction * width / 2))
          },
          
          draw_group = function(data, panel_scales, coord) {
            # Find the points for the line to go all the way around
            data <- transform(data, xminv = x,
                              xmaxv = x + violinwidth * (xmax - x))
            
            # Make sure it's sorted properly to draw the outline
            newdata <- rbind(plyr::arrange(transform(data, x = xminv), y),
                             plyr::arrange(transform(data, x = xmaxv), -y))
            
            # Close the polygon: set first and last point the same
            # Needed for coord_polar and such
            newdata <- rbind(newdata, newdata[1,])
            
            ggplot2:::ggname("geom_flat_violin", GeomPolygon$draw_panel(newdata, panel_scales, coord))
            
          },
          
          draw_key = draw_key_polygon,
          
          # (5) We also specify the default setting of the direction here
          default_aes = aes(weight = 1, colour = "white", fill = "white", size = 0.5,
                            alpha = 0.5, linetype = "solid", direction = 1),
          
          
          required_aes = c("x", "y")
)

geom_flat_violin <- function(mapping = NULL, data = NULL, stat = "ydensity",
                        position = "dodge", trim = TRUE, scale = "area",
                        show.legend = NA, inherit.aes = TRUE, direction = 1, ...) {
  
  ## (1) Right above here is where I added 'direction = 1'
  ggplot2::layer(
    data = data,
    mapping = mapping,
    stat = stat,
    ## This calls the ggproto object
    geom = GeomFlatViolin,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      trim = trim,
      scale = scale,
      direction = direction, ## (2), told the layer function that this is a parameter
      ...
    )
  )
}