New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

enhancement request: geom_flat_violin.R #2459

Closed
IndrajeetPatil opened this Issue Feb 21, 2018 · 5 comments

Comments

Projects
None yet
3 participants
@IndrajeetPatil

IndrajeetPatil commented Feb 21, 2018

This is not an issue, but an enhancement request for the development version. Any possibility that next release of ggplot2 will have David Robinson's awesome geom_flat_violin function in it?

@name geom_flat_violin
@author David Robinson
@note Author’s note: Somewhat hackish solution to:
https://twitter.com/EamonCaddigan/status/646759751242620928. This function
is based mostly on copy/pasting from ggplot2::geom_violin function

library(tidyverse)
#devtools::install_github(repo = "IndrajeetPatil/ggstatsplot")
library(ggstatsplot)
library(ggplot2)
library(dplyr)


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

#=========================== function definition ===========================

geom_flat_violin <-
  function(mapping = NULL,
           data = NULL,
           stat = "ydensity",
           position = "dodge",
           trim = TRUE,
           scale = "area",
           show.legend = NA,
           inherit.aes = TRUE,
           ...) {
    ggplot2::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 %>%
        dplyr::group_by(.data = ., group) %>%
        dplyr::mutate(
          .data = .,
          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 <- base::transform(data,
                              xminv = x,
                              xmaxv = x + violinwidth * (xmax - x))
      
      # Make sure it's sorted properly to draw the outline
      newdata <-
        base::rbind(
          dplyr::arrange(.data = base::transform(data, x = xminv), y),
          dplyr::arrange(.data = base::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 = ggplot2::aes(
      weight = 1,
      colour = "grey20",
      fill = "white",
      size = 0.5,
      alpha = NA,
      linetype = "solid"
    ),
    
    required_aes = c("x", "y")
  )

#============ Example ========================

# trying out only the geom_flat_violin function
ggplot2::ggplot(data = iris, mapping = ggplot2::aes(x = Species, y = Sepal.Length)) +
  geom_flat_violin() 

# adding other components to the underlying flat violin
ggplot2::ggplot(data = iris,
                mapping = ggplot2::aes(x = Species, y = Sepal.Length, fill = Species)) +
  geom_flat_violin(scale = "count", trim = FALSE) +
  ggplot2::stat_summary(
    fun.data = mean_sdl,
    fun.args = list(mult = 1),
    geom = "pointrange",
    position = ggplot2::position_nudge(x = 0.05, y = 0)
  ) +
  ggplot2::geom_dotplot(
    binaxis = "y",
    dotsize = 0.5,
    stackdir = "down",
    binwidth = 0.1,
    position = ggplot2::position_nudge(x = -0.025, y = 0)
  ) +
  ggplot2::labs(x = "Species", y = "Sepal length (cm)") +
  ggstatsplot::theme_mprl() +
  ggplot2::theme(legend.position = "none")

Created on 2018-03-15 by the reprex package (v0.2.0).

@thomasp85

This comment has been minimized.

Member

thomasp85 commented Feb 21, 2018

These more specialised germs are unlikely to be implemented in ggplot2 in order to keep maintenance burden on a reasonable level. Instead raise an issue at one of the many extension packages. FWIW I’m planning on adding this to ggforce eventually and you’re welcome to open an issue there as a reminder

@IndrajeetPatil

This comment has been minimized.

IndrajeetPatil commented Feb 21, 2018

@thomasp85 Ah, I see. Actually, I was thinking the same! I wanted to include this function in my package (currently in development: https://github.com/IndrajeetPatil/ggstatsplot) as well.

How does it work if I want to do that? I add David Robinson to authors in the file corresponding to this function? Is that sufficient or there are some license issues involved?

Thanks.

@thomasp85

This comment has been minimized.

Member

thomasp85 commented Feb 21, 2018

You would usually add him as author in the function documentation (and perhaps in the DESCRIPTION file)... but this is really a discussion you should have with @dgrtwo outside of this issue

@IndrajeetPatil

This comment has been minimized.

IndrajeetPatil commented Feb 21, 2018

Got it! Thanks.

@hadley hadley closed this Apr 27, 2018

@lock

This comment has been minimized.

lock bot commented Oct 24, 2018

This old issue has been automatically locked. If you believe you have found a related problem, please file a new issue (with reprex) and link to this issue. https://reprex.tidyverse.org/

@lock lock bot locked and limited conversation to collaborators Oct 24, 2018

Sign up for free to subscribe to this conversation on GitHub. Already have an account? Sign in.