# unit tests for the following 'xts' methods: # rbind # cbind # info_msg <- "test.rbind_zero_length_non_zero_length_POSIXct_errors" xpz <- xts( , as.POSIXct("2017-01-01")) xp1 <- xts(1, as.POSIXct("2017-01-02")) zpz <- as.zoo(xpz) zp1 <- as.zoo(xp1) zpe <- tryCatch(rbind(zpz, zp1), error = identity) xpe <- tryCatch(rbind(xpz, xp1), error = identity) expect_identical(zpe$message, xpe$message, info = info_msg) info_msg <- "test.rbind_zero_length_non_zero_length_Date_errors" xpz <- xts( , as.Date("2017-01-01")) xp1 <- xts(1, as.Date("2017-01-02")) zpz <- as.zoo(xpz) zp1 <- as.zoo(xp1) zpe <- tryCatch(rbind(zpz, zp1), error = identity) xpe <- tryCatch(rbind(xpz, xp1), error = identity) expect_identical(zpe$message, xpe$message, info = info_msg) info_msg <- "test.rbind_no_dim_does_not_error" d <- rep(0.1, 2) i <- rep(581910048, 2) xts_no_dim <- structure(d[1], class = c("xts", "zoo"), index = structure(i[1], tzone = "UTC", tclass = "Date")) xts_out <- structure(d, class = c("xts", "zoo"), .Dim = 2:1, index = structure(i, tzone = "UTC", tclass = "Date")) xts_rbind <- rbind(xts_no_dim, xts_no_dim) expect_identical(xts_out, xts_rbind, info = info_msg) # Test that as.Date.numeric() works at the top level (via zoo::as.Date()), # and for functions defined in the xts namespace even if xts::as.Date.numeric() # is not formally registered as an S3 method. info_msg <- "test.as.Date.numeric" # Define function that calls as.Date.numeric() ... f <- function(d) { as.Date(d) } # ... in xts' namespace environment(f) <- as.environment("package:xts") dd <- as.Date("2017-12-13") dn <- unclass(dd) expect_identical(dd, as.Date(dn), info = info_msg) # via zoo::as.Date() expect_identical(dd, f(dn), info = info_msg) # .subset.xts # window.xts # .toPOSIXct (indirectly) info_msg <- "test.window" # window function for xts series, use basic logic for testing & debugging # null start and end not supported window_dbg <- function(x, index. = index(x), start, end) { start <- xts:::.toPOSIXct(start, tzone(x)) end <- xts:::.toPOSIXct(end, tzone(x)) index. <- as.POSIXct(index., tz=tzone(x)) all.indexes <- .index(x) in.index <- all.indexes %in% as.numeric(index.) matches <- (in.index & all.indexes >= start & all.indexes <= end) x[matches,] } DAY = 24*3600 base <- as.POSIXct("2000-12-31") dts <- base + c(1:10, 12:15, 17:20)*DAY x <- xts(1:length(dts), dts) # Range over gap start <- base + 11*DAY end <- base + 16*DAY bin <- window(x, start = start, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- range over gap")) # Range over one day start <- base + 12*DAY end <- base + 12*DAY bin <- window(x, start = start, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- range over one day")) # Empty Range over one day start <- base + 11*DAY end <- base + 11*DAY bin <- window(x, start = start, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- empty Range over one day")) # Range containing all dates start <- base end <- base + 21*DAY bin <- window(x, start = start, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- range containing all dates")) # Range past end start <- base + 16*DAY end <- base + 30*DAY bin <- window(x, start = start, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- range past end")) # Range before begin start <- base end <- base + 3*DAY bin <- window(x, start = start, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- range before begin")) # Test just start, end = NULL start <- base + 13 * DAY end <- base + 30*DAY bin <- window(x, start = start) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just start, end = NULL")) # Test just start, end = NULL, empty range start <- base + 25 * DAY end <- base + 30*DAY bin <- window(x, start = start) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just start, end = NULL, empty range")) # Test just end, start = NULL end <- base + 13 * DAY start <- base bin <- window(x, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just end, start = NULL")) # Test just end, start = NULL, empty range end <- base start <- base bin <- window(x, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just end, start = NULL, empty range")) # Test end = NULL, start = NULL start <- base end <- base + 30*DAY bin <- window(x) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- end = NULL, start = NULL")) # Test just start, end = NA start <- base + 13 * DAY end <- base + 30*DAY bin <- window(x, start = start, end = NA) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just start, end = NA")) # Test just start, end = NA, empty range start <- base + 25 * DAY end <- base + 30*DAY bin <- window(x, start = start, end = NA) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just start, end = NA, empty range")) # Test just end, start = NA end <- base + 13 * DAY start <- base bin <- window(x, start = NA, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just end, start = NA")) # Test just end, start = NA, empty range end <- base start <- base bin <- window(x, start = NA, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just end, start = NA, empty range")) # Test end = NA, start = NA start <- base end <- base + 30*DAY bin <- window(x, start = NA, end = NA) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- end = NA, start = NA")) ####################################### # Test for index. parameter start <- base end <- base + 30*DAY idx = index(x)[c(2,4,6)] bin <- window(x, index. = idx) reg <- window_dbg(x, index. = idx, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- index. parameter provided")) # Test index. outside range of dates in xts series start <- base end <- base + 30*DAY idx = c(start, index(x)[c(2,4,6)], end) bin <- window(x, index. = idx) reg <- window_dbg(x, index. = idx, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- index. outside range of dates in xts series")) # Test NA in index start <- base end <- base + 30*DAY idx = c(start, index(x)[c(2,4,6)], end, NA) bin <- window(x, index. = idx) reg <- window_dbg(x, index. = idx, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- NA in index ")) # Next 3 adapted from window.zoo example # Test basic window.zoo example x.date <- as.Date(paste(2003, rep(1:4, 4:1), seq(1,19,2), sep = "-")) x <- xts(matrix(1:20, ncol = 2), x.date) bin <- window(x, start = as.Date("2003-02-01"), end = as.Date("2003-03-01")) reg <- window_dbg(x, start = as.Date("2003-02-01"), end = as.Date("2003-03-01")) expect_identical(bin, reg, info = paste(info_msg, "- basic window.zoo example")) # Test index + start bin <- window(x, index. = x.date[1:6], start = as.Date("2003-02-01")) reg <- window_dbg(x, index. = x.date[1:6], start = as.Date("2003-02-01"), end = as.Date("2004-01-01")) expect_identical(bin, reg, info = paste(info_msg, "- index + start")) # Test just index bin <- window(x, index. = x.date[c(4, 8, 10)]) reg <- window_dbg(x, index. = x.date[c(4, 8, 10)], start = as.Date("2003-01-01"), end = as.Date("2004-01-01")) expect_identical(bin, reg, info = paste(info_msg, "- just index")) # Test decreasing index bin <- window(x, index. = x.date[c(10, 8, 4)]) reg <- window_dbg(x, index. = x.date[c(10, 8, 4)], start = as.Date("2003-01-01"), end = as.Date("2004-01-01")) expect_identical(bin, reg, info = paste(info_msg, "- decreasing index")) # Test index parameter with repeated dates in xts series idx <- sort(rep(1:5, 5)) x <- xts(1:length(idx), as.Date("1999-12-31")+idx) bin <- window(x, index. = as.Date("1999-12-31")+c(1,3,5)) reg <- window_dbg(x, index. = as.Date("1999-12-31")+c(1,3,5), start = as.Date("2000-01-01"), end = as.Date("2000-01-05")) expect_identical(bin, reg, info = paste(info_msg, "- index parameter with repeated dates in xts series")) expect_true(nrow(bin) == 3*5, info = paste(info_msg, "- index parameter with repeated dates in xts series")) # Test performance difference DAY = 24*3600 base <- as.POSIXct("2000-12-31") dts <- base + c(1:10, 12:15, 17:20)*DAY x <- xts(1:length(dts), dts) start <- base + 14*DAY end <- base + 14*DAY #cat("\n") #print("performance:") #print("binary search") #print(system.time(replicate(1000, window(x, start = start, end = end)))) # Binary search is about 2x faster than regular #print("regular search") #print(system.time(replicate(1000, window_dbg(x, start = start, end = end)))) # test subset.xts for date subsetting by row info_msg <- "test.subset_i_datetime_or_character" base <- as.POSIXct("2000-12-31") dts <- base + c(1:10, 12:15, 17:20) * 24L * 3600L x <- xts(seq_along(dts), dts) # Note that "2001-01-11" is not in the series. Skipped by convention. d <- c("2001-01-10", "2001-01-11", "2001-01-12", "2001-01-13") for (type in c("double", "integer")) { storage.mode(.index(x)) <- type # Test scalar msg <- paste0(info_msg, " scalar, ", type, " index") bin <- window(x, start = d[1], end = d[1]) expect_identical(bin, x[d[1], ], info = paste("character", msg)) expect_identical(bin, x[I(d[1]), ], info = paste("as-is character", msg)) expect_identical(bin, x[as.POSIXct(d[1]), ], info = paste("POSIXct", msg)) expect_identical(bin, x[as.Date(d[1]), ], info = paste("Date", msg)) # Test vector msg <- paste0(info_msg, " vector, ", type, " index") bin <- window(x, start = d[1], end = d[length(d)]) expect_identical(bin, x[d, ], info = paste("character", msg)) expect_identical(bin, x[I(d), ], info = paste("as-is character", msg)) expect_identical(bin, x[as.POSIXct(d), ], info = paste("POSIXct", msg)) expect_identical(bin, x[as.Date(d), ], info = paste("Date", msg)) # Test character dates, and single column selection y <- xts(rep(2, length(dts)), dts) z <- xts(rep(3, length(dts)), dts) x2 <- cbind(y, x, z) sub <- x2[d, 2] # Note that "2001-01-11" is not in the series. Skipped by convention. bin <- window(x, start = d[1], end = d[length(d)]) expect_equal(nrow(sub), nrow(bin), info = paste(info_msg, "- character dates, and single column selection")) expect_true(all(sub == bin), info = paste(info_msg, "- character dates, and single column selection")) } info_msg <- "test.subset_i_ISO8601" x <- xts(1:1000, as.Date("2000-01-01")+1:1000) for (type in c("double", "integer")) { storage.mode(.index(x)) <- type # Test Date Ranges sub <- x['200001'] # January 2000 bin <- window(x, start = "2000-01-01", end = "2000-01-31") expect_identical(bin, sub, info = paste(info_msg, ", i = 2000-01")) # Test Date Ranges 2 sub <- x['1999/2000'] # All of 2000 (note there is no need to use the exact start) bin <- window(x, start = "2000-01-01", end = "2000-12-31") expect_identical(bin, sub, info = paste(info_msg, ", i = 1999/2000")) # Test Date Ranges 3 sub <- x['1999/200001'] # January 2000 bin <- window(x, start = "2000-01-01", end = "2000-01-31") expect_identical(bin, sub, info = paste(info_msg, ", i= 1999/2000-01")) }