Skip to content

Instantly share code, notes, and snippets.

@tjmahr
Created October 9, 2024 20:29
Show Gist options
  • Save tjmahr/9efd057e99ea91535a3c17812f596e61 to your computer and use it in GitHub Desktop.
Save tjmahr/9efd057e99ea91535a3c17812f596e61 to your computer and use it in GitHub Desktop.
my-bad-geom
library(ggplot2)

geom_crossrange <- function(
    mapping = NULL,
    data = NULL,
    stat = "identity",
    position = "identity",
    ...,
    na.rm = FALSE,
    orientation = NA,
    show.legend = NA,
    inherit.aes = TRUE
) {
  ggplot2::layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomCrossrange,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = rlang::list2(
      na.rm = na.rm,
      orientation = orientation,
      ...
    )
  )
}

GeomCrossrange <- ggproto(
  "GeomCrossrange",
  Geom,

  default_aes = aes(
    colour = "black",
    linewidth = 0.5,
    linetype = 1,
    width = 0.1,
    alpha = NA
  ),

  draw_key = draw_key_path,

  required_aes = c("x", "y", "ymin|xmin", "ymax|xmax"),

  setup_params = function(data, params) {
    GeomErrorbar$setup_params(data, params)
  },

  extra_params = c("na.rm", "orientation"),

  setup_data = function(data, params) {
    data$width <- data$width %||%
      params$width %||% (resolution(data$x, FALSE, TRUE) * 0.1)
    GeomErrorbar$setup_data(data, params)
  },

  draw_panel = function(self, data, panel_params, coord, lineend = "butt",
                        width = NULL, flipped_aes = FALSE) {
    data <- ggplot2:::check_linewidth(data, snake_class(self))
    data <- flip_data(data, flipped_aes)
    x <- vctrs::vec_interleave(data$xmin, data$xmax, NA, data$x,    data$x)
    y <- vctrs::vec_interleave(data$y,    data$y,    NA, data$ymax, data$ymin)
    lw <- vctrs::vec_interleave(data$linewidth * 2, data$linewidth * 2, NA, data$linewidth, data$linewidth)
    data <- ggplot2:::data_frame0(
      x = x,
      y = y,
      colour = rep(data$colour, each = 5),
      alpha = rep(data$alpha, each = 5),
      linewidth = lw,
      linetype = rep(data$linetype, each = 5),
      group = rep(seq_len(nrow(data)), each = 5),
      .size = nrow(data) * 5
    )
    data <- flip_data(data, flipped_aes)
    GeomPath$draw_panel(data, panel_params, coord, lineend = lineend)
  },

  rename_size = TRUE
)

library(tidyverse)
d <- mtcars |>
  dplyr::group_by(cyl) |>
  dplyr::reframe(mean_se(mpg))

ggplot(d) +
  geom_crossrange(aes(x = cyl, y = y, ymin = ymin, ymax = ymax, color = cyl))

ggplot(mtcars) +
  aes(x = cyl, y = wt) +
  stat_summary(geom = "crossrange")
#> No summary function supplied, defaulting to `mean_se()`

Created on 2024-10-09 with reprex v2.1.1

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