From 008155472db01d1f437fbfc7b1072978c23265cf Mon Sep 17 00:00:00 2001 From: Joshua Ulrich Date: Sat, 11 May 2019 10:55:13 -0500 Subject: [PATCH] Handle index class attribute in .xts() Check for .indexCLASS and tclass passed to the constructor via '...'. Warn that .indexCLASS is deprecated, but still use it. We will raise this to an error in a later version. Also warn if the tclass attribute on the index is not the same as the tclass argument default value ("POSIXct", "POSIXt"). Current behavior over-rides the index tclass attribute with the default argument value. This seems like a bug, but it may break existing code, so warn before changing or converting to an error. Remove these two elements from '...' before attaching the remaining elements to the result (as user attributes). Remove the indexClass() call from the checkXtsClass() test function, since indexClass() is deprecated. See #245. --- R/xts.R | 22 ++++++++++++++++------ inst/unitTests/runit.xts.R | 33 ++++++++++++++++++++++++++------- 2 files changed, 42 insertions(+), 13 deletions(-) diff --git a/R/xts.R b/R/xts.R index 546dd2c2..d5172d08 100644 --- a/R/xts.R +++ b/R/xts.R @@ -158,6 +158,20 @@ function(x=NULL, index, tclass=c("POSIXct","POSIXt"), tformat <- attr(index, "tformat") } + if(hasArg(".indexCLASS")) { + warning(sQuote(".indexCLASS"), " is deprecated, use tclass instead.") + tclass <- eval.parent(ctor.call$.indexCLASS) + } else if(missing("tclass")) { + # compare tclass on the index with tclass argument because the + # tclass argument will override the index attribute, but it shouldn't... + index.class <- attr(index, 'tclass') + default.class <- c("POSIXct", "POSIXt") + if(!is.null(index.class) && !all(index.class %in% default.class)) { + warning("the index tclass attribute is ", index.class, + " but will be changed to (POSIXct, POSIXt)") + } + } + # don't overwrite index tzone if tzone arg is missing if(missing(tzone)) { if(!is.null(index.tz <- attr(index,'tzone'))) @@ -166,12 +180,6 @@ function(x=NULL, index, tclass=c("POSIXct","POSIXt"), # xts' tzone must only contain one element (POSIXlt tzone has 3) tzone <- tzone[1L] - ## restore behaviour from v0.10-2 - if(hasArg(".indexCLASS")) { - ctor.call <- match.call(expand.dots = TRUE) - tclass <- eval.parent(ctor.call$.indexCLASS) - } - xx <- .Call("add_xtsCoreAttributes", x, index, tzone, tclass, c('xts','zoo'), tformat, PACKAGE='xts') @@ -179,6 +187,8 @@ function(x=NULL, index, tclass=c("POSIXct","POSIXt"), dots.names <- eval(substitute(alist(...))) dots.names$.indexFORMAT <- NULL dots.names$tformat <- NULL + dots.names$.indexCLASS <- NULL + dots.names$tclass <- NULL # set any user attributes if(length(dots.names)) attributes(xx) <- c(attributes(xx), list(...)) diff --git a/inst/unitTests/runit.xts.R b/inst/unitTests/runit.xts.R index 5e0c5c0c..0d50b4bf 100644 --- a/inst/unitTests/runit.xts.R +++ b/inst/unitTests/runit.xts.R @@ -83,6 +83,7 @@ test.xts_ctor_warns_for_indexCLASS_arg <- function() { op <- options(warn = 2) on.exit(options(warn = op$warn)) checkException(x <- xts(1, as.Date("2018-05-02"), .indexCLASS = "Date")) + checkException(x <- .xts(1, as.Date("2018-05-02"), .indexCLASS = "Date")) } test.xts_ctor_warns_for_indexTZ_arg <- function() { @@ -105,6 +106,23 @@ test..xts_dimnames_in_dots <- function() { checkEquals(x, y) } +test..xts_ctor_warns_if_index_tclass_not_NULL_or_POSIXct <- function() { + op <- options(warn = 2) + on.exit(options(warn = op$warn)) + + idx <- 1:3 + x <- .xts(1:3, idx) # no error, NULL + idx <- .POSIXct(idx) + x <- .xts(1:3, idx) # no error, POSIXct + + idx <- structure(1:3, tclass = "Date", tzone = "UTC") + checkException(.xts(1:3, idx), msg = "tclass = Date") + idx <- structure(idx, tclass = "yearmon", tzone = "UTC") + checkException(.xts(1:3, idx), msg = "tclass = yearmon") + idx <- structure(idx, tclass = "timeDate", tzone = "UTC") + checkException(.xts(1:3, idx), msg = "tclass = timeDate") +} + checkXtsFormat <- function(xts, format) { checkIdentical(tformat(xts), format) checkIdentical(attr(attr(xts, "index"), "tformat"), format) @@ -130,22 +148,23 @@ test..xts_index_format_precedence <- function() { checkXtsClass <- function(xts, class) { checkEquals(tclass(xts), class) - checkEquals(indexClass(xts), class) checkEquals(attr(attr(xts, "index"), "tclass"), class) } -### Check that .indexCLASS takes precedence over tclass when both specified -test..xts_class <- function() { +### Check that index class attribute precedence is: +### .indexCLASS argument > tclass argument > tclass index attribute +test..xts_index_class_precedence <- function() { checkXtsClass(.xts(1, 1), c("POSIXct", "POSIXt")) checkXtsClass(.xts(1, 1, tclass="timeDate"), "timeDate") checkXtsClass(.xts(1, 1, .indexCLASS="Date"), "Date") checkXtsClass(.xts(1, 1, tclass="timeDate", .indexCLASS="Date"), "Date") ## also check that tclass is ignored if specified as part of index - checkXtsClass(.xts(1, structure(1, tzone="",tclass="yearmon")), c("POSIXct", "POSIXt")) - checkXtsClass(.xts(1, structure(1, tzone="",tclass="yearmon"), tclass="timeDate"), "timeDate") - checkXtsClass(.xts(1, structure(1, tzone="",tclass="yearmon"), .indexCLASS="Date"), "Date") - checkXtsClass(.xts(1, structure(1, tzone="",tclass="yearmon"), tclass="timeDate", .indexCLASS="Date"), "Date") + idx <- structure(1, tzone="",tclass="yearmon") + checkXtsClass(.xts(1, idx), c("POSIXct", "POSIXt")) + checkXtsClass(.xts(1, idx, tclass="timeDate"), "timeDate") + checkXtsClass(.xts(1, idx, .indexCLASS="Date"), "Date") + checkXtsClass(.xts(1, idx, tclass="timeDate", .indexCLASS="Date"), "Date") } checkXtsTz <- function(xts, tzone) {