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