From 5dfec2f30f3c6b5415e07f5b48d47661d47515d2 Mon Sep 17 00:00:00 2001 From: Vitalie Spinu Date: Tue, 5 Apr 2016 17:30:14 +0200 Subject: [PATCH] [Fix #399] Change timezone across DTS rounding --- R/round.r | 30 ++++++++++++++++++++---------- R/update.r | 8 +++----- tests/testthat/test-round.R | 12 ++++++++++++ 3 files changed, 35 insertions(+), 15 deletions(-) diff --git a/R/round.r b/R/round.r index d106d35f..f7b343f9 100644 --- a/R/round.r +++ b/R/round.r @@ -113,11 +113,12 @@ floor_date <- function(x, unit = c("second", "minute", "hour", "day", "week", "m if(unit %in% c("second", "minute", "hour", "day")){ reclass_date(trunc(x, units = lub2base_units[[unit]]), x) } else { + new <- switch(unit, - week = update(x, wdays = 1, hours = 0, minutes = 0, seconds = 0, simple = T), - month = update(x, mdays = 1, hours = 0, minutes = 0, seconds = 0, simple = T), - quarter = update(x, months = ((month(x)-1)%/%3)*3+1, mdays = 1, hours = 0, minutes = 0, seconds = 0, simple = T), - year = update(x, ydays = 1, hours = 0, minutes = 0, seconds = 0, simple = T)) + week = update(x, wdays = 1, hours = 0, minutes = 0, seconds = 0), + month = update(x, mdays = 1, hours = 0, minutes = 0, seconds = 0), + quarter = update(x, months = ((month(x)-1)%/%3)*3+1, mdays = 1, hours = 0, minutes = 0, seconds = 0), + year = update(x, ydays = 1, hours = 0, minutes = 0, seconds = 0)) new } } @@ -143,10 +144,13 @@ floor_date <- function(x, unit = c("second", "minute", "hour", "day", "week", "m ceiling_date <- function(x, unit = c("second", "minute", "hour", "day", "week", "month", "year", "quarter"), change_on_boundary = getOption("lubridate.ceiling_date.change_on_boundary", FALSE)) { - if(!length(x)) return(x) + if(!length(x)) + return(x) + unit <- match.arg(unit) if(unit == "second"){ + sec <- second(x) csec <- ceiling(sec) if(change_on_boundary){ @@ -155,26 +159,32 @@ ceiling_date <- function(x, csec[zsec] <- csec[zsec] + 1L } update(x, seconds = csec, simple = T) + }else if(is.POSIXt(x) & (unit %in% c("minute", "hour", "day"))){ + ## cannot use this for Date class, (local tz interferes with computation) new <- as.POSIXct(x, tz = tz(x)) one <- as.numeric(change_on_boundary) new <- new + switch(unit, minute = 59 + one, hour = 3599 + one, day = 86399 + one) reclass_date(trunc.POSIXt(new, units = lub2base_units[[unit]]), x) + } else { + ## we need this to accomodate the case when date is on a boundary new <- if(change_on_boundary) x else update(x, seconds = second(x) - 0.00001, simple = T) + new <- switch(unit, minute = update(new, minute = minute(new) + 1L, second = 0, simple = T), hour = update(new, hour = hour(new) + 1L, minute = 0, second = 0, simple = T), - day = update(new, day = day(new) + 1L, hour = 0, minute = 0, second = 0, simple = T), - week = update(new, wday = 8, hour = 0, minute = 0, second = 0, simple = T), - month = update(new, month = month(new) + 1L, mday = 1, hour = 0, minute = 0, second = 0, simple = T), - quarter = update(new, month = ((month(new)-1)%/%3)*3+4, mday = 1, hour = 0, minute = 0, second = 0, simple = T), - year = update(new, year = year(new) + 1L, month = 1, mday = 1, hour = 0, minute = 0, second = 0, simple = T)) + day = update(new, day = day(new) + 1L, hour = 0, minute = 0, second = 0), + week = update(new, wday = 8, hour = 0, minute = 0, second = 0), + month = update(new, month = month(new) + 1L, mday = 1, hour = 0, minute = 0, second = 0), + quarter = update(new, month = ((month(new)-1)%/%3)*3+4, mday = 1, hour = 0, minute = 0, second = 0), + year = update(new, year = year(new) + 1L, month = 1, mday = 1, hour = 0, minute = 0, second = 0)) reclass_date(new, x) + } } diff --git a/R/update.r b/R/update.r index 1c580eb2..326befac 100644 --- a/R/update.r +++ b/R/update.r @@ -38,9 +38,7 @@ update.POSIXt <- function(object, ..., simple = FALSE){ units <- list(...) names(units) <- standardise_lt_names(names(units)) - new.tz <- NA - if (!is.null(units$tz)) { - new.tz <- units$tz + if (!is.null(new_tz <- units$tz)) { units$tz <- NULL } @@ -81,8 +79,8 @@ update.POSIXt <- function(object, ..., simple = FALSE){ } class(date) <- c("POSIXlt", "POSIXt") - if (!is.na(new.tz)) - attr(date, "tzone") <- new.tz + if (!is.null(new_tz)) + attr(date, "tzone") <- new_tz ## fit to timeline ## POSIXct format avoids negative and NA elements in POSIXlt format diff --git a/tests/testthat/test-round.R b/tests/testthat/test-round.R index e2b9b674..c194f590 100644 --- a/tests/testthat/test-round.R +++ b/tests/testthat/test-round.R @@ -161,6 +161,18 @@ test_that("round_date works for a variety of formats",{ "UTC"))) }) + +test_that("rounding works across DST",{ + ## https://github.com/hadley/lubridate/issues/399 + tt <- ymd("2016-03-27", tz="Europe/Helsinki"); + expect_equal(ceiling_date(tt, 'month'), as.POSIXct("2016-04-01", tz = "Europe/Helsinki")) + expect_equal(ceiling_date(tt, 'day'), as.POSIXct("2016-03-28", tz = "Europe/Helsinki")) + tt <- ymd("2016-03-28", tz="Europe/Helsinki"); + expect_equal(floor_date(tt, 'month'), as.POSIXct("2016-03-01", tz = "Europe/Helsinki")) + tt <- ymd_hms("2016-03-27 05:00:00", tz="Europe/Helsinki"); + expect_equal(floor_date(tt, 'day'), as.POSIXct("2016-03-27", tz = "Europe/Helsinki")) +}) + test_that("ceiling_date does not round up dates that are already on a boundary",{ expect_equal(ceiling_date(as.Date("2012-09-27"), 'day'), as.Date("2012-09-27")) expect_equal(ceiling_date(ymd_hms("2012-09-01 00:00:00"), 'month'), as.POSIXct("2012-09-01", tz = "UTC"))