R/geom_flat_violin.R

#' #' @title geom_flat_violin
#' #' @description This function/Geom contains the code to create half-violin plots
#' #' @param ... further arguments, including the variable/s by which to group_split and set names
#' #' @import ggplot2
#' #' @import dplyr
#' #' @export
#' #' @examples
#' #' geom_flat_violin()
#' #' ### Example:
#' #' ggplot(diamonds, aes(cut, carat)) +
#' #' geom_flat_violin() +
#' #' coord_flip()
#'
#' # 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
#'
#'
#' #'
#' #'
#' #' @importFrom purrr `%||%`
#' #' @export
#' geom_flat_violin <- function(mapping = NULL, data = NULL, stat = "ydensity",
#'                         position = "dodge", trim = TRUE, scale = "area",
#'                         show.legend = NA, inherit.aes = TRUE, ...) {
#'   layer(
#'     data = data,
#'     mapping = mapping,
#'     stat = stat,
#'     geom = GeomFlatViolin,
#'     position = position,
#'     show.legend = show.legend,
#'     inherit.aes = inherit.aes,
#'     params = list(
#'       trim = trim,
#'       scale = scale,
#'       ...
#'     )
#'   )
#' }
#'
#' #' @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)
#'
#'             # 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,
#'                      xmax = x + 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,
#'
#'           default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = 0.5,
#'                             alpha = NA, linetype = "solid"),
#'
#'           required_aes = c("x", "y")
#' )
#'
#'
jimjunker1/junkR documentation built on Sept. 22, 2023, 9:20 a.m.