diff --git a/NEWS.md b/NEWS.md index 8f87ac8..8d77833 100644 --- a/NEWS.md +++ b/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 diff --git a/R/addition.R b/R/addition.R index e02918e..775ba7d 100644 --- a/R/addition.R +++ b/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)) { diff --git a/R/get.R b/R/get.R index a88c5ba..ff16038 100644 --- a/R/get.R +++ b/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) diff --git a/R/update.R b/R/update.R index ed7a9e6..8cc2f34 100644 --- a/R/update.R +++ b/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)) { diff --git a/R/utils.R b/R/utils.R index 24159d7..cb13374 100644 --- a/R/utils.R +++ b/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")) -} diff --git a/R/zones.R b/R/zones.R index 47219b6..233f955 100644 --- a/R/zones.R +++ b/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) } diff --git a/tests/testthat/test-addition.R b/tests/testthat/test-addition.R index b7acbe0..bd2b0b0 100644 --- a/tests/testthat/test-addition.R +++ b/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)) +}) diff --git a/tests/testthat/test-get.R b/tests/testthat/test-get.R index ea821d4..f7dcf05 100644 --- a/tests/testthat/test-get.R +++ b/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) diff --git a/tests/testthat/test-round.R b/tests/testthat/test-round.R index 236502f..739a3df 100644 --- a/tests/testthat/test-round.R +++ b/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)) +}) diff --git a/tests/testthat/test-update.R b/tests/testthat/test-update.R index ec24cdf..fee1923 100644 --- a/tests/testthat/test-update.R +++ b/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)) +})