From 4765a8315de042069fb07b42a2fdafeee65886d9 Mon Sep 17 00:00:00 2001
From: Dana Seidel <dpseidel@berkeley.edu>
Date: Mon, 6 Aug 2018 16:38:20 -0700
Subject: [PATCH 1/3] Implement sec.axis for date, time, and datetime scales

---
 NEWS.md                        |   5 ++
 R/scale-date.r                 | 108 +++++++++++++++++++++++++++++----
 tests/testthat/test-sec-axis.R |  42 +++++++++++++
 3 files changed, 143 insertions(+), 12 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 7cdad8bc21..ab0f76d649 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -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).
+
 *   `sec_axis()` and `dup_axis()` now return appropriate breaks for the secondary
     axis when applied to log transformed scales (@dpseidel, #2729).
 
diff --git a/R/scale-date.r b/R/scale-date.r
index 6dceba7e89..202b1cfd82 100644
--- a/R/scale-date.r
+++ b/R/scale-date.r
@@ -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(
@@ -64,9 +65,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,
@@ -82,6 +84,13 @@ scale_x_date <- function(name = waiver(),
     expand = expand,
     position = position
   )
+
+  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
 }
 
 #' @rdname scale_date
@@ -95,9 +104,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,
@@ -113,6 +123,13 @@ scale_y_date <- function(name = waiver(),
     expand = expand,
     position = position
   )
+
+  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
 }
 
 #' @export
@@ -127,9 +144,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,
@@ -146,6 +164,13 @@ scale_x_datetime <- function(name = waiver(),
     expand = expand,
     position = position
   )
+
+  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
 }
 
 
@@ -161,9 +186,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,
@@ -180,6 +206,13 @@ scale_y_datetime <- function(name = waiver(),
     expand = expand,
     position = position
   )
+
+  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
 }
 
 
@@ -194,7 +227,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,
@@ -206,7 +240,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
   )
 }
 
@@ -221,7 +256,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,
@@ -233,7 +269,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
   )
 }
 
@@ -301,6 +338,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")
@@ -312,7 +350,30 @@ 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
@@ -320,7 +381,30 @@ ScaleContinuousDatetime <- ggproto("ScaleContinuousDatetime", ScaleContinuous,
 #' @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)
+    }
   }
 )
diff --git a/tests/testthat/test-sec-axis.R b/tests/testthat/test-sec-axis.R
index 56284cc415..0df31869aa 100644
--- a/tests/testthat/test-sec-axis.R
+++ b/tests/testthat/test-sec-axis.R
@@ -115,3 +115,45 @@ test_that("sec axis works with tidy eval", {
 
   expect_equal(breaks$major_source / 10, breaks$sec.major_source)
 })
+
+test_that("sec_axis works with date/time/datetime scales", {
+  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)
+  )
+  df$date <- as.Date(df$dx)
+  dt <- ggplot(df, aes(dx, price)) +
+    geom_line() +
+    scale_x_datetime(sec.axis = dup_axis())
+  scale <- layer_scales(dt)$x
+  breaks <- scale$break_info()
+  expect_equal(breaks$major_source, breaks$sec.major_source)
+
+  dt <- ggplot(df, aes(date, price)) +
+    geom_line() +
+    scale_x_date(sec.axis = dup_axis())
+  scale <- layer_scales(dt)$x
+  breaks <- scale$break_info()
+  expect_equal(breaks$major_source, breaks$sec.major_source)
+
+  dt <- ggplot(df, aes(dx, price)) +
+    geom_line() +
+    scale_x_datetime(
+      name = "UTC",
+      sec.axis = dup_axis(~. + 12 * 60 * 60,
+        name = "UTC+12"
+      )
+    )
+  scale <- layer_scales(dt)$x
+  breaks <- scale$break_info()
+
+  expect_equal(
+    as.numeric(breaks$major_source) + 12 * 60 * 60,
+    as.numeric(breaks$sec.major_source)
+  )
+})

From e86f8cbc4c9cc50cee97e682af18e09ec7691c70 Mon Sep 17 00:00:00 2001
From: Dana Seidel <dpseidel@berkeley.edu>
Date: Mon, 6 Aug 2018 16:52:03 -0700
Subject: [PATCH 2/3] Update documentation

---
 man/scale_date.Rd | 50 ++++++++++++++++++++++++++++-------------------
 1 file changed, 30 insertions(+), 20 deletions(-)

diff --git a/man/scale_date.Rd b/man/scale_date.Rd
index bc25206725..63864c730f 100644
--- a/man/scale_date.Rd
+++ b/man/scale_date.Rd
@@ -9,33 +9,39 @@
 \alias{scale_y_time}
 \title{Position scales for date/time data}
 \usage{
-scale_x_date(name = waiver(), breaks = waiver(), date_breaks = waiver(),
-  labels = waiver(), date_labels = waiver(), minor_breaks = waiver(),
-  date_minor_breaks = waiver(), limits = NULL, expand = waiver(),
-  position = "bottom")
+scale_x_date(name = waiver(), breaks = waiver(),
+  date_breaks = waiver(), labels = waiver(), date_labels = waiver(),
+  minor_breaks = waiver(), date_minor_breaks = waiver(),
+  limits = NULL, expand = waiver(), position = "bottom",
+  sec.axis = waiver())
 
-scale_y_date(name = waiver(), breaks = waiver(), date_breaks = waiver(),
-  labels = waiver(), date_labels = waiver(), minor_breaks = waiver(),
-  date_minor_breaks = waiver(), limits = NULL, expand = waiver(),
-  position = "left")
+scale_y_date(name = waiver(), breaks = waiver(),
+  date_breaks = waiver(), labels = waiver(), date_labels = waiver(),
+  minor_breaks = waiver(), date_minor_breaks = waiver(),
+  limits = NULL, expand = waiver(), position = "left",
+  sec.axis = waiver())
 
 scale_x_datetime(name = waiver(), breaks = waiver(),
   date_breaks = waiver(), labels = waiver(), date_labels = waiver(),
-  minor_breaks = waiver(), date_minor_breaks = waiver(), timezone = NULL,
-  limits = NULL, expand = waiver(), position = "bottom")
+  minor_breaks = waiver(), date_minor_breaks = waiver(),
+  timezone = NULL, limits = NULL, expand = waiver(),
+  position = "bottom", sec.axis = waiver())
 
 scale_y_datetime(name = waiver(), breaks = waiver(),
   date_breaks = waiver(), labels = waiver(), date_labels = waiver(),
-  minor_breaks = waiver(), date_minor_breaks = waiver(), timezone = NULL,
-  limits = NULL, expand = waiver(), position = "left")
-
-scale_x_time(name = waiver(), breaks = waiver(), minor_breaks = waiver(),
-  labels = waiver(), limits = NULL, expand = waiver(), oob = censor,
-  na.value = NA_real_, position = "bottom")
-
-scale_y_time(name = waiver(), breaks = waiver(), minor_breaks = waiver(),
-  labels = waiver(), limits = NULL, expand = waiver(), oob = censor,
-  na.value = NA_real_, position = "left")
+  minor_breaks = waiver(), date_minor_breaks = waiver(),
+  timezone = NULL, limits = NULL, expand = waiver(),
+  position = "left", sec.axis = waiver())
+
+scale_x_time(name = waiver(), breaks = waiver(),
+  minor_breaks = waiver(), labels = waiver(), limits = NULL,
+  expand = waiver(), oob = censor, na.value = NA_real_,
+  position = "bottom", sec.axis = waiver())
+
+scale_y_time(name = waiver(), breaks = waiver(),
+  minor_breaks = waiver(), labels = waiver(), limits = NULL,
+  expand = waiver(), oob = censor, na.value = NA_real_,
+  position = "left", sec.axis = waiver())
 }
 \arguments{
 \item{name}{The name of the scale. Used as axis or legend title. If
@@ -95,6 +101,8 @@ expand the scale by 5\% on each side for continuous variables, and by
 \item{position}{The position of the axis. "left" or "right" for vertical
 scales, "top" or "bottom" for horizontal scales}
 
+\item{sec.axis}{specify a secondary axis}
+
 \item{timezone}{The timezone to use for display on the axes. The default
 (\code{NULL}) uses the timezone encoded in the data.}
 
@@ -130,6 +138,8 @@ base + scale_x_date(date_minor_breaks = "1 day")
 base + scale_x_date(limits = c(Sys.Date() - 7, NA))
 }
 \seealso{
+\code{\link[=sec_axis]{sec_axis()}} for how to specify secondary axes
+
 Other position scales: \code{\link{scale_x_continuous}},
   \code{\link{scale_x_discrete}}
 }

From a73fea524a78300477118bce6d11fb6bf2862eaf Mon Sep 17 00:00:00 2001
From: Dana Seidel <dpseidel@berkeley.edu>
Date: Fri, 17 Aug 2018 17:11:23 -0700
Subject: [PATCH 3/3] Add new examples and separate set_sec_axis check

---
 R/axis-secondary.R   | 35 +++++++++++++++++++++++++++++++++++
 R/scale-continuous.r | 17 +++++------------
 R/scale-date.r       | 29 +++++------------------------
 man/scale_date.Rd    |  1 +
 man/sec_axis.Rd      | 24 ++++++++++++++++++++++++
 5 files changed, 70 insertions(+), 36 deletions(-)

diff --git a/R/axis-secondary.R b/R/axis-secondary.R
index a7eb19546d..79503318f8 100644
--- a/R/axis-secondary.R
+++ b/R/axis-secondary.R
@@ -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)
@@ -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
diff --git a/R/scale-continuous.r b/R/scale-continuous.r
index 044227a1c3..7134dd8c84 100644
--- a/R/scale-continuous.r
+++ b/R/scale-continuous.r
@@ -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
@@ -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)
 }
 
 
diff --git a/R/scale-date.r b/R/scale-date.r
index 202b1cfd82..030d2f412d 100644
--- a/R/scale-date.r
+++ b/R/scale-date.r
@@ -50,6 +50,7 @@
 #'
 #' # Set limits
 #' base + scale_x_date(limits = c(Sys.Date() - 7, NA))
+#'
 #' @name scale_date
 #' @aliases NULL
 NULL
@@ -85,12 +86,7 @@ scale_x_date <- function(name = waiver(),
     position = position
   )
 
-  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_date
@@ -124,12 +120,7 @@ scale_y_date <- function(name = waiver(),
     position = position
   )
 
-  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)
 }
 
 #' @export
@@ -165,12 +156,7 @@ scale_x_datetime <- function(name = waiver(),
     position = position
   )
 
-  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)
 }
 
 
@@ -207,12 +193,7 @@ scale_y_datetime <- function(name = waiver(),
     position = position
   )
 
-  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)
 }
 
 
diff --git a/man/scale_date.Rd b/man/scale_date.Rd
index c4daba41e1..aa1c57d0c4 100644
--- a/man/scale_date.Rd
+++ b/man/scale_date.Rd
@@ -136,6 +136,7 @@ base + scale_x_date(date_minor_breaks = "1 day")
 
 # Set limits
 base + scale_x_date(limits = c(Sys.Date() - 7, NA))
+
 }
 \seealso{
 \code{\link[=sec_axis]{sec_axis()}} for how to specify secondary axes
diff --git a/man/sec_axis.Rd b/man/sec_axis.Rd
index b3f722d74d..b6383830d4 100644
--- a/man/sec_axis.Rd
+++ b/man/sec_axis.Rd
@@ -65,4 +65,28 @@ p + scale_y_continuous(sec.axis = dup_axis())
 # 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")))
+
 }