File: scale-expansion.r

package info (click to toggle)
r-cran-ggplot2 3.4.1%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 8,748 kB
  • sloc: sh: 15; makefile: 5
file content (238 lines) | stat: -rw-r--r-- 9,158 bytes parent folder | download
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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238

#' Generate expansion vector for scales
#'
#' This is a convenience function for generating scale expansion vectors
#' for the `expand` argument of [scale_(x|y)_continuous][scale_x_continuous()]
#' and [scale_(x|y)_discrete][scale_x_discrete()]. The expansion vectors are used to
#' add some space between the data and the axes.
#'
#' @param mult vector of multiplicative range expansion factors.
#'   If length 1, both the lower and upper limits of the scale
#'   are expanded outwards by `mult`. If length 2, the lower limit
#'   is expanded by `mult[1]` and the upper limit by `mult[2]`.
#' @param add vector of additive range expansion constants.
#'   If length 1, both the lower and upper limits of the scale
#'   are expanded outwards by `add` units. If length 2, the
#'   lower limit is expanded by `add[1]` and the upper
#'   limit by `add[2]`.
#'
#' @export
#' @examples
#' # No space below the bars but 10% above them
#' ggplot(mtcars) +
#'   geom_bar(aes(x = factor(cyl))) +
#'   scale_y_continuous(expand = expansion(mult = c(0, .1)))
#'
#' # Add 2 units of space on the left and right of the data
#' ggplot(subset(diamonds, carat > 2), aes(cut, clarity)) +
#'   geom_jitter() +
#'   scale_x_discrete(expand = expansion(add = 2))
#'
#' # Reproduce the default range expansion used
#' # when the 'expand' argument is not specified
#' ggplot(subset(diamonds, carat > 2), aes(cut, price)) +
#'   geom_jitter() +
#'   scale_x_discrete(expand = expansion(add = .6)) +
#'   scale_y_continuous(expand = expansion(mult = .05))
#'
expansion <- function(mult = 0, add = 0) {
  if (!(is.numeric(mult) && (length(mult) %in% 1:2) && is.numeric(add) && (length(add) %in% 1:2))) {
    cli::cli_abort("{.arg mult} and {.arg add} must be numeric vectors with 1 or 2 elements")
  }

  mult <- rep(mult, length.out = 2)
  add <- rep(add, length.out = 2)
  c(mult[1], add[1], mult[2], add[2])
}

#' @rdname expansion
#' @export
expand_scale <- function(mult = 0, add = 0) {
  deprecate_warn0("3.3.0", "expand_scale()", "expansion()")
  expansion(mult, add)
}

#' Expand a numeric range
#'
#' @param limits A numeric vector of length 2 giving the
#'   range to expand.
#' @param expand A numeric vector of length 2 (`c(add, mult)`)
#'   or length 4 (`c(mult_left, add_left, mult_right, add_right)`),
#'   as generated by [expansion()].
#'
#' @return The expanded `limits`
#'
#' @noRd
#'
expand_range4 <- function(limits, expand) {
  if (!(is.numeric(expand) && length(expand) %in% c(2,4))) {
    cli::cli_abort("{.arg expand} must be a numeric vector with 2 or 4 elements")
  }

  if (all(!is.finite(limits))) {
    return(c(-Inf, Inf))
  }

  # If only two expansion constants are given (i.e. the old syntax),
  # reuse them to generate a four-element expansion vector
  if (length(expand) == 2) {
    expand <- c(expand, expand)
  }

  # Calculate separate range expansion for the lower and
  # upper range limits, and then combine them into one vector
  lower <- expand_range(limits, expand[1], expand[2])[1]
  upper <- expand_range(limits, expand[3], expand[4])[2]
  c(lower, upper)
}

#' Calculate the default expansion for a scale
#'
#' @param scale A position scale (e.g., [scale_x_continuous()] or [scale_x_discrete()])
#' @param discrete,continuous Default scale expansion factors for
#'   discrete and continuous scales, respectively.
#' @param expand Should any expansion be applied?
#'
#' @return One of `discrete`, `continuous`, or `scale$expand`
#' @noRd
#'
default_expansion <- function(scale, discrete = expansion(add = 0.6),
                              continuous = expansion(mult = 0.05), expand = TRUE) {
  if (!expand) {
    return(expansion(0, 0))
  }

  scale$expand %|W|% if (scale$is_discrete()) discrete else continuous
}

#' Expand limits in (possibly) transformed space
#'
#' These functions calculate the continuous range in coordinate space
#' and in scale space. Usually these can be calculated from
#' each other using the coordinate system transformation, except
#' when transforming and expanding the scale limits results in values outside
#' the domain of the transformation (e.g., a lower limit of 0 with a square root
#' transformation).
#'
#' @param scale A position scale (see [scale_x_continuous()] and [scale_x_discrete()])
#' @param limits The initial scale limits, in scale-transformed space.
#' @param coord_limits The user-provided limits in scale-transformed space,
#'   which may include one more more NA values, in which case those limits
#'   will fall back to the `limits`. In `expand_limits_scale()`, `coord_limits`
#'   are in user data space and can be `NULL` (unspecified), since the transformation
#'   from user to mapped space is different for each scale.
#' @param expand An expansion generated by [expansion()] or [default_expansion()].
#' @param trans The coordinate system transformation.
#'
#' @return A list with components `continuous_range`, which is the
#'   expanded range in scale-transformed space, and `continuous_range_coord`,
#'   which is the expanded range in coordinate-transformed space.
#'
#' @noRd
#'
expand_limits_scale <- function(scale, expand = expansion(0, 0), limits = waiver(),
                                coord_limits = NULL) {
  limits <- limits %|W|% scale$get_limits()

  if (scale$is_discrete()) {
    coord_limits <- coord_limits %||% c(NA_real_, NA_real_)
    expand_limits_discrete(
      limits,
      expand,
      coord_limits,
      range_continuous = scale$range_c$range
    )
  } else {
    # using the inverse transform to resolve the NA value is needed for date/datetime/time
    # scales, which refuse to transform objects of the incorrect type
    coord_limits <- coord_limits %||% scale$trans$inverse(c(NA_real_, NA_real_))
    coord_limits_scale <- scale$trans$transform(coord_limits)
    expand_limits_continuous(limits, expand, coord_limits_scale)
  }
}

expand_limits_continuous <- function(limits, expand = expansion(0, 0), coord_limits = c(NA, NA)) {
  expand_limits_continuous_trans(limits, expand, coord_limits)$continuous_range
}

expand_limits_discrete <- function(limits, expand = expansion(0, 0), coord_limits = c(NA, NA),
                                   range_continuous = NULL) {
  limit_info <- expand_limits_discrete_trans(
    limits,
    expand,
    coord_limits,
    range_continuous = range_continuous
  )

  limit_info$continuous_range
}

expand_limits_continuous_trans <- function(limits, expand = expansion(0, 0),
                                           coord_limits = c(NA, NA), trans = identity_trans()) {

  # let non-NA coord_limits override the scale limits
  limits <- ifelse(is.na(coord_limits), limits, coord_limits)

  # expand limits in coordinate space
  continuous_range_coord <- trans$transform(limits)

  # range expansion expects values in increasing order, which may not be true
  # for reciprocal/reverse transformations
  if (all(is.finite(continuous_range_coord)) && diff(continuous_range_coord) < 0) {
    continuous_range_coord <- rev(expand_range4(rev(continuous_range_coord), expand))
  } else {
    continuous_range_coord <- expand_range4(continuous_range_coord, expand)
  }

  final_scale_limits <- trans$inverse(continuous_range_coord)

  # if any non-finite values were introduced in the transformations,
  # replace them with the original scale limits for the purposes of
  # calculating breaks and minor breaks from the scale
  continuous_range <- ifelse(is.finite(final_scale_limits), final_scale_limits, limits)

  list(
    continuous_range_coord = continuous_range_coord,
    continuous_range = continuous_range
  )
}

expand_limits_discrete_trans <- function(limits, expand = expansion(0, 0),
                                         coord_limits = c(NA, NA), trans = identity_trans(),
                                         range_continuous = NULL) {
  if (is.discrete(limits)) {
    n_discrete_limits <- length(limits)
  } else {
    n_discrete_limits <- 0
  }

  is_empty <- is.null(limits) && is.null(range_continuous)
  is_only_continuous <- n_discrete_limits == 0
  is_only_discrete <- is.null(range_continuous)

  if (is_empty) {
    expand_limits_continuous_trans(c(0, 1), expand, coord_limits, trans)
  } else if (is_only_continuous) {
    expand_limits_continuous_trans(range_continuous, expand, coord_limits, trans)
  } else if (is_only_discrete) {
    expand_limits_continuous_trans(c(1, n_discrete_limits), expand, coord_limits, trans)
  } else {
    # continuous and discrete
    limit_info_discrete <- expand_limits_continuous_trans(c(1, n_discrete_limits), expand, coord_limits, trans)

    # don't expand continuous range if there is also a discrete range
    limit_info_continuous <- expand_limits_continuous_trans(
      range_continuous, expansion(0, 0), coord_limits, trans
    )

    # prefer expanded discrete range, but allow continuous range to further expand the range
    list(
      continuous_range_coord = range(
        c(limit_info_discrete$continuous_range_coord, limit_info_continuous$continuous_range_coord)
      ),
      continuous_range = range(
        c(limit_info_discrete$continuous_range, limit_info_continuous$continuous_range)
      )
    )
  }
}