Skip to content

Commit

Permalink
Correct time of day subsetting when using hours.
Browse files Browse the repository at this point in the history
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 joshuaulrich#326
  • Loading branch information
cjm authored and joshuaulrich committed Sep 7, 2020
1 parent 209151d commit 1292363
Show file tree
Hide file tree
Showing 2 changed files with 65 additions and 13 deletions.
37 changes: 29 additions & 8 deletions R/xts.methods.R
Expand Up @@ -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
Expand Down
41 changes: 36 additions & 5 deletions inst/unitTests/runit.subset.R
Expand Up @@ -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() {
Expand Down

0 comments on commit 1292363

Please sign in to comment.