1#' Horizontal error bars
2#'
3#' A rotated version of [geom_errorbar()].
4#'
5#' @eval rd_aesthetics("geom", "errorbarh")
6#' @inheritParams layer
7#' @inheritParams geom_point
8#' @export
9#' @examples
10#' df <- data.frame(
11#'   trt = factor(c(1, 1, 2, 2)),
12#'   resp = c(1, 5, 3, 4),
13#'   group = factor(c(1, 2, 1, 2)),
14#'   se = c(0.1, 0.3, 0.3, 0.2)
15#' )
16#'
17#' # Define the top and bottom of the errorbars
18#'
19#' p <- ggplot(df, aes(resp, trt, colour = group))
20#' p +
21#'   geom_point() +
22#'   geom_errorbarh(aes(xmax = resp + se, xmin = resp - se))
23#'
24#' p +
25#'   geom_point() +
26#'   geom_errorbarh(aes(xmax = resp + se, xmin = resp - se, height = .2))
27geom_errorbarh <- function(mapping = NULL, data = NULL,
28                           stat = "identity", position = "identity",
29                           ...,
30                           na.rm = FALSE,
31                           show.legend = NA,
32                           inherit.aes = TRUE) {
33  layer(
34    data = data,
35    mapping = mapping,
36    stat = stat,
37    geom = GeomErrorbarh,
38    position = position,
39    show.legend = show.legend,
40    inherit.aes = inherit.aes,
41    params = list(
42      na.rm = na.rm,
43      ...
44    )
45  )
46}
47
48
49#' @rdname ggplot2-ggproto
50#' @format NULL
51#' @usage NULL
52#' @export
53GeomErrorbarh <- ggproto("GeomErrorbarh", Geom,
54  default_aes = aes(colour = "black", size = 0.5, linetype = 1, height = 0.5,
55    alpha = NA),
56
57  draw_key = draw_key_path,
58
59  required_aes = c("xmin", "xmax", "y"),
60
61  setup_data = function(data, params) {
62    data$height <- data$height %||%
63      params$height %||% (resolution(data$y, FALSE) * 0.9)
64
65    transform(data,
66      ymin = y - height / 2, ymax = y + height / 2, height = NULL
67    )
68  },
69
70  draw_panel = function(data, panel_params, coord, height = NULL) {
71    GeomPath$draw_panel(new_data_frame(list(
72      x = as.vector(rbind(data$xmax, data$xmax, NA, data$xmax, data$xmin, NA, data$xmin, data$xmin)),
73      y = as.vector(rbind(data$ymin, data$ymax, NA, data$y,    data$y,    NA, data$ymin, data$ymax)),
74      colour = rep(data$colour, each = 8),
75      alpha = rep(data$alpha, each = 8),
76      size = rep(data$size, each = 8),
77      linetype = rep(data$linetype, each = 8),
78      group = rep(1:(nrow(data)), each = 8),
79      row.names = 1:(nrow(data) * 8)
80    )), panel_params, coord)
81  }
82)
83