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