|
| 1 | +#' Adjust position by simultaneously dodging and jittering |
| 2 | +#' |
| 3 | +#' This is primarily used for aligning points generated through |
| 4 | +#' \code{geom_point()} with dodged boxplots (e.g., a \code{geom_boxplot()} with |
| 5 | +#' a fill aesthetic supplied). |
| 6 | +#' |
| 7 | +#' @family position adjustments |
| 8 | +#' @param jitter.width degree of jitter in x direction. Defaults to 40\% of the |
| 9 | +#' resolution of the data. |
| 10 | +#' @param jitter.height degree of jitter in y direction. Defaults to 0. |
| 11 | +#' @param dodge.width the amount to dodge in the x direction. Defaults to 0.75, |
| 12 | +#' the default \code{position_dodge()} width. |
| 13 | +#' @export |
| 14 | +#' @examples |
| 15 | +#' dsub <- diamonds[ sample(nrow(diamonds), 1000), ] |
| 16 | +#' ggplot(dsub, aes(x = cut, y = carat, fill = clarity)) + |
| 17 | +#' geom_boxplot(outlier.size = 0) + |
| 18 | +#' geom_point(pch = 21, position = position_jitterdodge()) |
| 19 | +position_jitterdodge <- function (jitter.width = NULL, |
| 20 | + jitter.height = NULL, |
| 21 | + dodge.width = NULL) { |
| 22 | + |
| 23 | + PositionJitterDodge$new(jitter.width = jitter.width, |
| 24 | + jitter.height = jitter.height, |
| 25 | + dodge.width = dodge.width) |
| 26 | +} |
| 27 | + |
| 28 | +PositionJitterDodge <- proto(Position, { |
| 29 | + |
| 30 | + jitter.width <- NULL |
| 31 | + jitter.height <- NULL |
| 32 | + dodge.width <- NULL |
| 33 | + |
| 34 | + new <- function(., |
| 35 | + jitter.width = NULL, |
| 36 | + jitter.height = NULL, |
| 37 | + dodge.width = NULL) { |
| 38 | + |
| 39 | + .$proto(jitter.width=jitter.width, |
| 40 | + jitter.height=jitter.height, |
| 41 | + dodge.width=dodge.width) |
| 42 | + |
| 43 | + } |
| 44 | + |
| 45 | + objname <- "jitterdodge" |
| 46 | + |
| 47 | + adjust <- function(., data) { |
| 48 | + |
| 49 | + if (empty(data)) return(data.frame()) |
| 50 | + check_required_aesthetics(c("x", "y", "fill"), names(data), "position_jitterdodge") |
| 51 | + |
| 52 | + ## Workaround to avoid this warning: |
| 53 | + ## ymax not defined: adjusting position using y instead |
| 54 | + if (!("ymax" %in% names(data))) { |
| 55 | + data$ymax <- data$y |
| 56 | + } |
| 57 | + |
| 58 | + ## Adjust the x transformation based on the number of 'fill' variables |
| 59 | + nfill <- length(levels(data$fill)) |
| 60 | + |
| 61 | + if (is.null(.$jitter.width)) { |
| 62 | + .$jitter.width <- resolution(data$x, zero = FALSE) * 0.4 |
| 63 | + } |
| 64 | + |
| 65 | + if (is.null(.$jitter.height)) { |
| 66 | + .$jitter.height <- 0 |
| 67 | + } |
| 68 | + |
| 69 | + trans_x <- NULL |
| 70 | + trans_y <- NULL |
| 71 | + if (.$jitter.width > 0) { |
| 72 | + trans_x <- function(x) jitter(x, amount = .$jitter.width / (nfill + 2)) |
| 73 | + } |
| 74 | + if (.$jitter.height > 0) { |
| 75 | + trans_y <- function(x) jitter(x, amount = .$jitter.height) |
| 76 | + } |
| 77 | + |
| 78 | + if (is.null(.$dodge.width)) { |
| 79 | + .$dodge.width <- 0.75 |
| 80 | + } |
| 81 | + |
| 82 | + ## dodge, then jitter |
| 83 | + data <- collide(data, .$dodge.width, .$my_name(), pos_dodge, check.width = FALSE) |
| 84 | + transform_position(data, trans_x, trans_y) |
| 85 | + } |
| 86 | + |
| 87 | +}) |
0 commit comments