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