From 06d468d2a5d8bf2f904c45ba180fac09fed3ff32 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Tue, 24 Jul 2018 14:15:27 -0700 Subject: [PATCH 1/4] Add subsecond interval support to date_breaks() and full_seq() Closes #85 --- NEWS.md | 2 ++ R/full-seq.r | 9 ++++++++- R/trans-date.r | 2 +- tests/testthat/test-trans-date.r | 22 ++++++++++++++++++++++ 4 files changed, 33 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 760f7acc..af0dc98d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # scales 0.5.0.9000 +* `date_breaks()` now supports subsecond intervals (@dpseidel, #85). + * New functions `byte_format()` and `bytes()` format numeric vectors into byte measurements (@hrbrmstr, @dpseidel). diff --git a/R/full-seq.r b/R/full-seq.r index 3be1228b..3303decf 100644 --- a/R/full-seq.r +++ b/R/full-seq.r @@ -33,5 +33,12 @@ fullseq.Date <- function(range, size, ...) { } #' @export fullseq.POSIXt <- function(range, size, ...) { - seq(floor_time(range[1], size), ceiling_time(range[2], size), by = size) + + # for subsecond interval support + parsed <- parse_unit_spec(size) + if (parsed$unit == "sec") { + seq(floor_time(range[1], size), ceiling_time(range[2], size), by = parsed$mult) + } else { + seq(floor_time(range[1], size), ceiling_time(range[2], size), by = size) + } } diff --git a/R/trans-date.r b/R/trans-date.r index 25fba9a1..fe211a05 100644 --- a/R/trans-date.r +++ b/R/trans-date.r @@ -107,7 +107,7 @@ time_breaks <- function(n = 5) { #' #' @param width an interval specification, one of "sec", "min", "hour", #' "day", "week", "month", "year". Can be by an integer and a space, or -#' followed by "s". +#' followed by "s". Fractional seconds are supported. #' @export date_breaks <- function(width = "1 month") { force(width) diff --git a/tests/testthat/test-trans-date.r b/tests/testthat/test-trans-date.r index 3b1f9d7e..de84586f 100644 --- a/tests/testthat/test-trans-date.r +++ b/tests/testthat/test-trans-date.r @@ -40,3 +40,25 @@ test_that("tz arugment overrules default time zone", { expect_equal(tz(x), "GMT") expect_equal(tz2(x), "GMT") }) + +test_that("date_breaks() works", { + times <- c(a_time, a_time + 60, a_time + 3600) + + expect_equal( + date_breaks("1 hour")(times), + as.POSIXct(c("2012-01-01 03:00:00 UTC", "2012-01-01 04:00:00 UTC")) + ) + expect_equal( + date_breaks(".5 secs")(c(a_time, a_time + 1)), + as.POSIXct(c( + "2012-01-01 03:30:00.0 UTC", "2012-01-01 03:30:00.5 UTC", + "2012-01-01 03:30:01.0 UTC", "2012-01-01 03:30:01.5 UTC" + )) + ) + + dates <- a_date + 1:30 + expect_equal( + date_breaks("1 month")(dates), + as.Date(c("2012-01-01", "2012-02-01")) + ) +}) From 7b73efbef3efa2a11dc8575bbbb86a4b0c87575f Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Tue, 24 Jul 2018 15:10:57 -0700 Subject: [PATCH 2/4] Fix tz mismatch for sec and min intervals. Fix tests. --- R/date-time.r | 4 +++- tests/testthat/test-trans-date.r | 11 ++++------- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/R/date-time.r b/R/date-time.r index 7190c78e..5d92000a 100644 --- a/R/date-time.r +++ b/R/date-time.r @@ -13,10 +13,12 @@ floor_date <- function(date, time) { as.Date(cut(date, time, right = TRUE, include.lowest = TRUE)) } } + floor_time <- function(date, time) { to_time <- function(x) { force(x) - structure(x, class = c("POSIXt", "POSIXct")) + structure(x, class = c("POSIXt", "POSIXct"), + tzone = attr(date, "tzone", exact = TRUE) %||% "") } prec <- parse_unit_spec(time) diff --git a/tests/testthat/test-trans-date.r b/tests/testthat/test-trans-date.r index de84586f..08b46e19 100644 --- a/tests/testthat/test-trans-date.r +++ b/tests/testthat/test-trans-date.r @@ -42,18 +42,15 @@ test_that("tz arugment overrules default time zone", { }) test_that("date_breaks() works", { - times <- c(a_time, a_time + 60, a_time + 3600) + times <- as.POSIXct(c("2000-01-01 08:29:58", "2000-01-01 08:30:10"), tz = "UTC") expect_equal( date_breaks("1 hour")(times), - as.POSIXct(c("2012-01-01 03:00:00 UTC", "2012-01-01 04:00:00 UTC")) + as.POSIXct(c("2000-01-01 8:00:00 UTC", "2000-01-01 9:00:00 UTC"), tz = "UTC") ) expect_equal( - date_breaks(".5 secs")(c(a_time, a_time + 1)), - as.POSIXct(c( - "2012-01-01 03:30:00.0 UTC", "2012-01-01 03:30:00.5 UTC", - "2012-01-01 03:30:01.0 UTC", "2012-01-01 03:30:01.5 UTC" - )) + date_breaks(".5 secs")(times)[1:2], + as.POSIXct(c("2000-01-01 08:29:58.0 UTC", "2000-01-01 08:29:58.5 UTC"), tz = "UTC") ) dates <- a_date + 1:30 From ba54b00359be0cfef119d80be54dc99fdbf952ae Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Tue, 24 Jul 2018 16:40:56 -0700 Subject: [PATCH 3/4] Fix structure() code style --- R/date-time.r | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/date-time.r b/R/date-time.r index 5d92000a..d08731aa 100644 --- a/R/date-time.r +++ b/R/date-time.r @@ -17,8 +17,10 @@ floor_date <- function(date, time) { floor_time <- function(date, time) { to_time <- function(x) { force(x) - structure(x, class = c("POSIXt", "POSIXct"), - tzone = attr(date, "tzone", exact = TRUE) %||% "") + structure(x, + class = c("POSIXt", "POSIXct"), + tzone = attr(date, "tzone", exact = TRUE) %||% "" + ) } prec <- parse_unit_spec(time) From 7570ceee5e11ada9cef0ee8121b2f1fa02d431bc Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Wed, 25 Jul 2018 09:39:02 -0700 Subject: [PATCH 4/4] Add clarifying comment about seq --- R/full-seq.r | 1 + 1 file changed, 1 insertion(+) diff --git a/R/full-seq.r b/R/full-seq.r index 3303decf..45d21bab 100644 --- a/R/full-seq.r +++ b/R/full-seq.r @@ -35,6 +35,7 @@ fullseq.Date <- function(range, size, ...) { fullseq.POSIXt <- function(range, size, ...) { # for subsecond interval support + # seq() does not support partial secs in character strings parsed <- parse_unit_spec(size) if (parsed$unit == "sec") { seq(floor_time(range[1], size), ceiling_time(range[2], size), by = parsed$mult)