Skip to content

Commit

Permalink
Implement sec.axis for date, time, and datetime scales (#2806)
Browse files Browse the repository at this point in the history 
* Implement sec.axis for date, time, and datetime scales. Closes #2244.
  • Loading branch information
@dpseidel
dpseidel committed Sep 18, 2018
1 parent fa3cd8f commit 4b880bb
Show file tree
Hide file tree
Showing 7 changed files with 202 additions and 31 deletions.
7 changes: 6 additions & 1 deletion NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,10 @@
# ggplot2 3.0.0.9000

* `scale_*_date()`, `scale_*_time()` and `scale_*_datetime()` can now display
a secondary axis that is a __one-to-one__ transformation of the primary axis,
implemented using the `sec.axis` argument to the scale constructor
(@dpseidel, #2244).

* The error message in `compute_aesthetics()` now provides the names of only
aesthetics with mismatched lengths, rather than all aesthetics (@karawoo,
#2853).
Expand All @@ -23,7 +28,7 @@
`grouped_df()` objects when dplyr is not installed (@jimhester, #2822).

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

* `sec_axis()` and `dup_axis()` now return appropriate breaks for the secondary
axis when applied to log transformed scales (@dpseidel, #2729).
Expand Down
35 changes: 35 additions & 0 deletions R/axis-secondary.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,30 @@
#' # You can pass in a formula as a shorthand
#' p + scale_y_continuous(sec.axis = ~.^2)
#'
#' # Secondary axes work for date and datetime scales too:
#' df <- data.frame(
#' dx = seq(as.POSIXct("2012-02-29 12:00:00",
#' tz = "UTC",
#' format = "%Y-%m-%d %H:%M:%S"
#' ),
#' length.out = 10, by = "4 hour"
#' ),
#' price = seq(20, 200000, length.out = 10)
#' )
#'
#' # useful for labelling different time scales in the same plot
#' ggplot(df, aes(x = dx, y = price)) + geom_line() +
#' scale_x_datetime("Date", date_labels = "%b %d",
#' date_breaks = "6 hour",
#' sec.axis = dup_axis(name = "Time of Day",
#' labels = scales::time_format("%I %p")))
#'
#' # or to transform axes for different timezones
#' ggplot(df, aes(x = dx, y = price)) + geom_line() +
#' scale_x_datetime("GMT", date_labels = "%b %d %I %p",
#' sec.axis = sec_axis(~. + 8*3600, name = "GMT+8",
#' labels = scales::time_format("%b %d %I %p")))
#'
#' @export
sec_axis <- function(trans = NULL, name = waiver(), breaks = waiver(), labels = waiver()) {
if (!is.formula(trans)) stop("transformation for secondary axes must be a formula", call. = FALSE)
Expand All @@ -61,9 +85,20 @@ sec_axis <- function(trans = NULL, name = waiver(), breaks = waiver(), labels =
dup_axis <- function(trans = ~., name = derive(), breaks = derive(), labels = derive()) {
sec_axis(trans, name, breaks, labels)
}

is.sec_axis <- function(x) {
inherits(x, "AxisSecondary")
}

set_sec_axis <- function(sec.axis, scale) {
if (!is.waive(sec.axis)) {
if (is.formula(sec.axis)) sec.axis <- sec_axis(sec.axis)
if (!is.sec_axis(sec.axis)) stop("Secondary axes must be specified using 'sec_axis()'")
scale$secondary.axis <- sec.axis
}
return(scale)
}

#' @rdname sec_axis
#'
#' @export
Expand Down
17 changes: 5 additions & 12 deletions R/scale-continuous.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -86,12 +86,9 @@ scale_x_continuous <- function(name = waiver(), breaks = waiver(),
expand = expand, oob = oob, na.value = na.value, trans = trans,
guide = "none", position = position, super = ScaleContinuousPosition
)
if (!is.waive(sec.axis)) {
if (is.formula(sec.axis)) sec.axis <- sec_axis(sec.axis)
if (!is.sec_axis(sec.axis)) stop("Secondary axes must be specified using 'sec_axis()'")
sc$secondary.axis <- sec.axis
}
sc

set_sec_axis(sec.axis, sc)

}

#' @rdname scale_continuous
Expand All @@ -108,12 +105,8 @@ scale_y_continuous <- function(name = waiver(), breaks = waiver(),
expand = expand, oob = oob, na.value = na.value, trans = trans,
guide = "none", position = position, super = ScaleContinuousPosition
)
if (!is.waive(sec.axis)) {
if (is.formula(sec.axis)) sec.axis <- sec_axis(sec.axis)
if (!is.sec_axis(sec.axis)) stop("Secondary axes must be specified using 'sec_axis()'")
sc$secondary.axis <- sec.axis
}
sc

set_sec_axis(sec.axis, sc)
}


Expand Down
89 changes: 77 additions & 12 deletions R/scale-date.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,7 @@
#' @param timezone The timezone to use for display on the axes. The default
#' (`NULL`) uses the timezone encoded in the data.
#' @family position scales
#' @seealso [sec_axis()] for how to specify secondary axes
#' @examples
#' last_month <- Sys.Date() - 0:29
#' df <- data.frame(
Expand All @@ -49,6 +50,7 @@
#'
#' # Set limits
#' base + scale_x_date(limits = c(Sys.Date() - 7, NA))
#'
#' @name scale_date
#' @aliases NULL
NULL
Expand All @@ -64,9 +66,10 @@ scale_x_date <- function(name = waiver(),
date_minor_breaks = waiver(),
limits = NULL,
expand = waiver(),
position = "bottom") {
position = "bottom",
sec.axis = waiver()) {

datetime_scale(
sc <- datetime_scale(
c("x", "xmin", "xmax", "xend"),
"date",
name = name,
Expand All @@ -82,6 +85,8 @@ scale_x_date <- function(name = waiver(),
expand = expand,
position = position
)

set_sec_axis(sec.axis, sc)
}

#' @rdname scale_date
Expand All @@ -95,9 +100,10 @@ scale_y_date <- function(name = waiver(),
date_minor_breaks = waiver(),
limits = NULL,
expand = waiver(),
position = "left") {
position = "left",
sec.axis = waiver()) {

datetime_scale(
sc <- datetime_scale(
c("y", "ymin", "ymax", "yend"),
"date",
name = name,
Expand All @@ -113,6 +119,8 @@ scale_y_date <- function(name = waiver(),
expand = expand,
position = position
)

set_sec_axis(sec.axis, sc)
}

#' @export
Expand All @@ -127,9 +135,10 @@ scale_x_datetime <- function(name = waiver(),
timezone = NULL,
limits = NULL,
expand = waiver(),
position = "bottom") {
position = "bottom",
sec.axis = waiver()) {

datetime_scale(
sc <- datetime_scale(
c("x", "xmin", "xmax", "xend"),
"time",
name = name,
Expand All @@ -146,6 +155,8 @@ scale_x_datetime <- function(name = waiver(),
expand = expand,
position = position
)

set_sec_axis(sec.axis, sc)
}


Expand All @@ -161,9 +172,10 @@ scale_y_datetime <- function(name = waiver(),
timezone = NULL,
limits = NULL,
expand = waiver(),
position = "left") {
position = "left",
sec.axis = waiver()) {

datetime_scale(
sc <- datetime_scale(
c("y", "ymin", "ymax", "yend"),
"time",
name = name,
Expand All @@ -180,6 +192,8 @@ scale_y_datetime <- function(name = waiver(),
expand = expand,
position = position
)

set_sec_axis(sec.axis, sc)
}


Expand All @@ -194,7 +208,8 @@ scale_x_time <- function(name = waiver(),
expand = waiver(),
oob = censor,
na.value = NA_real_,
position = "bottom") {
position = "bottom",
sec.axis = waiver()) {

scale_x_continuous(
name = name,
Expand All @@ -206,7 +221,8 @@ scale_x_time <- function(name = waiver(),
oob = oob,
na.value = na.value,
position = position,
trans = scales::hms_trans()
trans = scales::hms_trans(),
sec.axis = sec.axis
)
}

Expand All @@ -221,7 +237,8 @@ scale_y_time <- function(name = waiver(),
expand = waiver(),
oob = censor,
na.value = NA_real_,
position = "left") {
position = "left",
sec.axis = waiver()) {

scale_y_continuous(
name = name,
Expand All @@ -233,7 +250,8 @@ scale_y_time <- function(name = waiver(),
oob = oob,
na.value = na.value,
position = position,
trans = scales::hms_trans()
trans = scales::hms_trans(),
sec.axis = sec.axis
)
}

Expand Down Expand Up @@ -301,6 +319,7 @@ datetime_scale <- function(aesthetics, trans, palette,
#' @usage NULL
#' @export
ScaleContinuousDatetime <- ggproto("ScaleContinuousDatetime", ScaleContinuous,
secondary.axis = waiver(),
timezone = NULL,
transform = function(self, x) {
tz <- attr(x, "tzone")
Expand All @@ -312,15 +331,61 @@ ScaleContinuousDatetime <- ggproto("ScaleContinuousDatetime", ScaleContinuous,
},
map = function(self, x, limits = self$get_limits()) {
self$oob(x, limits)
},
break_info = function(self, range = NULL) {
breaks <- ggproto_parent(ScaleContinuous, self)$break_info(range)
if (!(is.waive(self$secondary.axis) || self$secondary.axis$empty())) {
self$secondary.axis$init(self)
breaks <- c(breaks, self$secondary.axis$break_info(breaks$range, self))
}
breaks
},
sec_name = function(self) {
if (is.waive(self$secondary.axis)) {
waiver()
} else {
self$secondary.axis$name
}
},
make_sec_title = function(self, title) {
if (!is.waive(self$secondary.axis)) {
self$secondary.axis$make_title(title)
} else {
ggproto_parent(ScaleContinuous, self)$make_sec_title(title)
}
}

)

#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
ScaleContinuousDate <- ggproto("ScaleContinuousDate", ScaleContinuous,
secondary.axis = waiver(),
map = function(self, x, limits = self$get_limits()) {
self$oob(x, limits)
},
break_info = function(self, range = NULL) {
breaks <- ggproto_parent(ScaleContinuous, self)$break_info(range)
if (!(is.waive(self$secondary.axis) || self$secondary.axis$empty())) {
self$secondary.axis$init(self)
breaks <- c(breaks, self$secondary.axis$break_info(breaks$range, self))
}
breaks
},
sec_name = function(self) {
if (is.waive(self$secondary.axis)) {
waiver()
} else {
self$secondary.axis$name
}
},
make_sec_title = function(self, title) {
if (!is.waive(self$secondary.axis)) {
self$secondary.axis$make_title(title)
} else {
ggproto_parent(ScaleContinuous, self)$make_sec_title(title)
}
}
)
19 changes: 13 additions & 6 deletions man/scale_date.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit 4b880bb

Please sign in to comment.