From 7941df8a14f39d8aee6ae78644e6948f8ba634bc Mon Sep 17 00:00:00 2001 From: Vitalie Spinu Date: Thu, 23 Apr 2015 20:00:48 +0200 Subject: [PATCH] [Fix #313, Fix #217] Optimize fit_to_timeline `fit_to_timeline` now operates only on problematic dates. As a byproduct this also fixes #313 and #217 --- R/update.r | 41 ++++++++++++++++++++++++-------------- inst/tests/test-round.R | 11 +++++++++- inst/tests/test-update.R | 43 +++++++++++++--------------------------- 3 files changed, 50 insertions(+), 45 deletions(-) diff --git a/R/update.r b/R/update.r index 0624517d..833f4577 100644 --- a/R/update.r +++ b/R/update.r @@ -140,23 +140,34 @@ fit_to_timeline <- function(lt, class = "POSIXct") { # fall break - DST only changes if it has to ct <- as.POSIXct(lt) - t <- lt - t$isdst <- as.POSIXlt(ct)$isdst - - # spring break - ct <- as.POSIXct(t) # should directly match if not in gap - chours <- format.POSIXlt(as.POSIXlt(ct), "%H", usetz = FALSE) - lhours <- format.POSIXlt(t, "%H", usetz = FALSE) - - if (class == "POSIXlt") { - t[chours != lhours] <- NA - t - } else { - ct[chours != lhours] <- NA - ct + lt2 <- as.POSIXlt(ct) + dstdiff <- !is.na(ct) & (lt$isdst != lt2$isdst) + + if (any(dstdiff)) { + + dlt <- lt[dstdiff] + dlt2 <- lt2[dstdiff] + dlt$isdst <- dlt2$isdst + dct <- as.POSIXct(dlt) # should directly match if not in gap + + if (class == "POSIXct") + ct[dstdiff] <- dct + else + lt2[dstdiff] <- dlt + + chours <- format.POSIXlt(as.POSIXlt(dct), "%H", usetz = FALSE) + lhours <- format.POSIXlt(dlt, "%H", usetz = FALSE) + + any <- any(hdiff <- chours != lhours) + if (!is.na(any) && any) { + if (class == "POSIXct") + ct[dstdiff][hdiff] <- NA + else + lt2[dstdiff][hdiff] <- NA + } } + if (class == "POSIXct") ct else lt2 } - #' @export update.Date <- function(object, ...){ diff --git a/inst/tests/test-round.R b/inst/tests/test-round.R index 31c3258a..324e879c 100644 --- a/inst/tests/test-round.R +++ b/inst/tests/test-round.R @@ -210,4 +210,13 @@ test_that("round_date returns input of length zero when given input of length ze x <- structure(vector(mode = "numeric"), class = c("POSIXct", "POSIXt")) expect_equal(round_date(x), x) -}) \ No newline at end of file +}) + +test_that("round_date behaves correctly on 60th second (bug #217)", { + x <- ymd_hms('2013-12-01 23:59:59.9999') + + expect_equal(round_date(x, unit = "second"), + ymd("2013-12-02")) + second(x) <- 60 + expect_equal(x, ymd("2013-12-02")) +}) diff --git a/inst/tests/test-update.R b/inst/tests/test-update.R index 7e67c1cf..461cc7d2 100644 --- a/inst/tests/test-update.R +++ b/inst/tests/test-update.R @@ -354,20 +354,6 @@ test_that("update handles vectors of dates and conformable vector of inputs",{ equals(c(1,2,3))) }) -# test_that("update handles gives error for non-comformable date and input vectors",{ -# poslt <- as.POSIXlt(c("2010-02-14 01:59:59", "2010-02-15 01:59:59", "2010-02-16 -# 01:59:59"), tz = "UTC", format = "%Y-%m-%d %H:%M:%S") -# posct <- as.POSIXct(poslt) -# date <- as.Date(poslt) - -# expect_that(second(update(poslt, seconds = c(1, 2))), -# throws_error()) -# expect_that(second(update(posct, seconds = c(1, 2))), -# throws_error()) -# expect_that(day(update(date, days = c(1, 2))), -# throws_error()) -# }) - test_that("update handles single vector of inputs",{ poslt <- as.POSIXlt("2010-03-14 01:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") @@ -397,20 +383,6 @@ test_that("update handles conformable vectors of inputs",{ c(1,2,3,4))), equals(c(1,2,1,2))) }) -# test_that("update handles gives error for non-conformable vectors of inputs",{ -# poslt <- as.POSIXlt("2010-03-10 01:59:59", tz = "UTC", format -# = "%Y-%m-%d %H:%M:%S") -# posct <- as.POSIXct(poslt) -# date <- as.Date(poslt) - -# expect_that(second(update(poslt, seconds = c(1,2), minutes = -# c(1,2,3))), throws_error()) -# expect_that(second(update(posct, seconds = c(1,2), minutes = -# c(1,2,3))), throws_error()) -# expect_that(day(update(date, days = c(1,2), months = -# c(1,2,3))), throws_error()) -# }) - test_that("update.POSIXct returns input of length zero when given input of length zero",{ x <- structure(vector(mode = "numeric"), class = c("POSIXct", "POSIXt")) @@ -421,4 +393,17 @@ test_that("update.POSIXlt returns input of length zero when given input of lengt x <- as.POSIXlt(structure(vector(mode = "numeric"), class = c("POSIXct", "POSIXt"))) expect_equal(update(x, days = 1), x) -}) \ No newline at end of file +}) + +test_that("update correctly handles 60 seconds on 59 minute (bug #313)", { + expect_equal(ymd_hms("2015-01-01 00:59:00") + seconds(60), + ymd_hms("2015-01-01 01:00:00")) + expect_equal(ymd_hms("2015-01-01 01:59:00") + seconds(60), + ymd_hms("2015-01-01 02:00:00")) + expect_equal(ymd_hms("2015-01-01 23:59:00") + seconds(60), + ymd_hms("2015-01-02 00:00:00")) + expect_equal(ymd_hms("2015-01-01 00:59:05") + seconds(55), + ymd_hms("2015-01-01 01:00:00")) + expect_equal(ymd_hms("2015-01-01 00:59:59") + seconds(1), + ymd_hms("2015-01-01 01:00:00")) +})