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
|
#' Adjust position by simultaneously dodging and jittering
#'
#' This is primarily used for aligning points generated through
#' \code{geom_point()} with dodged boxplots (e.g., a \code{geom_boxplot()} with
#' a fill aesthetic supplied).
#'
#' @family position adjustments
#' @param jitter.width degree of jitter in x direction. Defaults to 40\% of the
#' resolution of the data.
#' @param jitter.height degree of jitter in y direction. Defaults to 0.
#' @param dodge.width the amount to dodge in the x direction. Defaults to 0.75,
#' the default \code{position_dodge()} width.
#' @export
#' @examples
#' dsub <- diamonds[ sample(nrow(diamonds), 1000), ]
#' ggplot(dsub, aes(x = cut, y = carat, fill = clarity)) +
#' geom_boxplot(outlier.size = 0) +
#' geom_point(pch = 21, position = position_jitterdodge())
position_jitterdodge <- function (jitter.width = NULL,
jitter.height = NULL,
dodge.width = NULL) {
PositionJitterDodge$new(jitter.width = jitter.width,
jitter.height = jitter.height,
dodge.width = dodge.width)
}
PositionJitterDodge <- proto(Position, {
jitter.width <- NULL
jitter.height <- NULL
dodge.width <- NULL
new <- function(.,
jitter.width = NULL,
jitter.height = NULL,
dodge.width = NULL) {
.$proto(jitter.width=jitter.width,
jitter.height=jitter.height,
dodge.width=dodge.width)
}
objname <- "jitterdodge"
adjust <- function(., data) {
if (empty(data)) return(data.frame())
check_required_aesthetics(c("x", "y", "fill"), names(data), "position_jitterdodge")
## Workaround to avoid this warning:
## ymax not defined: adjusting position using y instead
if (!("ymax" %in% names(data))) {
data$ymax <- data$y
}
## Adjust the x transformation based on the number of 'fill' variables
nfill <- length(levels(data$fill))
if (is.null(.$jitter.width)) {
.$jitter.width <- resolution(data$x, zero = FALSE) * 0.4
}
if (is.null(.$jitter.height)) {
.$jitter.height <- 0
}
trans_x <- NULL
trans_y <- NULL
if (.$jitter.width > 0) {
trans_x <- function(x) jitter(x, amount = .$jitter.width / (nfill + 2))
}
if (.$jitter.height > 0) {
trans_y <- function(x) jitter(x, amount = .$jitter.height)
}
if (is.null(.$dodge.width)) {
.$dodge.width <- 0.75
}
## dodge, then jitter
data <- collide(data, .$dodge.width, .$my_name(), pos_dodge, check.width = FALSE)
transform_position(data, trans_x, trans_y)
}
})
|
