forked from tidyverse/ggplot2
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathgeom-linerange.r
122 lines (115 loc) · 4.01 KB
/
geom-linerange.r
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
#' Vertical intervals: lines, crossbars & errorbars
#'
#' Various ways of representing a vertical interval defined by `x`,
#' `ymin` and `ymax`. Each case draws a single graphical object.
#'
#' @eval rd_orientation()
#'
#' @eval rd_aesthetics("geom", "linerange")
#' @param fatten A multiplicative factor used to increase the size of the
#' middle bar in `geom_crossbar()` and the middle point in
#' `geom_pointrange()`.
#' @seealso
#' [stat_summary()] for examples of these guys in use,
#' [geom_smooth()] for continuous analogue,
#' [geom_errorbarh()] for a horizontal error bar.
#' @export
#' @inheritParams layer
#' @inheritParams geom_bar
#' @examples
#' # Create a simple example dataset
#' df <- data.frame(
#' trt = factor(c(1, 1, 2, 2)),
#' resp = c(1, 5, 3, 4),
#' group = factor(c(1, 2, 1, 2)),
#' upper = c(1.1, 5.3, 3.3, 4.2),
#' lower = c(0.8, 4.6, 2.4, 3.6)
#' )
#'
#' p <- ggplot(df, aes(trt, resp, colour = group))
#' p + geom_linerange(aes(ymin = lower, ymax = upper))
#' p + geom_pointrange(aes(ymin = lower, ymax = upper))
#' p + geom_crossbar(aes(ymin = lower, ymax = upper), width = 0.2)
#' p + geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.2)
#'
#' # Flip the orientation by changing mapping
#' ggplot(df, aes(resp, trt, colour = group)) +
#' geom_linerange(aes(xmin = lower, xmax = upper))
#'
#' # Draw lines connecting group means
#' p +
#' geom_line(aes(group = group)) +
#' geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.2)
#'
#' # If you want to dodge bars and errorbars, you need to manually
#' # specify the dodge width
#' p <- ggplot(df, aes(trt, resp, fill = group))
#' p +
#' geom_col(position = "dodge") +
#' geom_errorbar(aes(ymin = lower, ymax = upper), position = "dodge", width = 0.25)
#'
#' # Because the bars and errorbars have different widths
#' # we need to specify how wide the objects we are dodging are
#' dodge <- position_dodge(width=0.9)
#' p +
#' geom_col(position = dodge) +
#' geom_errorbar(aes(ymin = lower, ymax = upper), position = dodge, width = 0.25)
#'
#' # When using geom_errorbar() with position_dodge2(), extra padding will be
#' # needed between the error bars to keep them aligned with the bars.
#' p +
#' geom_col(position = "dodge2") +
#' geom_errorbar(
#' aes(ymin = lower, ymax = upper),
#' position = position_dodge2(width = 0.5, padding = 0.5)
#' )
geom_linerange <- function(mapping = NULL, data = NULL,
stat = "identity", position = "identity",
...,
na.rm = FALSE,
orientation = NA,
show.legend = NA,
inherit.aes = TRUE) {
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomLinerange,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
orientation = orientation,
...
)
)
}
#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
GeomLinerange <- ggproto("GeomLinerange", Geom,
default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
draw_key = draw_key_vpath,
required_aes = c("x|y", "ymin|xmin", "ymax|xmax"),
setup_params = function(data, params) {
params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE)
# if flipped_aes == TRUE then y, xmin, xmax is present
if (!(params$flipped_aes || all(c("x", "ymin", "ymax") %in% c(names(data), names(params))))) {
abort("Either, `x`, `ymin`, and `ymax` or `y`, `xmin`, and `xmax` must be supplied")
}
params
},
extra_params = c("na.rm", "orientation"),
setup_data = function(data, params) {
data$flipped_aes <- params$flipped_aes
data
},
draw_panel = function(data, panel_params, coord, flipped_aes = FALSE) {
data <- flip_data(data, flipped_aes)
data <- transform(data, xend = x, y = ymin, yend = ymax)
data <- flip_data(data, flipped_aes)
ggname("geom_linerange", GeomSegment$draw_panel(data, panel_params, coord))
}
)