Fix timezone issues in scale_*_datetime (#1767)

Fixes #1718

* Store and access timezone when making labels and breaks

* Add default timezone argument

NEWS.md

@@ -38,6 +38,10 @@
   degrees Fahrenheit). The secondary axis will be positioned opposite of the 
   primary axis and can be controlled using the `sec.axis` argument to the scale
   constructor.
+
+* `scale_*_datetime` now has support for timezones. If time data has been 
+  encoded with a timezone this will be used, but it can be overridden with the
+  `timezone` argument in the scale constructor.
 
 * The documentation for theme elements has been improved (#1743).
 

R/scale-date.r

@@ -14,6 +14,8 @@
 #' @param date_labels A string giving the formatting specification for the
 #'   labels. Codes are defined in \code{\link{strftime}}. If both \code{labels}
 #'   and \code{date_labels} are specified, \code{date_labels} wins.
+#' @param timezone The timezone to use for display on the axes. The default
+#' (\code{NULL}) uses the timezone encoded in the data.
 #' @seealso \code{\link{scale_continuous}} for continuous position scales.
 #' @examples
 #' last_month <- Sys.Date() - 0:29
@@ -76,14 +78,15 @@ scale_x_datetime <- function(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") {
+                             timezone = NULL, limits = NULL, expand = waiver(),
+                             position = "bottom") {
 
   scale_datetime(c("x", "xmin", "xmax", "xend"), "time",
     name = name,
     breaks = breaks, date_breaks = date_breaks,
     labels = labels, date_labels = date_labels,
     minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks,
-    limits = limits, expand = expand, position = position
+    timezone = timezone, limits = limits, expand = expand, position = position
   )
 }
 
@@ -94,22 +97,23 @@ scale_y_datetime <- function(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") {
+                             timezone = NULL, limits = NULL, expand = waiver(),
+                             position = "left") {
 
   scale_datetime(c("y", "ymin", "ymax", "yend"), "time",
     name = name,
     breaks = breaks, date_breaks = date_breaks,
     labels = labels, date_labels = date_labels,
     minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks,
-    limits = limits, expand = expand, position = position
+    timezone = timezone, limits = limits, expand = expand, position = position
   )
 }
 
 scale_datetime <- function(aesthetics, trans,
                            breaks = pretty_breaks(), minor_breaks = waiver(),
                            labels = waiver(), date_breaks = waiver(),
                            date_labels = waiver(),
-                           date_minor_breaks = waiver(),
+                           date_minor_breaks = waiver(), timezone = NULL,
                            ...) {
 
   name <- switch(trans, date = "date", time = "datetime")
@@ -125,14 +129,17 @@ scale_datetime <- function(aesthetics, trans,
     minor_breaks <- date_breaks(date_minor_breaks)
   }
   if (!is.waive(date_labels)) {
-    labels <- date_format(date_labels)
+    labels <- function(self, x) {
+      tz <- if (is.null(self$timezone)) "UTC" else self$timezone
+      date_format(date_labels, tz)(x)
+    }
   }
 
   scale_class <- switch(trans, date = ScaleContinuousDate, time = ScaleContinuousDatetime)
   sc <- continuous_scale(aesthetics, name, identity,
     breaks = breaks, minor_breaks = minor_breaks, labels = labels,
     guide = "none", trans = trans, ..., super = scale_class)
-
+  sc$timezone <- timezone
   sc
 }
 
@@ -142,6 +149,15 @@ scale_datetime <- function(aesthetics, trans,
 #' @usage NULL
 #' @export
 ScaleContinuousDatetime <- ggproto("ScaleContinuousDatetime", ScaleContinuous,
+  timezone = NULL,
+  transform = function(self, x) {
+    tz <- attr(x, "tzone")
+    if (is.null(self$timezone) && !is.null(tz)) {
+      self$timezone <- tz
+      self$trans <- time_trans(self$timezone)
+    }
+    ggproto_parent(ScaleContinuous, self)$transform(x)
+  },
   map = function(self, x, limits = self$get_limits()) {
     self$oob(x, limits)
   }

tests/testthat/test-scale-date.R

@@ -0,0 +1,46 @@
+context("scale_date")
+
+base_time <- function(tz = "") {
+  as.POSIXct(strptime("2015-06-01", "%Y-%m-%d", tz = tz))
+}
+
+df <- data.frame(
+  time1 = base_time("") + 0:6 * 3600,
+  time2 = base_time("UTC") + 0:6 * 3600,
+  time3 = base_time("Australia/Lord_Howe") + (0:6 + 13) * 3600, # has half hour offset
+  y = seq_along(base_time)
+)
+
+test_that("inherits timezone from data", {
+  # Local time
+  p <- ggplot(df, aes(y = y)) + geom_point(aes(time1))
+  sc <- layer_scales(p)$x
+  expect_equal(sc$timezone, NULL)
+  expect_equal(sc$get_labels()[1], "00:00")
+
+  # UTC
+  p <- ggplot(df, aes(y = y)) + geom_point(aes(time2))
+  sc <- layer_scales(p)$x
+  expect_equal(sc$timezone, "UTC")
+  expect_equal(sc$get_labels()[1], "00:00")
+})
+
+
+test_that("first timezone wins", {
+  p <- ggplot(df, aes(y = y)) +
+    geom_point(aes(time2)) +
+    geom_point(aes(time3), colour = "red") +
+    scale_x_datetime(date_breaks = "hour", date_labels = "%H:%M")
+  sc <- layer_scales(p)$x
+  expect_equal(sc$timezone, "UTC")
+})
+
+test_that("not cached across calls", {
+  scale_x <- scale_x_datetime(date_breaks = "hour", date_labels = "%H:%M")
+
+  p1 <- ggplot(df, aes(y = y)) + geom_point(aes(time2)) + scale_x
+  p2 <- ggplot(df, aes(y = y)) + geom_point(aes(time3)) + scale_x
+
+  expect_equal(layer_scales(p1)$x$timezone, "UTC")
+  expect_equal(layer_scales(p2)$x$timezone, "Australia/Lord_Howe")
+})