Skip to content

Commit 4b880bb

Browse files
dpseideldpseidel
authored
Implement sec.axis for date, time, and datetime scales (#2806)
* Implement sec.axis for date, time, and datetime scales. Closes #2244.
1 parent fa3cd8f commit 4b880bb

File tree

7 files changed

+202
-31
lines changed

7 files changed

+202
-31
lines changed

‎NEWS.md

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,10 @@
11
# ggplot2 3.0.0.9000
22

3+
* `scale_*_date()`, `scale_*_time()` and `scale_*_datetime()` can now display
4+
a secondary axis that is a __one-to-one__ transformation of the primary axis,
5+
implemented using the `sec.axis` argument to the scale constructor
6+
(@dpseidel, #2244).
7+
38
* The error message in `compute_aesthetics()` now provides the names of only
49
aesthetics with mismatched lengths, rather than all aesthetics (@karawoo,
510
#2853).
@@ -23,7 +28,7 @@
2328
`grouped_df()` objects when dplyr is not installed (@jimhester, #2822).
2429

2530
* All `geom_*()` now display an informative error message when required
26-
aesthetics are missing (@dpseidel, #2637 and #2706).
31+
aesthetics are missing (@dpseidel, #2637 and #2706).s
2732

2833
* `sec_axis()` and `dup_axis()` now return appropriate breaks for the secondary
2934
axis when applied to log transformed scales (@dpseidel, #2729).

‎R/axis-secondary.R

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,30 @@
4545
#' # You can pass in a formula as a shorthand
4646
#' p + scale_y_continuous(sec.axis = ~.^2)
4747
#'
48+
#' # Secondary axes work for date and datetime scales too:
49+
#' df <- data.frame(
50+
#' dx = seq(as.POSIXct("2012-02-29 12:00:00",
51+
#' tz = "UTC",
52+
#' format = "%Y-%m-%d %H:%M:%S"
53+
#' ),
54+
#' length.out = 10, by = "4 hour"
55+
#' ),
56+
#' price = seq(20, 200000, length.out = 10)
57+
#' )
58+
#'
59+
#' # useful for labelling different time scales in the same plot
60+
#' ggplot(df, aes(x = dx, y = price)) + geom_line() +
61+
#' scale_x_datetime("Date", date_labels = "%b %d",
62+
#' date_breaks = "6 hour",
63+
#' sec.axis = dup_axis(name = "Time of Day",
64+
#' labels = scales::time_format("%I %p")))
65+
#'
66+
#' # or to transform axes for different timezones
67+
#' ggplot(df, aes(x = dx, y = price)) + geom_line() +
68+
#' scale_x_datetime("GMT", date_labels = "%b %d %I %p",
69+
#' sec.axis = sec_axis(~. + 8*3600, name = "GMT+8",
70+
#' labels = scales::time_format("%b %d %I %p")))
71+
#'
4872
#' @export
4973
sec_axis <- function(trans = NULL, name = waiver(), breaks = waiver(), labels = waiver()) {
5074
if (!is.formula(trans)) stop("transformation for secondary axes must be a formula", call. = FALSE)
@@ -61,9 +85,20 @@ sec_axis <- function(trans = NULL, name = waiver(), breaks = waiver(), labels =
6185
dup_axis <- function(trans = ~., name = derive(), breaks = derive(), labels = derive()) {
6286
sec_axis(trans, name, breaks, labels)
6387
}
88+
6489
is.sec_axis <- function(x) {
6590
inherits(x, "AxisSecondary")
6691
}
92+
93+
set_sec_axis <- function(sec.axis, scale) {
94+
if (!is.waive(sec.axis)) {
95+
if (is.formula(sec.axis)) sec.axis <- sec_axis(sec.axis)
96+
if (!is.sec_axis(sec.axis)) stop("Secondary axes must be specified using 'sec_axis()'")
97+
scale$secondary.axis <- sec.axis
98+
}
99+
return(scale)
100+
}
101+
67102
#' @rdname sec_axis
68103
#'
69104
#' @export

‎R/scale-continuous.r

Lines changed: 5 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -86,12 +86,9 @@ scale_x_continuous <- function(name = waiver(), breaks = waiver(),
8686
expand = expand, oob = oob, na.value = na.value, trans = trans,
8787
guide = "none", position = position, super = ScaleContinuousPosition
8888
)
89-
if (!is.waive(sec.axis)) {
90-
if (is.formula(sec.axis)) sec.axis <- sec_axis(sec.axis)
91-
if (!is.sec_axis(sec.axis)) stop("Secondary axes must be specified using 'sec_axis()'")
92-
sc$secondary.axis <- sec.axis
93-
}
94-
sc
89+
90+
set_sec_axis(sec.axis, sc)
91+
9592
}
9693

9794
#' @rdname scale_continuous
@@ -108,12 +105,8 @@ scale_y_continuous <- function(name = waiver(), breaks = waiver(),
108105
expand = expand, oob = oob, na.value = na.value, trans = trans,
109106
guide = "none", position = position, super = ScaleContinuousPosition
110107
)
111-
if (!is.waive(sec.axis)) {
112-
if (is.formula(sec.axis)) sec.axis <- sec_axis(sec.axis)
113-
if (!is.sec_axis(sec.axis)) stop("Secondary axes must be specified using 'sec_axis()'")
114-
sc$secondary.axis <- sec.axis
115-
}
116-
sc
108+
109+
set_sec_axis(sec.axis, sc)
117110
}
118111

119112

‎R/scale-date.r

Lines changed: 77 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@
3131
#' @param timezone The timezone to use for display on the axes. The default
3232
#' (`NULL`) uses the timezone encoded in the data.
3333
#' @family position scales
34+
#' @seealso [sec_axis()] for how to specify secondary axes
3435
#' @examples
3536
#' last_month <- Sys.Date() - 0:29
3637
#' df <- data.frame(
@@ -49,6 +50,7 @@
4950
#'
5051
#' # Set limits
5152
#' base + scale_x_date(limits = c(Sys.Date() - 7, NA))
53+
#'
5254
#' @name scale_date
5355
#' @aliases NULL
5456
NULL
@@ -64,9 +66,10 @@ scale_x_date <- function(name = waiver(),
6466
date_minor_breaks = waiver(),
6567
limits = NULL,
6668
expand = waiver(),
67-
position = "bottom") {
69+
position = "bottom",
70+
sec.axis = waiver()) {
6871

69-
datetime_scale(
72+
sc <- datetime_scale(
7073
c("x", "xmin", "xmax", "xend"),
7174
"date",
7275
name = name,
@@ -82,6 +85,8 @@ scale_x_date <- function(name = waiver(),
8285
expand = expand,
8386
position = position
8487
)
88+
89+
set_sec_axis(sec.axis, sc)
8590
}
8691

8792
#' @rdname scale_date
@@ -95,9 +100,10 @@ scale_y_date <- function(name = waiver(),
95100
date_minor_breaks = waiver(),
96101
limits = NULL,
97102
expand = waiver(),
98-
position = "left") {
103+
position = "left",
104+
sec.axis = waiver()) {
99105

100-
datetime_scale(
106+
sc <- datetime_scale(
101107
c("y", "ymin", "ymax", "yend"),
102108
"date",
103109
name = name,
@@ -113,6 +119,8 @@ scale_y_date <- function(name = waiver(),
113119
expand = expand,
114120
position = position
115121
)
122+
123+
set_sec_axis(sec.axis, sc)
116124
}
117125

118126
#' @export
@@ -127,9 +135,10 @@ scale_x_datetime <- function(name = waiver(),
127135
timezone = NULL,
128136
limits = NULL,
129137
expand = waiver(),
130-
position = "bottom") {
138+
position = "bottom",
139+
sec.axis = waiver()) {
131140

132-
datetime_scale(
141+
sc <- datetime_scale(
133142
c("x", "xmin", "xmax", "xend"),
134143
"time",
135144
name = name,
@@ -146,6 +155,8 @@ scale_x_datetime <- function(name = waiver(),
146155
expand = expand,
147156
position = position
148157
)
158+
159+
set_sec_axis(sec.axis, sc)
149160
}
150161

151162

@@ -161,9 +172,10 @@ scale_y_datetime <- function(name = waiver(),
161172
timezone = NULL,
162173
limits = NULL,
163174
expand = waiver(),
164-
position = "left") {
175+
position = "left",
176+
sec.axis = waiver()) {
165177

166-
datetime_scale(
178+
sc <- datetime_scale(
167179
c("y", "ymin", "ymax", "yend"),
168180
"time",
169181
name = name,
@@ -180,6 +192,8 @@ scale_y_datetime <- function(name = waiver(),
180192
expand = expand,
181193
position = position
182194
)
195+
196+
set_sec_axis(sec.axis, sc)
183197
}
184198

185199

@@ -194,7 +208,8 @@ scale_x_time <- function(name = waiver(),
194208
expand = waiver(),
195209
oob = censor,
196210
na.value = NA_real_,
197-
position = "bottom") {
211+
position = "bottom",
212+
sec.axis = waiver()) {
198213

199214
scale_x_continuous(
200215
name = name,
@@ -206,7 +221,8 @@ scale_x_time <- function(name = waiver(),
206221
oob = oob,
207222
na.value = na.value,
208223
position = position,
209-
trans = scales::hms_trans()
224+
trans = scales::hms_trans(),
225+
sec.axis = sec.axis
210226
)
211227
}
212228

@@ -221,7 +237,8 @@ scale_y_time <- function(name = waiver(),
221237
expand = waiver(),
222238
oob = censor,
223239
na.value = NA_real_,
224-
position = "left") {
240+
position = "left",
241+
sec.axis = waiver()) {
225242

226243
scale_y_continuous(
227244
name = name,
@@ -233,7 +250,8 @@ scale_y_time <- function(name = waiver(),
233250
oob = oob,
234251
na.value = na.value,
235252
position = position,
236-
trans = scales::hms_trans()
253+
trans = scales::hms_trans(),
254+
sec.axis = sec.axis
237255
)
238256
}
239257

@@ -301,6 +319,7 @@ datetime_scale <- function(aesthetics, trans, palette,
301319
#' @usage NULL
302320
#' @export
303321
ScaleContinuousDatetime <- ggproto("ScaleContinuousDatetime", ScaleContinuous,
322+
secondary.axis = waiver(),
304323
timezone = NULL,
305324
transform = function(self, x) {
306325
tz <- attr(x, "tzone")
@@ -312,15 +331,61 @@ ScaleContinuousDatetime <- ggproto("ScaleContinuousDatetime", ScaleContinuous,
312331
},
313332
map = function(self, x, limits = self$get_limits()) {
314333
self$oob(x, limits)
334+
},
335+
break_info = function(self, range = NULL) {
336+
breaks <- ggproto_parent(ScaleContinuous, self)$break_info(range)
337+
if (!(is.waive(self$secondary.axis) || self$secondary.axis$empty())) {
338+
self$secondary.axis$init(self)
339+
breaks <- c(breaks, self$secondary.axis$break_info(breaks$range, self))
340+
}
341+
breaks
342+
},
343+
sec_name = function(self) {
344+
if (is.waive(self$secondary.axis)) {
345+
waiver()
346+
} else {
347+
self$secondary.axis$name
348+
}
349+
},
350+
make_sec_title = function(self, title) {
351+
if (!is.waive(self$secondary.axis)) {
352+
self$secondary.axis$make_title(title)
353+
} else {
354+
ggproto_parent(ScaleContinuous, self)$make_sec_title(title)
355+
}
315356
}
357+
316358
)
317359

318360
#' @rdname ggplot2-ggproto
319361
#' @format NULL
320362
#' @usage NULL
321363
#' @export
322364
ScaleContinuousDate <- ggproto("ScaleContinuousDate", ScaleContinuous,
365+
secondary.axis = waiver(),
323366
map = function(self, x, limits = self$get_limits()) {
324367
self$oob(x, limits)
368+
},
369+
break_info = function(self, range = NULL) {
370+
breaks <- ggproto_parent(ScaleContinuous, self)$break_info(range)
371+
if (!(is.waive(self$secondary.axis) || self$secondary.axis$empty())) {
372+
self$secondary.axis$init(self)
373+
breaks <- c(breaks, self$secondary.axis$break_info(breaks$range, self))
374+
}
375+
breaks
376+
},
377+
sec_name = function(self) {
378+
if (is.waive(self$secondary.axis)) {
379+
waiver()
380+
} else {
381+
self$secondary.axis$name
382+
}
383+
},
384+
make_sec_title = function(self, title) {
385+
if (!is.waive(self$secondary.axis)) {
386+
self$secondary.axis$make_title(title)
387+
} else {
388+
ggproto_parent(ScaleContinuous, self)$make_sec_title(title)
389+
}
325390
}
326391
)

‎man/scale_date.Rd

Lines changed: 13 additions & 6 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)