[#24] Use and propagate tzone attribute of Date objects

NEWS.md

@@ -9,6 +9,7 @@ Version 0.1.1.9000
 ## Bug Fixes
 
  - [#16](https://github.com/vspinu/timechange/issues/16) Rounding unit parser is now conformant to R numeric parser
+ - [#23](https://github.com/vspinu/timechange/pull/24) Respect `tzone` attributes of Date objects.
 
 ## Internals
 

R/addition.R

@@ -193,12 +193,12 @@ time_add <- function(time, periods = NULL,
     storage.mode(time) <- "double"
     C_time_add(time, periods, roll_month, roll_dst)
   } else if (is.Date(time)) {
-    out <- date2posixct(time)
+    out <- date_to_posixct(time, tz(time))
     out <- C_time_add(out, periods, roll_month, roll_dst)
     if (is.null(periods[["hour"]]) &&
         is.null(periods[["minute"]]) &&
         is.null(periods[["second"]])) {
-      out <- as.Date(out, tz = "UTC")
+      out <- posixct_to_date(out)
     }
     out
   } else if (is.POSIXlt(time)) {

R/get.R

@@ -32,7 +32,7 @@ time_get <- function(time,
     if (is.POSIXct(time)) {
       C_time_get(time, components, week_start)
     } else if (is.Date(time)) {
-      time <- date2posixct(time)
+      time <- date_to_posixct(time, "UTC")
       C_time_get(time, components, week_start)
     } else if (is.POSIXlt(time)) {
       unique_components <- unique(components)

R/update.R

@@ -75,13 +75,13 @@ time_update <- function(time, updates = NULL, year = NULL, month = NULL,
     storage.mode(time) <- "double"
     C_time_update(time, updates, tz, roll_month, roll_dst, week_start, exact)
   } else if (is.Date(time)) {
-    out <- date2posixct(time)
+    out <- date_to_posixct(time, tz(time))
     out <- C_time_update(out, updates, tz, roll_month, roll_dst, week_start, exact)
     if (is.null(updates[["hour"]]) &&
         is.null(updates[["minute"]]) &&
         is.null(updates[["second"]]) &&
         is.null(tz)) {
-      out <- as.Date(out, tz = "UTC")
+      out <- posixct_to_date(out)
     }
     out
   } else if (is.POSIXlt(time)) {

R/utils.R

@@ -12,7 +12,17 @@ unsupported_date_time <- function(x) {
 date_to_posixct <- function(date, tz = "UTC") {
   utc <- .POSIXct(unclass(date) * 86400, tz = "UTC")
   if (tz == "UTC") utc
-  else time_force_tz(utc, tz)
+  else C_force_tz(utc, tz, c("boundary", "post"))
+}
+
+posixct_to_date <- function(x) {
+  tz <- tz(x)
+  if (tz == "UTC") {
+    structure(floor(unclass(x)/86400), class = "Date", tzone = NULL)
+  } else {
+    x <- C_force_tz(x, "UTC", c("boundary", "post"))
+    structure(floor(unclass(x)/86400), class = "Date", tzone = tz)
+  }
 }
 
 tz <- function(x) {
@@ -33,7 +43,7 @@ to_posixct <- function(time) {
     storage.mode(time) <- "double"
     time
   } else if (is.Date(time))
-    date_to_posixct(time, tz = tz(time))
+    date_to_posixct(time, tz(time))
   else if (is.POSIXlt(time)) {
     as.POSIXct.POSIXlt(time, tz = tz(time))
   } else {
@@ -46,7 +56,7 @@ from_posixct <- function(ct, time, force_date = FALSE) {
     ct
   else if (is.Date(time)) {
     if (force_date) {
-      as.Date(ct, tz = tz(time))
+      posixct_to_date(ct)
     } else {
       ct
     }
@@ -62,7 +72,7 @@ from_posixlt <- function(new, old, force_date = FALSE) {
     new
   else if (is.Date(old)) {
     if (force_date) {
-      as.Date(new, tz = tz(old))
+      as.Date.POSIXlt(new, tz = tz(old))
     } else {
       as.POSIXct.POSIXlt(new)
     }
@@ -81,10 +91,3 @@ standardise_unit_name <- function(x) {
 parse_unit <- function(unit) {
   .Call(C_parse_unit, as.character(unit))
 }
-
-# Because `as.POSIXct.Date()` always uses local timezone
-date2posixct <- function(x) {
-  structure(unclass(x) * 86400,
-            tzone = "UTC",
-            class = c("POSIXct", "POSIXt"))
-}

R/zones.R

@@ -141,7 +141,7 @@ time_clock_at_tz <- function(time, tz = NULL, units = "secs") {
     time
   } else {
     time <-
-      if (is.Date(time)) date2posixct(time)
+      if (is.Date(time)) date_to_posixct(time, tz(time))
       else as.POSIXct(time)
     .clock_at_tz(time, tz, units)
   }

tests/testthat/test-addition.R

@@ -258,3 +258,13 @@ test_that("addition works correctly for DST transitions", {
   expect_equal(time_add(ref, hours = rep(1:3, 2), minutes = 1:6, roll_dst = c("post", "NA")),
                ref + c(1, NA, 4, 1, 2, 2)*3600 + 1:6*60)
 })
+
+test_that("tzone attributes of Dates is preserved", {
+  d <- ymd("2020-01-01")
+  tzone <- "America/New_York"
+  attr(d, "tzone") <- tzone
+  expect_is(time_add(d, month = 2), "Date")
+  expect_is(time_add(d, hour = 2), "POSIXct")
+  expect_identical(time_add(d, month = 1), structure(ymd("2020-02-01"), tzone = tzone))
+  expect_identical(time_add(d, hour = 1), ymd_hms("2020-01-01 01:00:00", tz = tzone))
+})

tests/testthat/test-get.R

@@ -30,6 +30,16 @@ test_that("time_get handles different date-time types correctly", {
 
 })
 
+test_that("tzone attributes of Dates is preserved", {
+  d <- ymd("2020-01-01")
+  tzone <- "America/New_York"
+  attr(d, "tzone") <- tzone
+  time_get(d, "month")
+  expect_is(time_update(d, hour = 2), "POSIXct")
+  expect_identical(time_update(d, month = 2), structure(ymd("2020-02-01"), tzone = tzone))
+  expect_identical(time_update(d, hour = 1), ymd_hms("2020-01-01 01:00:00", tz = tzone))
+})
+
 ## speed tests
 
 ## library(microbenchmark)

tests/testthat/test-round.R

@@ -722,3 +722,17 @@ test_that("rounding with custom origin respects change_on_boundary", {
   expect_equal(time_ceiling(x, "3000a", change_on_boundary = TRUE, origin = time_floor(x, "day")),
                ymd_hms(c("2010-10-01 02:30:00", "2010-11-02 03:20:00"), tz = "America/New_York"))
 })
+
+
+test_that("tzone attributes of Dates is preserved", {
+  #23
+  d <- ymd("2020-01-01")
+  tzone <- "America/New_York"
+  attr(d, "tzone") <- tzone
+  expect_is(time_floor(d, "month"), "Date")
+  expect_is(time_floor(d, "hour"), "POSIXct")
+  expect_identical(time_floor(d, "month"), structure(ymd("2020-01-01"), tzone = tzone))
+  expect_identical(time_floor(d, "hour"), ymd("2020-01-01", tz = tzone))
+  expect_identical(time_ceiling(d, "hour"), ymd_hms("2020-01-01 01:00:00", tz = tzone))
+  expect_identical(time_ceiling(d, "hour", change_on_boundary = FALSE), ymd_hms("2020-01-01 00:00:00", tz = tzone))
+})

tests/testthat/test-update.R

@@ -543,3 +543,14 @@ test_that("NAs propagate in update", {
   expect_equal(time_update(ymd("2020-03-03"), year = c(2021, NA), second = c(NA, 10)),
                c(NA_POSIXct_, NA_POSIXct_))
 })
+
+
+test_that("tzone attributes of Dates is preserved", {
+  d <- ymd("2020-01-01")
+  tzone <- "America/New_York"
+  attr(d, "tzone") <- tzone
+  expect_is(time_update(d, month = 2), "Date")
+  expect_is(time_update(d, hour = 2), "POSIXct")
+  expect_identical(time_update(d, month = 2), structure(ymd("2020-02-01"), tzone = tzone))
+  expect_identical(time_update(d, hour = 1), ymd_hms("2020-01-01 01:00:00", tz = tzone))
+})