[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

@@ -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, ...){ 

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)
-})
+})
+
+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"))
+})

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)
-})
+})
+
+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"))
+})