From 1292363ad09e79a7f36a5f3d8ee8c397ede2aa5d Mon Sep 17 00:00:00 2001
From: cjm <claymorejmarshall@gmail.com>
Date: Wed, 19 Feb 2020 23:05:38 +1100
Subject: [PATCH] Correct time of day subsetting when using hours.

e.g.  subsetting with "T01/T03" does not currently give expected
results.

This requires fixing .subsetTimeOfDay()

Unit tests also updated for time of day subsetting.

Fixes #326
---
 R/xts.methods.R               | 37 ++++++++++++++++++++++++-------
 inst/unitTests/runit.subset.R | 41 ++++++++++++++++++++++++++++++-----
 2 files changed, 65 insertions(+), 13 deletions(-)

diff --git a/R/xts.methods.R b/R/xts.methods.R
index 2c568408..6ab4bba5 100644
--- a/R/xts.methods.R
+++ b/R/xts.methods.R
@@ -20,19 +20,40 @@
 #   along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 .subsetTimeOfDay <- function(x, fromTimeString, toTimeString) {
+  validateTimestring <- function(time) {
+    if (isFALSE(grepl(paste0("^(([0-9]{1,2}|",
+                             "[0-9]{1,2}:[0-9]{1,2})$)|",
+                             "([0-9]{1,2}:[0-9]{1,2}:[0-9]{1,2}($|?(.[0-9]+)))"),
+                      time)))
+      stop("Supply time-of-day subsetting in the format of T%H:%M:%OS/T%H:%M:%OS")
+  }
+  padTimestring <- function(time) {
+    ifelse(grepl("^[0-9]{1,2}$", time), paste0(time, ":00"), time)
+  }
   timestringToSeconds <- function(timeString) {
-    # "09:00:00" to seconds of day
-    origin <- paste("1970-01-01", timeString)
-    as.numeric(as.POSIXct(origin, "UTC")) %% 86400L
+    validateTimestring(timeString)
+    tstring <- paste("1970-01-01", padTimestring(timeString))
+    as.numeric(as.POSIXct(tstring, "UTC")) %% 86400L
+  }
+  roundupTimestring <- function(timestring) {
+    ts <- unlist(strsplit(timestring, ":|\\."))
+    n_ts <- length(ts)
+    if (n_ts == 4) ts[4] <- paste0(".", ts[4])
+    ts <- as.numeric(ts)
+    names(ts) <- c("hour", "min", "sec", "subsec")[1:n_ts]
+    ts <- c(ts, list(tz = "UTC"))
+    do.call(lastof, as.list(ts))
+  }
+  timestringToSecondsRoundUp <- function(timeString) {
+    validateTimestring(timeString)
+    tstamp <- roundupTimestring(timeString)
+    as.numeric(tstamp) %% 86400L
   }
-
-  # handle timezone
   tz <- tzone(x)
   secOfDay <- as.POSIXlt(index(x), tz = tz)
-  secOfDay <- secOfDay$hour*60*60 + secOfDay$min*60 + secOfDay$sec
-
+  secOfDay <- secOfDay$hour * 60 * 60 + secOfDay$min * 60 + secOfDay$sec
   secBegin <- timestringToSeconds(fromTimeString)
-  secEnd   <- timestringToSeconds(toTimeString)
+  secEnd   <- timestringToSecondsRoundUp(toTimeString)
 
   if (secBegin <= secEnd) {
     i <- secOfDay >= secBegin & secOfDay <= secEnd
diff --git a/inst/unitTests/runit.subset.R b/inst/unitTests/runit.subset.R
index de112513..31466e09 100644
--- a/inst/unitTests/runit.subset.R
+++ b/inst/unitTests/runit.subset.R
@@ -310,12 +310,43 @@ test.time_of_day_when_DST_ends <- function() {
   checkIdentical(.index(x["T01:00:00/T03:00:00"]), i)
 }
 
-test.time_of_day_start_equals_end <- function() {
-  i <- 0:47
-  x <- .xts(i, i * 3600, tz = "UTC")
-  i1 <- .index(x[c(2L, 26L)])
 
-  checkIdentical(.index(x["T01:00/T01:00"]), i1)
+test.time_of_day_by_hour_start_equals_end <- function() {
+  i <- 0:94
+  x <- .xts(i, i * 1800, tz = "UTC")
+  i1 <- .index(x[c(3, 4, 51, 52)])
+  
+  checkIdentical(.index(x["T01/T01"]), i1)
+  checkIdentical(.index(x["T1/T1"]), i1)
+}
+
+test.time_of_day_by_minute <- function() {
+  i <- 0:189
+  x <- .xts(i, i * 900, tz = "UTC")
+  i1 <- .index(x[c(5:8, 101:104)])
+
+  checkIdentical(.index(x["T01:00/T01:45"]), i1)
+  checkIdentical(.index(x["T01/T01:45"]), i1)
+}
+
+test.time_of_day_check_time_string <- function() {
+  i <- 0:10
+  x <- .xts(i, i * 1800, tz = "UTC")
+  # Should supply with colon separator:
+  checkException(x["T0100/T0115"])
+}
+
+test.time_of_day_by_second <- function() {
+  i <- 0:500
+  x <- .xts(c(i, i), c(i * 15, 86400 + i * 15), tz = "UTC")
+  i1 <- .index(x[c(474L, 475L, 476L, 477L, 478L, 479L, 480L, 481L, 482L, 483L, 
+                   484L, 485L, 975L, 976L, 977L, 978L, 979L, 980L, 981L, 982L, 
+                   983L, 984L, 985L, 986L)])
+
+  checkIdentical(.index(x["T01:58:05/T02:01:09"]), i1)
+  # Can omit 0 padding, as is possible by default with as.POSIXct():
+  checkIdentical(.index(x["T01:58:5/T02:1:9"]), i1)  
+  checkIdentical(.index(x["T01:58:05.000/T02:01:09.000"]), i1)
 }
 
 test.time_of_day_end_before_start <- function() {