1#' Dodge overlapping objects side-to-side
2#'
3#' Dodging preserves the vertical position of an geom while adjusting the
4#' horizontal position. `position_dodge()` requires the grouping variable to be
5#' be specified in the global or `geom_*` layer. Unlike `position_dodge()`,
6#' `position_dodge2()` works without a grouping variable in a layer.
7#' `position_dodge2()` works with bars and rectangles, but is
8#' particulary useful for arranging box plots, which
9#' can have variable widths.
10#'
11#' @param width Dodging width, when different to the width of the individual
12#'   elements. This is useful when you want to align narrow geoms with wider
13#'   geoms. See the examples.
14#' @param preserve Should dodging preserve the total width of all elements
15#'    at a position, or the width of a single element?
16#' @family position adjustments
17#' @export
18#' @examples
19#' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) +
20#'   geom_bar(position = "dodge2")
21#'
22#' # By default, dodging with `position_dodge2()` preserves the total width of
23#' # the elements. You can choose to preserve the width of each element with:
24#' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) +
25#'   geom_bar(position = position_dodge2(preserve = "single"))
26#'
27#' \donttest{
28#' ggplot(diamonds, aes(price, fill = cut)) +
29#'   geom_histogram(position="dodge2")
30#' # see ?geom_bar for more examples
31#'
32#' # In this case a frequency polygon is probably a better choice
33#' ggplot(diamonds, aes(price, colour = cut)) +
34#'   geom_freqpoly()
35#' }
36#'
37#' # Dodging with various widths -------------------------------------
38#' # To dodge items with different widths, you need to be explicit
39#' df <- data.frame(
40#'   x = c("a","a","b","b"),
41#'   y = 2:5,
42#'   g = rep(1:2, 2)
43#' )
44#' p <- ggplot(df, aes(x, y, group = g)) +
45#'   geom_col(position = "dodge", fill = "grey50", colour = "black")
46#' p
47#'
48#' # A line range has no width:
49#' p + geom_linerange(aes(ymin = y - 1, ymax = y + 1), position = "dodge")
50#'
51#' # So you must explicitly specify the width
52#' p + geom_linerange(
53#'   aes(ymin = y - 1, ymax = y + 1),
54#'   position = position_dodge(width = 0.9)
55#' )
56#'
57#' # The same principle applies to error bars, which are usually
58#' # narrower than the bars
59#' p + geom_errorbar(
60#'   aes(ymin = y - 1, ymax = y + 1),
61#'   width = 0.2,
62#'   position = "dodge"
63#' )
64#' p + geom_errorbar(
65#'   aes(ymin = y - 1, ymax = y + 1),
66#'   width = 0.2,
67#'   position = position_dodge(width = 0.9)
68#' )
69#'
70#' # Box plots use position_dodge2 by default, and bars can use it too
71#' ggplot(mpg, aes(factor(year), displ)) +
72#'   geom_boxplot(aes(colour = hwy < 30))
73#'
74#' ggplot(mpg, aes(factor(year), displ)) +
75#'   geom_boxplot(aes(colour = hwy < 30), varwidth = TRUE)
76#'
77#' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) +
78#'   geom_bar(position = position_dodge2(preserve = "single"))
79#'
80#' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) +
81#'   geom_bar(position = position_dodge2(preserve = "total"))
82position_dodge <- function(width = NULL, preserve = c("total", "single")) {
83  ggproto(NULL, PositionDodge,
84    width = width,
85    preserve = match.arg(preserve)
86  )
87}
88
89#' @rdname ggplot2-ggproto
90#' @format NULL
91#' @usage NULL
92#' @export
93PositionDodge <- ggproto("PositionDodge", Position,
94  width = NULL,
95  preserve = "total",
96  setup_params = function(self, data) {
97    flipped_aes <- has_flipped_aes(data)
98    data <- flip_data(data, flipped_aes)
99    if (is.null(data$xmin) && is.null(data$xmax) && is.null(self$width)) {
100      warn("Width not defined. Set with `position_dodge(width = ?)`")
101    }
102
103    if (identical(self$preserve, "total")) {
104      n <- NULL
105    } else {
106      panels <- unname(split(data, data$PANEL))
107      ns <- vapply(panels, function(panel) max(table(panel$xmin)), double(1))
108      n <- max(ns)
109    }
110
111    list(
112      width = self$width,
113      n = n,
114      flipped_aes = flipped_aes
115    )
116  },
117
118  setup_data = function(self, data, params) {
119    data <- flip_data(data, params$flipped_aes)
120    if (!"x" %in% names(data) && all(c("xmin", "xmax") %in% names(data))) {
121      data$x <- (data$xmin + data$xmax) / 2
122    }
123    flip_data(data, params$flipped_aes)
124  },
125
126  compute_panel = function(data, params, scales) {
127    data <- flip_data(data, params$flipped_aes)
128    collided <- collide(
129      data,
130      params$width,
131      name = "position_dodge",
132      strategy = pos_dodge,
133      n = params$n,
134      check.width = FALSE
135    )
136    flip_data(collided, params$flipped_aes)
137  }
138)
139
140# Dodge overlapping interval.
141# Assumes that each set has the same horizontal position.
142pos_dodge <- function(df, width, n = NULL) {
143  if (is.null(n)) {
144    n <- length(unique(df$group))
145  }
146
147  if (n == 1)
148    return(df)
149
150  if (!all(c("xmin", "xmax") %in% names(df))) {
151    df$xmin <- df$x
152    df$xmax <- df$x
153  }
154
155  d_width <- max(df$xmax - df$xmin)
156
157  # Have a new group index from 1 to number of groups.
158  # This might be needed if the group numbers in this set don't include all of 1:n
159  groupidx <- match(df$group, sort(unique(df$group)))
160
161  # Find the center for each group, then use that to calculate xmin and xmax
162  df$x <- df$x + width * ((groupidx - 0.5) / n - .5)
163  df$xmin <- df$x - d_width / n / 2
164  df$xmax <- df$x + d_width / n / 2
165
166  df
167}
168