1
2#' Generate expansion vector for scales
3#'
4#' This is a convenience function for generating scale expansion vectors
5#' for the `expand` argument of [scale_(x|y)_continuous][scale_x_continuous()]
6#' and [scale_(x|y)_discrete][scale_x_discrete()]. The expansion vectors are used to
7#' add some space between the data and the axes.
8#'
9#' @param mult vector of multiplicative range expansion factors.
10#'   If length 1, both the lower and upper limits of the scale
11#'   are expanded outwards by `mult`. If length 2, the lower limit
12#'   is expanded by `mult[1]` and the upper limit by `mult[2]`.
13#' @param add vector of additive range expansion constants.
14#'   If length 1, both the lower and upper limits of the scale
15#'   are expanded outwards by `add` units. If length 2, the
16#'   lower limit is expanded by `add[1]` and the upper
17#'   limit by `add[2]`.
18#'
19#' @export
20#' @examples
21#' # No space below the bars but 10% above them
22#' ggplot(mtcars) +
23#'   geom_bar(aes(x = factor(cyl))) +
24#'   scale_y_continuous(expand = expansion(mult = c(0, .1)))
25#'
26#' # Add 2 units of space on the left and right of the data
27#' ggplot(subset(diamonds, carat > 2), aes(cut, clarity)) +
28#'   geom_jitter() +
29#'   scale_x_discrete(expand = expansion(add = 2))
30#'
31#' # Reproduce the default range expansion used
32#' # when the 'expand' argument is not specified
33#' ggplot(subset(diamonds, carat > 2), aes(cut, price)) +
34#'   geom_jitter() +
35#'   scale_x_discrete(expand = expansion(add = .6)) +
36#'   scale_y_continuous(expand = expansion(mult = .05))
37#'
38expansion <- function(mult = 0, add = 0) {
39  if (!(is.numeric(mult) && (length(mult) %in% 1:2) && is.numeric(add) && (length(add) %in% 1:2))) {
40    abort("`mult` and `add` must be numeric vectors with 1 or 2 elements")
41  }
42
43  mult <- rep(mult, length.out = 2)
44  add <- rep(add, length.out = 2)
45  c(mult[1], add[1], mult[2], add[2])
46}
47
48#' @rdname expansion
49#' @export
50expand_scale <- function(mult = 0, add = 0) {
51  .Deprecated(msg = "`expand_scale()` is deprecated; use `expansion()` instead.")
52  expansion(mult, add)
53}
54
55#' Expand a numeric range
56#'
57#' @param limits A numeric vector of length 2 giving the
58#'   range to expand.
59#' @param expand A numeric vector of length 2 (`c(add, mult)`)
60#'   or length 4 (`c(mult_left, add_left, mult_right, add_right)`),
61#'   as generated by [expansion()].
62#'
63#' @return The expanded `limits`
64#'
65#' @noRd
66#'
67expand_range4 <- function(limits, expand) {
68  if (!(is.numeric(expand) && length(expand) %in% c(2,4))) {
69    abort("`expand` must be a numeric vector with 2 or 4 elements")
70  }
71
72  if (all(!is.finite(limits))) {
73    return(c(-Inf, Inf))
74  }
75
76  # If only two expansion constants are given (i.e. the old syntax),
77  # reuse them to generate a four-element expansion vector
78  if (length(expand) == 2) {
79    expand <- c(expand, expand)
80  }
81
82  # Calculate separate range expansion for the lower and
83  # upper range limits, and then combine them into one vector
84  lower <- expand_range(limits, expand[1], expand[2])[1]
85  upper <- expand_range(limits, expand[3], expand[4])[2]
86  c(lower, upper)
87}
88
89#' Calculate the default expansion for a scale
90#'
91#' @param scale A position scale (e.g., [scale_x_continuous()] or [scale_x_discrete()])
92#' @param discrete,continuous Default scale expansion factors for
93#'   discrete and continuous scales, respectively.
94#' @param expand Should any expansion be applied?
95#'
96#' @return One of `discrete`, `continuous`, or `scale$expand`
97#' @noRd
98#'
99default_expansion <- function(scale, discrete = expansion(add = 0.6),
100                              continuous = expansion(mult = 0.05), expand = TRUE) {
101  if (!expand) {
102    return(expansion(0, 0))
103  }
104
105  scale$expand %|W|% if (scale$is_discrete()) discrete else continuous
106}
107
108#' Expand limits in (possibly) transformed space
109#'
110#' These functions calculate the continuous range in coordinate space
111#' and in scale space. Usually these can be calculated from
112#' each other using the coordinate system transformation, except
113#' when transforming and expanding the scale limits results in values outside
114#' the domain of the transformation (e.g., a lower limit of 0 with a square root
115#' transformation).
116#'
117#' @param scale A position scale (see [scale_x_continuous()] and [scale_x_discrete()])
118#' @param limits The initial scale limits, in scale-transformed space.
119#' @param coord_limits The user-provided limits in scale-transformed space,
120#'   which may include one more more NA values, in which case those limits
121#'   will fall back to the `limits`. In `expand_limits_scale()`, `coord_limits`
122#'   are in user data space and can be `NULL` (unspecified), since the transformation
123#'   from user to mapped space is different for each scale.
124#' @param expand An expansion generated by [expansion()] or [default_expansion()].
125#' @param trans The coordinate system transformation.
126#'
127#' @return A list with components `continuous_range`, which is the
128#'   expanded range in scale-transformed space, and `continuous_range_coord`,
129#'   which is the expanded range in coordinate-transformed space.
130#'
131#' @noRd
132#'
133expand_limits_scale <- function(scale, expand = expansion(0, 0), limits = waiver(),
134                                coord_limits = NULL) {
135  limits <- limits %|W|% scale$get_limits()
136
137  if (scale$is_discrete()) {
138    coord_limits <- coord_limits %||% c(NA_real_, NA_real_)
139    expand_limits_discrete(
140      limits,
141      expand,
142      coord_limits,
143      range_continuous = scale$range_c$range
144    )
145  } else {
146    # using the inverse transform to resolve the NA value is needed for date/datetime/time
147    # scales, which refuse to transform objects of the incorrect type
148    coord_limits <- coord_limits %||% scale$trans$inverse(c(NA_real_, NA_real_))
149    coord_limits_scale <- scale$trans$transform(coord_limits)
150    expand_limits_continuous(limits, expand, coord_limits_scale)
151  }
152}
153
154expand_limits_continuous <- function(limits, expand = expansion(0, 0), coord_limits = c(NA, NA)) {
155  expand_limits_continuous_trans(limits, expand, coord_limits)$continuous_range
156}
157
158expand_limits_discrete <- function(limits, expand = expansion(0, 0), coord_limits = c(NA, NA),
159                                   range_continuous = NULL) {
160  limit_info <- expand_limits_discrete_trans(
161    limits,
162    expand,
163    coord_limits,
164    range_continuous = range_continuous
165  )
166
167  limit_info$continuous_range
168}
169
170expand_limits_continuous_trans <- function(limits, expand = expansion(0, 0),
171                                           coord_limits = c(NA, NA), trans = identity_trans()) {
172
173  # let non-NA coord_limits override the scale limits
174  limits <- ifelse(is.na(coord_limits), limits, coord_limits)
175
176  # expand limits in coordinate space
177  continuous_range_coord <- trans$transform(limits)
178
179  # range expansion expects values in increasing order, which may not be true
180  # for reciprocal/reverse transformations
181  if (all(is.finite(continuous_range_coord)) && diff(continuous_range_coord) < 0) {
182    continuous_range_coord <- rev(expand_range4(rev(continuous_range_coord), expand))
183  } else {
184    continuous_range_coord <- expand_range4(continuous_range_coord, expand)
185  }
186
187  final_scale_limits <- trans$inverse(continuous_range_coord)
188
189  # if any non-finite values were introduced in the transformations,
190  # replace them with the original scale limits for the purposes of
191  # calculating breaks and minor breaks from the scale
192  continuous_range <- ifelse(is.finite(final_scale_limits), final_scale_limits, limits)
193
194  list(
195    continuous_range_coord = continuous_range_coord,
196    continuous_range = continuous_range
197  )
198}
199
200expand_limits_discrete_trans <- function(limits, expand = expansion(0, 0),
201                                         coord_limits = c(NA, NA), trans = identity_trans(),
202                                         range_continuous = NULL) {
203  if (is.discrete(limits)) {
204    n_discrete_limits <- length(limits)
205  } else {
206    n_discrete_limits <- 0
207  }
208
209  is_empty <- is.null(limits) && is.null(range_continuous)
210  is_only_continuous <- n_discrete_limits == 0
211  is_only_discrete <- is.null(range_continuous)
212
213  if (is_empty) {
214    expand_limits_continuous_trans(c(0, 1), expand, coord_limits, trans)
215  } else if (is_only_continuous) {
216    expand_limits_continuous_trans(range_continuous, expand, coord_limits, trans)
217  } else if (is_only_discrete) {
218    expand_limits_continuous_trans(c(1, n_discrete_limits), expand, coord_limits, trans)
219  } else {
220    # continuous and discrete
221    limit_info_discrete <- expand_limits_continuous_trans(c(1, n_discrete_limits), expand, coord_limits, trans)
222
223    # don't expand continuous range if there is also a discrete range
224    limit_info_continuous <- expand_limits_continuous_trans(
225      range_continuous, expansion(0, 0), coord_limits, trans
226    )
227
228    # prefer expanded discrete range, but allow continuous range to further expand the range
229    list(
230      continuous_range_coord = range(
231        c(limit_info_discrete$continuous_range_coord, limit_info_continuous$continuous_range_coord)
232      ),
233      continuous_range = range(
234        c(limit_info_discrete$continuous_range, limit_info_continuous$continuous_range)
235      )
236    )
237  }
238}
239