test-endpoints.R
In xts: eXtensible Time Series

# index crosses the unix epoch
info_msg <- "test.double_index_cross_epoch"
x <- .xts(1:22, 1.0*(-10:11), tzone="UTC")
ep <- endpoints(x, "seconds", 2)
expect_identical(ep, 0:11*2L, info_msg)

info_msg <- "test.integer_index_cross_epoch"
x <- .xts(1:22, -10:11, tzone="UTC")
ep <- endpoints(x, "seconds", 2)
expect_identical(ep, 0:11*2L, info_msg)


#{{{daily data
data(sample_matrix)
xDailyDblIdx <- as.xts(sample_matrix, dateFormat="Date")
xDailyIntIdx <- xDailyDblIdx
storage.mode(.index(xDailyIntIdx)) <- "integer"

info_msg <- "test.days_double_index"
ep <- endpoints(xDailyDblIdx, "days", 7)
expect_identical(ep, c(0L, 1:26*7L-3L, nrow(xDailyDblIdx)), info_msg)

info_msg <- "test.days_integer_index"
ep <- endpoints(xDailyIntIdx, "days", 7)
expect_identical(ep, c(0L, 1:26*7L-3L, nrow(xDailyIntIdx)), info_msg)


info_msg <- "test.weeks_double_index"
ep <- endpoints(xDailyDblIdx, "weeks", 1)
expect_identical(ep, c(0L, 1:25*7L-1L, nrow(xDailyDblIdx)), info_msg)

info_msg <- "test.weeks_integer_index"
ep <- endpoints(xDailyIntIdx, "weeks", 1)
expect_identical(ep, c(0L, 1:25*7L-1L, nrow(xDailyIntIdx)), info_msg)


info_msg <- "test.months_double_index"
ep <- endpoints(xDailyDblIdx, "months", 1)
expect_identical(ep, c(0L, 30L, 58L, 89L, 119L, 150L, 180L), info_msg)

info_msg <- "test.months_integer_index"
ep <- endpoints(xDailyIntIdx, "months", 1)
expect_identical(ep, c(0L, 30L, 58L, 89L, 119L, 150L, 180L), info_msg)


info_msg <- "test.quarters_double_index"
ep <- endpoints(xDailyDblIdx, "quarters", 1)
expect_identical(ep, c(0L, 89L, 180L), info_msg)

info_msg <- "test.quarters_integer_index"
ep <- endpoints(xDailyIntIdx, "quarters", 1)
expect_identical(ep, c(0L, 89L, 180L), info_msg)


info_msg <- "test.years_double_index"
d <- seq(as.Date("1970-01-01"), by="1 day", length.out=365*5)
x <- xts(seq_along(d), d)
ep <- endpoints(x, "years", 1)
expect_identical(ep, c(0L, 365L, 730L, 1096L, 1461L, 1825L), info_msg)

info_msg <- "test.years_integer_index"
d <- seq(as.Date("1970-01-01"), by="1 day", length.out=365*5)
x <- xts(seq_along(d), d)
storage.mode(.index(x)) <- "integer"
ep <- endpoints(x, "years", 1)
expect_identical(ep, c(0L, 365L, 730L, 1096L, 1461L, 1825L), info_msg)

#}}}

#{{{second data
n <- 86400L %/% 30L * 365L * 2L
xSecIntIdx <- .xts(1L:n,
    seq(.POSIXct(0, tz="UTC"), by="30 sec", length.out=n), tzone="UTC")
xSecDblIdx <- xSecIntIdx 
storage.mode(.index(xSecDblIdx)) <- "double"

info_msg <- "test.seconds_double_index"
ep <- endpoints(xSecDblIdx, "seconds", 3600)
expect_identical(ep, seq(0L, nrow(xSecDblIdx), 120L), info_msg)

info_msg <- "test.seconds_integer_index"
ep <- endpoints(xSecIntIdx, "seconds", 3600)
expect_identical(ep, seq(0L, nrow(xSecIntIdx), 120L), info_msg)

info_msg <- "test.seconds_secs"
x <- .xts(1:10, 1:10/6)
ep1 <- endpoints(x, "seconds")
ep2 <- endpoints(x, "secs")
expect_identical(ep1, ep2, info_msg)


info_msg <- "test.minutes_double_index"
ep <- endpoints(xSecDblIdx, "minutes", 60)
expect_identical(ep, seq(0L, nrow(xSecDblIdx), 120L), info_msg)

info_msg <- "test.minutes_integer_index"
ep <- endpoints(xSecIntIdx, "minutes", 60)
expect_identical(ep, seq(0L, nrow(xSecIntIdx), 120L), info_msg)

info_msg <- "test.minutes_mins"
x <- .xts(1:10, 1:10*10)
ep1 <- endpoints(x, "minutes")
ep2 <- endpoints(x, "mins")
expect_identical(ep1, ep2, info_msg)


info_msg <- "test.hours_double_index"
ep <- endpoints(xSecDblIdx, "hours", 1)
expect_identical(ep, seq(0L, nrow(xSecDblIdx), 120L), info_msg)

info_msg <- "test.hours_integer_index"
ep <- endpoints(xSecIntIdx, "hours", 1)
expect_identical(ep, seq(0L, nrow(xSecIntIdx), 120L), info_msg)


info_msg <- "test.days_double_index"
ep <- endpoints(xSecDblIdx, "days", 1)
expect_identical(ep, seq(0L, by=2880L, length.out=length(ep)), info_msg)

info_msg <- "test.days_integer_index"
ep <- endpoints(xSecIntIdx, "days", 1)
expect_identical(ep, seq(0L, by=2880L, length.out=length(ep)), info_msg)


info_msg <- "test.weeks_double_index"
ep <- endpoints(xSecDblIdx, "weeks", 1)
ep2 <- c(0L, seq(11520L, nrow(xSecDblIdx)-1L, 20160L), nrow(xSecDblIdx))
expect_identical(ep, ep2, info_msg)

info_msg <- "test.weeks_integer_index"
ep <- endpoints(xSecIntIdx, "weeks", 1)
ep2 <- c(0L, seq(11520L, nrow(xSecIntIdx)-1L, 20160L), nrow(xSecIntIdx))
expect_identical(ep, ep2, info_msg)


info_msg <- "test.months_double_index"
ep <- endpoints(xSecDblIdx, "months", 1)
n <- 86400L * c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) / 30
ep2 <- as.integer(cumsum(c(0L, n, n)))
expect_identical(ep, ep2, info_msg)

info_msg <- "test.months_integer_index"
ep <- endpoints(xSecIntIdx, "months", 1)
n <- 86400L * c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) / 30
ep2 <- as.integer(cumsum(c(0L, n, n)))
expect_identical(ep, ep2, info_msg)


info_msg <- "test.quarters_double_index"
ep <- endpoints(xSecDblIdx, "quarters", 1)
n <- 86400L * c(90, 91, 92, 92) / 30
ep2 <- as.integer(cumsum(c(0L, n, n)))
expect_identical(ep, ep2, info_msg)

info_msg <- "test.quarters_integer_index"
ep <- endpoints(xSecIntIdx, "quarters", 1)
n <- 86400L * c(90, 91, 92, 92) / 30
ep2 <- as.integer(cumsum(c(0L, n, n)))
expect_identical(ep, ep2, info_msg)


info_msg <- "test.years_double_index"
ep <- endpoints(xSecDblIdx, "years", 1)
expect_identical(ep, c(0L, 1051200L, 2102400L), info_msg)

info_msg <- "test.years_integer_index"
ep <- endpoints(xSecIntIdx, "years", 1)
expect_identical(ep, c(0L, 1051200L, 2102400L), info_msg)

#}}}

# sparse endpoints could be a problem with POSIXlt elements (#169)
# TODO: sparse intraday endpoints
info_msg <- "test.sparse_years"
x <- xts(2:6, as.Date(sprintf("199%d-06-01", 2:6)))
ep <- endpoints(x, "years")
expect_identical(ep, 0:5, info_msg)

info_msg <- "test.sparse_quarters"
x <- xts(2:6, as.Date(sprintf("199%d-06-01", 2:6)))
ep <- endpoints(x, "quarters")
expect_identical(ep, 0:5, info_msg)

info_msg <- "test.sparse_months"
x <- xts(2:6, as.Date(sprintf("199%d-06-01", 2:6)))
ep <- endpoints(x, "months")
expect_identical(ep, 0:5, info_msg)

info_msg <- "test.sparse_weeks"
x <- xts(2:6, as.Date(sprintf("199%d-06-01", 2:6)))
ep <- endpoints(x, "weeks")
expect_identical(ep, 0:5, info_msg)

info_msg <- "test.sparse_days"
x <- xts(2:6, as.Date(sprintf("199%d-06-01", 2:6)))
ep <- endpoints(x, "days")
expect_identical(ep, 0:5, info_msg)


# sub-second resolution on Windows
info_msg <- "test.sub_second_resolution"
x <- .xts(1:6, .POSIXct(0:5 / 10 + 0.01))
ep <- endpoints(x, "ms", 250)
expect_identical(ep, c(0L, 3L, 5L, 6L), info_msg)


# precision issues
info_msg <- "test.sub_second_resolution_exact"
x <- .xts(1:6, .POSIXct(0:5 / 10))
ep <- endpoints(x, "ms", 250)
expect_identical(ep, c(0L, 3L, 5L, 6L), info_msg)

info_msg <- "test.sub_second_resolution_representation"
x <- .xts(1:10, .POSIXct(1.5e9 + 0:9 / 10))
ep <- endpoints(x, "ms", 200)
expect_identical(ep, seq(0L, 10L, 2L), info_msg)


# on = "quarters", k > 1
info_msg <- "test.multiple_quarters"
x <- xts(1:48, as.yearmon("2015-01-01") + 0:47 / 12)
expect_identical(endpoints(x, "quarters", 1), seq(0L, 48L, 3L), info_msg)
expect_identical(endpoints(x, "quarters", 2), seq(0L, 48L, 6L), info_msg)
expect_identical(endpoints(x, "quarters", 3), c(seq(0L, 48L, 9L), 48L), info_msg)
expect_identical(endpoints(x, "quarters", 4), seq(0L, 48L,12L), info_msg)
expect_identical(endpoints(x, "quarters", 5), c(seq(0L, 48L,15L), 48L), info_msg)
expect_identical(endpoints(x, "quarters", 6), c(seq(0L, 48L,18L), 48L), info_msg)


# end(x) always in endpoints(x) result
info_msg <- "test.last_obs_always_in_output"
N <- 341*12
xx <- xts(rnorm(N), seq(Sys.Date(), by = "day", length.out = N))

ep <- endpoints(xx, on = "quarters", k = 2) # OK
expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "quarters, k=2"))

ep <- endpoints(xx, on = "quarters", k = 3) # NOPE
expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "quarters, k=3"))

ep <- endpoints(xx, on = "quarters", k = 4) # NOPE
expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "quarters, k=4"))

ep <- endpoints(xx, on = "quarters", k = 5) # NOPE
expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "quarters, k=5"))

ep <- endpoints(xx, on = "months", k = 2) # NOPE
expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "months, k=2"))

ep <- endpoints(xx, on = "months", k = 3) # OK
expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "months, k=3"))

ep <- endpoints(xx, on = "months", k = 4) # NOPE
expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "months, k=4"))

# For the "weeks" case works fine

ep <- endpoints(xx, on = "weeks", k = 2) # OK
expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "weeks, k=2"))

ep <- endpoints(xx, on = "weeks", k = 3) # OK
expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "weeks, k=3"))

ep <- endpoints(xx, on = "weeks", k = 4) # OK
expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "weeks, k=4"))


info_msg <- "test.k_less_than_1_errors"
x <- xDailyIntIdx

expect_error(endpoints(x, on = "years", k =  0), info = info_msg)
expect_error(endpoints(x, on = "years", k = -1), info = info_msg)

expect_error(endpoints(x, on = "quarters", k =  0), info = info_msg)
expect_error(endpoints(x, on = "quarters", k = -1), info = info_msg)

expect_error(endpoints(x, on = "months", k =  0), info = info_msg)
expect_error(endpoints(x, on = "months", k = -1), info = info_msg)

expect_error(endpoints(x, on = "weeks", k =  0), info = info_msg)
expect_error(endpoints(x, on = "weeks", k = -1), info = info_msg)

expect_error(endpoints(x, on = "days", k =  0), info = info_msg)
expect_error(endpoints(x, on = "days", k = -1), info = info_msg)

x <- xSecIntIdx

expect_error(endpoints(x, on = "hours", k =  0), info = info_msg)
expect_error(endpoints(x, on = "hours", k = -1), info = info_msg)

expect_error(endpoints(x, on = "minutes", k =  0), info = info_msg)
expect_error(endpoints(x, on = "minutes", k = -1), info = info_msg)

expect_error(endpoints(x, on = "seconds", k =  0), info = info_msg)
expect_error(endpoints(x, on = "seconds", k = -1), info = info_msg)

x <- .xts(1:10, sort(1 + runif(10)))

expect_error(endpoints(x, on = "ms", k =  0), info = info_msg)
expect_error(endpoints(x, on = "ms", k = -1), info = info_msg)

expect_error(endpoints(x, on = "us", k =  0), info = info_msg)
expect_error(endpoints(x, on = "us", k = -1), info = info_msg)