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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
#' Dodge overlapping objects side-to-side
#'
#' Dodging preserves the vertical position of an geom while adjusting the
#' horizontal position. `position_dodge()` requires the grouping variable to be
#' be specified in the global or `geom_*` layer. Unlike `position_dodge()`,
#' `position_dodge2()` works without a grouping variable in a layer.
#' `position_dodge2()` works with bars and rectangles, but is
#' particularly useful for arranging box plots, which
#' can have variable widths.
#'
#' @param width Dodging width, when different to the width of the individual
#' elements. This is useful when you want to align narrow geoms with wider
#' geoms. See the examples.
#' @param preserve Should dodging preserve the `"total"` width of all elements
#' at a position, or the width of a `"single"` element?
#' @family position adjustments
#' @export
#' @examples
#' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) +
#' geom_bar(position = "dodge2")
#'
#' # By default, dodging with `position_dodge2()` preserves the total width of
#' # the elements. You can choose to preserve the width of each element with:
#' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) +
#' geom_bar(position = position_dodge2(preserve = "single"))
#'
#' \donttest{
#' ggplot(diamonds, aes(price, fill = cut)) +
#' geom_histogram(position="dodge2")
#' # see ?geom_bar for more examples
#'
#' # In this case a frequency polygon is probably a better choice
#' ggplot(diamonds, aes(price, colour = cut)) +
#' geom_freqpoly()
#' }
#'
#' # Dodging with various widths -------------------------------------
#' # To dodge items with different widths, you need to be explicit
#' df <- data.frame(
#' x = c("a","a","b","b"),
#' y = 2:5,
#' g = rep(1:2, 2)
#' )
#' p <- ggplot(df, aes(x, y, group = g)) +
#' geom_col(position = "dodge", fill = "grey50", colour = "black")
#' p
#'
#' # A line range has no width:
#' p + geom_linerange(aes(ymin = y - 1, ymax = y + 1), position = "dodge")
#'
#' # So you must explicitly specify the width
#' p + geom_linerange(
#' aes(ymin = y - 1, ymax = y + 1),
#' position = position_dodge(width = 0.9)
#' )
#'
#' # The same principle applies to error bars, which are usually
#' # narrower than the bars
#' p + geom_errorbar(
#' aes(ymin = y - 1, ymax = y + 1),
#' width = 0.2,
#' position = "dodge"
#' )
#' p + geom_errorbar(
#' aes(ymin = y - 1, ymax = y + 1),
#' width = 0.2,
#' position = position_dodge(width = 0.9)
#' )
#'
#' # Box plots use position_dodge2 by default, and bars can use it too
#' ggplot(mpg, aes(factor(year), displ)) +
#' geom_boxplot(aes(colour = hwy < 30))
#'
#' ggplot(mpg, aes(factor(year), displ)) +
#' geom_boxplot(aes(colour = hwy < 30), varwidth = TRUE)
#'
#' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) +
#' geom_bar(position = position_dodge2(preserve = "single"))
#'
#' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) +
#' geom_bar(position = position_dodge2(preserve = "total"))
position_dodge <- function(width = NULL, preserve = "total") {
ggproto(NULL, PositionDodge,
width = width,
preserve = arg_match0(preserve, c("total", "single"))
)
}
#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
PositionDodge <- ggproto("PositionDodge", Position,
width = NULL,
preserve = "total",
setup_params = function(self, data) {
flipped_aes <- has_flipped_aes(data)
data <- flip_data(data, flipped_aes)
if (is.null(data$xmin) && is.null(data$xmax) && is.null(self$width)) {
cli::cli_warn(c(
"Width not defined",
"i" = "Set with {.code position_dodge(width = ...)}"
))
}
if (identical(self$preserve, "total")) {
n <- NULL
} else {
panels <- unname(split(data, data$PANEL))
ns <- vapply(panels, function(panel) max(table(panel$xmin)), double(1))
n <- max(ns)
}
list(
width = self$width,
n = n,
flipped_aes = flipped_aes
)
},
setup_data = function(self, data, params) {
data <- flip_data(data, params$flipped_aes)
if (!"x" %in% names(data) && all(c("xmin", "xmax") %in% names(data))) {
data$x <- (data$xmin + data$xmax) / 2
}
flip_data(data, params$flipped_aes)
},
compute_panel = function(data, params, scales) {
data <- flip_data(data, params$flipped_aes)
collided <- collide(
data,
params$width,
name = "position_dodge",
strategy = pos_dodge,
n = params$n,
check.width = FALSE
)
flip_data(collided, params$flipped_aes)
}
)
# Dodge overlapping interval.
# Assumes that each set has the same horizontal position.
pos_dodge <- function(df, width, n = NULL) {
if (is.null(n)) {
n <- vec_unique_count(df$group)
}
if (n == 1)
return(df)
if (!all(c("xmin", "xmax") %in% names(df))) {
df$xmin <- df$x
df$xmax <- df$x
}
d_width <- max(df$xmax - df$xmin)
# Have a new group index from 1 to number of groups.
# This might be needed if the group numbers in this set don't include all of 1:n
groupidx <- match(df$group, sort(unique0(df$group)))
# Find the center for each group, then use that to calculate xmin and xmax
df$x <- df$x + width * ((groupidx - 0.5) / n - .5)
df$xmin <- df$x - d_width / n / 2
df$xmax <- df$x + d_width / n / 2
df
}
|
