diff --git a/NAMESPACE b/NAMESPACE
index a03dc851..cb39e39d 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -96,6 +96,8 @@ export(CLASS)
export('CLASS<-')
export(indexFormat)
export('indexFormat<-')
+export(tformat)
+export('tformat<-')
export(indexClass)
export('indexClass<-')
@@ -175,6 +177,7 @@ export(lag.xts)
export(diff.xts)
export(merge.xts)
#export(mergeXts)
+S3method(all.equal, xts)
S3method(split, xts)
S3method(lag,xts)
S3method(diff,xts)
@@ -228,14 +231,14 @@ S3method(window,xts)
S3method(dimnames, xts)
S3method('dimnames<-', xts)
-S3method('indexClass<-',xts)
+S3method(tclass,xts)
S3method('tclass<-',xts)
-S3method('indexFormat',xts)
-S3method('indexFormat<-',xts)
+S3method(tformat,xts)
+S3method('tformat<-',xts)
-S3method(indexTZ,xts)
-S3method('indexTZ<-',xts)
+S3method(tzone, default)
+S3method('tzone<-', default)
S3method(tzone,xts)
S3method('tzone<-',xts)
diff --git a/R/Ops.xts.R b/R/Ops.xts.R
index 2227c861..cc5ecbcd 100644
--- a/R/Ops.xts.R
+++ b/R/Ops.xts.R
@@ -44,26 +44,32 @@ function(e1, e2)
}
}
if(.Generic %in% c("+","-","*","/","^","%%","%/%")) {
- if(length(e)==0)
- attr(e,'index') <- numeric(0)
#.Call('add_xts_class', e)
.Call('add_class', e, CLASS, PACKAGE="xts")
}
- else
+ if(length(e)==0) {
+ if(is.xts(e1)) {
+ idx <- .index(e1)
+ } else {
+ idx <- .index(e2)
+ }
+ idx[] <- idx[0]
+ attr(e,'index') <- idx
+ }
if(is.null(attr(e,'index'))) {
if(is.xts(e1)) {
- .xts(e, .index(e1),
- .indexCLASS=indexClass(e1),
- .indexFORMAT=indexFormat(e1),
- .indexTZ=indexTZ(e1))
+ e <- .xts(e, .index(e1))
} else {
- .xts(e, .index(e2),
- .indexCLASS=indexClass(e2),
- .indexFORMAT=indexFormat(e2),
- .indexTZ=indexTZ(e2)
- )
+ e <- .xts(e, .index(e2))
}
- } else {
- e
}
+ if(!is.null(dimnames(e)[[1L]])) {
+ if(is.null(dimnames(e)[[2L]])) {
+ attr(e, "dimnames") <- NULL
+ } else {
+ dimnames(e)[[1]] <- list(NULL)
+ }
+ }
+ attr(e, "names") <- NULL
+ e
}
diff --git a/R/align.time.R b/R/align.time.R
index dc2777d0..9b7b6688 100644
--- a/R/align.time.R
+++ b/R/align.time.R
@@ -25,7 +25,7 @@ align.time <- function(x, ...) {
align.time.xts <- function(x, n=60, ...) {
if(n <= 0) stop("'n' must be positive")
- .xts(x, .index(x) + (n-.index(x) %% n), tzone=indexTZ(x), tclass=indexClass(x))
+ .xts(x, .index(x) + (n-.index(x) %% n), tzone=tzone(x), tclass=tclass(x))
}
align.time.POSIXct <- function(x, n=60, ...) {
@@ -43,7 +43,7 @@ shift.time <- function(x, n=60, ...) {
}
shift.time.xts <- function(x, n=60, ...) {
- .xts(x, .index(x) + n, tzone=indexTZ(x), tclass=indexClass(x))
+ .xts(x, .index(x) + n, tzone=tzone(x), tclass=tclass(x))
}
is.index.unique <- is.time.unique <- function(x) {
diff --git a/R/all.equal.R b/R/all.equal.R
new file mode 100644
index 00000000..aec4c810
--- /dev/null
+++ b/R/all.equal.R
@@ -0,0 +1,34 @@
+#
+# xts: eXtensible time-series
+#
+# Copyright (C) 2019 Joshua M. Ulrich
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see .
+
+all.equal.xts <-
+function(target,
+ current,
+ ...,
+ check.attributes = TRUE)
+{
+ if (isTRUE(check.attributes)) {
+ # Remove potential index attributes on the objects
+ attrNames <- c(".indexCLASS", ".indexTZ", "tclass", "tzone")
+ for (aname in attrNames) {
+ attr(target, aname) <- NULL
+ attr(current, aname) <- NULL
+ }
+ }
+ NextMethod("all.equal")
+}
diff --git a/R/coredata.xts.R b/R/coredata.xts.R
index 88ba55b5..bba06ce4 100644
--- a/R/coredata.xts.R
+++ b/R/coredata.xts.R
@@ -23,15 +23,15 @@ coredata.xts <- function(x, fmt=FALSE, ...) {
x.attr <- attributes(x)
if(is.character(fmt)) {
- indexFormat(x) <- fmt
+ tformat(x) <- fmt
fmt <- TRUE
}
if(length(x) > 0 && fmt) {
- if(!is.null(indexFormat(x))) {
- x.attr$dimnames <- list(format(index(x), format=indexFormat(x)),
+ if(!is.null(tformat(x))) {
+ x.attr$dimnames <- list(format(index(x), format=tformat(x)),
dimnames(x)[[2]])
- indexFormat(x) <- NULL # remove before printing
+ tformat(x) <- NULL # remove before printing
} else {
x.attr$dimnames <- list(format(index(x)),dimnames(x)[[2]])
}
@@ -53,6 +53,7 @@ coredata.xts <- function(x, fmt=FALSE, ...) {
xx <- NextMethod(x)
attr(xx, ".indexCLASS") <- NULL
attr(xx, "tclass") <- NULL
+ # Remove tz attrs (object created before 0.10-3)
attr(xx, ".indexTZ") <- NULL
attr(xx, "tzone") <- NULL
return(xx)
@@ -106,7 +107,7 @@ function(x, user=NULL) {
else
if(user) {
# Only user attributes
- rm.attr <- c(rm.attr,'.CLASS','.CLASSnames','.ROWNAMES', '.indexCLASS', '.indexFORMAT','.indexTZ','tzone','tclass',
+ rm.attr <- c(rm.attr,'.CLASS','.CLASSnames','.ROWNAMES', '.indexCLASS', '.indexFORMAT','.indexTZ','tzone','tclass',
x.attr$.CLASSnames)
xa <- x.attr[!names(x.attr) %in% rm.attr]
} else {
@@ -131,9 +132,16 @@ function(x,value) {
}
} else
for(nv in names(value)) {
- if(!nv %in% c('dim','dimnames','index','class','.CLASS','.ROWNAMES','.CLASSnames',
- '.indexCLASS','.indexFORMAT','.indexTZ'))
+ if(!nv %in% c('dim','dimnames','index','class','.CLASS','.ROWNAMES','.CLASSnames'))
attr(x,nv) <- value[[nv]]
}
+ # Remove tz attrs (object created before 0.10-3)
+ attr(x, ".indexTZ") <- NULL
+ attr(x, "tzone") <- NULL
+ # Remove index class attrs (object created before 0.10-3)
+ attr(x, ".indexCLASS") <- NULL
+ attr(x, "tclass") <- NULL
+ # Remove index format attr (object created before 0.10-3)
+ attr(x, ".indexFORMAT") <- NULL
x
}
diff --git a/R/endpoints.R b/R/endpoints.R
index 00a94e98..27679c63 100644
--- a/R/endpoints.R
+++ b/R/endpoints.R
@@ -39,7 +39,7 @@ function(x,on='months',k=1) {
# posixltindex is costly in memory (9x length of time)
# make sure we really need it
if(on %in% c('years','quarters','months','weeks','days'))
- posixltindex <- as.POSIXlt(.POSIXct(.index(x)),tz=indexTZ(x))
+ posixltindex <- as.POSIXlt(.POSIXct(.index(x)),tz=tzone(x))
switch(on,
"years" = {
diff --git a/R/index.R b/R/index.R
index fdc1de23..10550d51 100644
--- a/R/index.R
+++ b/R/index.R
@@ -21,10 +21,10 @@
index.xts <- time.xts <-
function(x, ...) {
- value <- indexClass(x)
+ value <- tclass(x)
if(is.null(value))
return(.index(x))
- # if indexClass is Date, POSIXct time is set to 00:00:00 GMT. Convert here
+ # if tclass is Date, POSIXct time is set to 00:00:00 GMT. Convert here
# to avoid ugly and hard to debug TZ conversion. What will this break?
if(value[[1]] == "Date")
#return( as.Date(.index(x)/86400) )
@@ -61,7 +61,7 @@ function(x, ...) {
#Date = as.Date(as.character(x.index)), # handled above
yearmon = as.yearmon(x.index),
yearqtr = as.yearqtr(x.index),
- stop(paste('unsupported',sQuote('indexClass'),'indexing type:',value[[1]]))
+ stop(paste('unsupported',sQuote('tclass'),'indexing type:',value[[1]]))
)
}
@@ -81,13 +81,13 @@ function(x, ...) {
if(!isOrdered(.index(x), strictly=FALSE))
stop("new index needs to be sorted")
- # set the .indexCLASS/tclass attribute to the end-user specified class
- attr(x, '.indexCLASS') <- class(value)
+ # set tzone attribute
if(any(class(value) %in% .classesWithoutTZ)) {
attr(.index(x), 'tzone') <- 'UTC'
} else {
attr(.index(x), 'tzone') <- attr(value, 'tzone')
}
+ # set tclass attribute to the end-user specified class
attr(.index(x), 'tclass') <- class(value)
return(x)
}
@@ -113,36 +113,35 @@ function(x, ...) {
}
`.indexsec` <- function(x) {
- as.POSIXlt(.POSIXct(.index(x), tz=indexTZ(x)))$sec
+ as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$sec
}
`.indexmin` <- function(x) {
- as.POSIXlt(.POSIXct(.index(x), tz=indexTZ(x)))$min
+ as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$min
}
`.indexhour` <- function(x) {
- as.POSIXlt(.POSIXct(.index(x), tz=indexTZ(x)))$hour
+ as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$hour
}
`.indexmday` <- function(x) {
- as.POSIXlt(.POSIXct(.index(x), tz=indexTZ(x)))$mday
+ as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$mday
}
`.indexmon` <- function(x) {
- as.POSIXlt(.POSIXct(.index(x), tz=indexTZ(x)))$mon
+ as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$mon
}
`.indexyear` <- function(x) {
- as.POSIXlt(.POSIXct(.index(x), tz=indexTZ(x)))$year
+ as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$year
}
`.indexwday` <- function(x) {
- as.POSIXlt(.POSIXct(.index(x), tz=indexTZ(x)))$wday
+ as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$wday
}
`.indexbday` <- function(x) {
# is business day T/F
- as.POSIXlt(.POSIXct(.index(x), tz=indexTZ(x)))$wday %% 6 > 0
+ as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$wday %% 6 > 0
}
`.indexyday` <- function(x) {
- as.POSIXlt(.POSIXct(.index(x), tz=indexTZ(x)))$yday
+ as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$yday
}
`.indexisdst` <- function(x) {
- as.POSIXlt(.POSIXct(.index(x), tz=indexTZ(x)))$isdst
-}
+ as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$isdst }
`.indexDate` <- `.indexday` <- function(x) {
.index(x) %/% 86400L
}
diff --git a/R/irts.R b/R/irts.R
index a7da1394..c1bd926c 100644
--- a/R/irts.R
+++ b/R/irts.R
@@ -26,7 +26,7 @@ function(x,...) {
if(!requireNamespace('tseries', quietly=TRUE))
irts <- function(...) message("package 'tseries' is required for re.irts")
- indexClass(x) <- "POSIXct"
+ tclass(x) <- "POSIXct"
xx <- coredata(x)
# rownames(xx) <- attr(x,'irts.rownames')
tseries::irts(index(x),xx)
diff --git a/R/lag.xts.R b/R/lag.xts.R
index 3188dc52..bdb22300 100644
--- a/R/lag.xts.R
+++ b/R/lag.xts.R
@@ -99,7 +99,7 @@ diff.xts <- function(x, lag=1, differences=1, arithmetic=TRUE, log=FALSE, na.pad
stop("'differences' must be integer")
if(is.logical(x))
- x <- .xts(matrix(as.integer(x),ncol=NCOL(x)), .index(x), indexClass(x))
+ x <- .xts(matrix(as.integer(x),ncol=NCOL(x)), .index(x), tclass(x))
if(lag < 1 || differences < 1)
stop("'diff.xts' defined only for positive lag and differences arguments")
diff --git a/R/matrix.R b/R/matrix.R
index c56e2849..d6bf8ac1 100644
--- a/R/matrix.R
+++ b/R/matrix.R
@@ -36,7 +36,7 @@ function(x, ...) {
colnames(y) <- cnx
} else {
cn <- deparse(substitute(x), width.cutoff = 100, nlines = 1)
- if (ncol(x) == 1) {
+ if (NCOL(x) == 1) {
colnames(y) <- cn
} else {
colnames(y) <- paste(cn, 1:ncol(x), sep = ".")
diff --git a/R/periodicity.R b/R/periodicity.R
index e825fe04..1ce2a57b 100644
--- a/R/periodicity.R
+++ b/R/periodicity.R
@@ -115,7 +115,7 @@ function (x, ...)
if(!is.xts(x)) x <- as.xts(x)
# convert if necessary to usable format
- if(!indexClass(x)[[1]] %in% c('Date','POSIXt')) indexClass(x) <- "POSIXct"
+ if(!tclass(x)[[1]] %in% c('Date','POSIXt')) tclass(x) <- "POSIXct"
# this takes a long time on big data - possibly use some sort of sampling instead???
p <- median(diff(time(x)))
diff --git a/R/plot.R b/R/plot.R
index 15574b5b..ed4101ba 100644
--- a/R/plot.R
+++ b/R/plot.R
@@ -612,7 +612,7 @@ addSeries <- function(x, main="", on=NA, type="l", col=NULL, lty=1, lwd=1, pch=1
} else {
subset.range <- paste(start(xDataSubset), end(xDataSubset),sep="/")
}
- ta.y <- merge(ta, .xts(,.index(xDataSubset), tzone=indexTZ(xdata)))[subset.range]
+ ta.y <- merge(ta, .xts(,.index(xDataSubset), tzone=tzone(xdata)))[subset.range]
chart.lines(ta.y, type=type, col=col, lty=lty, lwd=lwd, pch=pch, ...)
}
@@ -741,7 +741,7 @@ addEventLines <- function(events, main="", on=0, lty=1, lwd=1, col=1, ...){
end(xdata[xsubset]),sep="/")
ta.adj <- merge(n=.xts(1:NROW(xdata[xsubset]),
.index(xdata[xsubset]),
- tzone=indexTZ(xdata)),
+ tzone=tzone(xdata)),
.xts(rep(1, NROW(events)),# use numeric for the merge
.index(events)))[subset.range]
# should we not merge and only add events that are in index(xdata)?
@@ -952,7 +952,7 @@ addPolygon <- function(x, y=NULL, main="", on=NA, col=NULL, ...){
end(xdata[xsubset]),sep="/")
ta.adj <- merge(n=.xts(1:NROW(xdata[xsubset]),
.index(xdata[xsubset]),
- tzone=indexTZ(xdata)),ta)[subset.range]
+ tzone=tzone(xdata)),ta)[subset.range]
ta.x <- as.numeric(na.approx(ta.adj[,1], rule=2) )
# NAs in the coordinates break the polygon which is not the behavior we want
ta.y <- na.omit(ta.adj[,-1])
diff --git a/R/print.R b/R/print.R
index d4405474..a1c3ac6b 100644
--- a/R/print.R
+++ b/R/print.R
@@ -23,7 +23,7 @@
function(x,fmt,...) {
check.TZ(x)
if(missing(fmt))
- fmt <- indexFormat(x)
+ fmt <- tformat(x)
if(is.null(fmt))
fmt <- TRUE
diff --git a/R/str.R b/R/str.R
index a255c758..e59caa64 100644
--- a/R/str.R
+++ b/R/str.R
@@ -31,8 +31,8 @@ function(object,...) {
cat(paste(" Data:"))
str(coredata(object))
cat(paste(" Indexed by objects of class: "))
- cat(paste('[',paste(indexClass(object),collapse=','),'] ',sep=''))
- cat(paste("TZ: ", indexTZ(object), "\n", sep=""))
+ cat(paste('[',paste(tclass(object),collapse=','),'] ',sep=''))
+ cat(paste("TZ: ", tzone(object), "\n", sep=""))
if(!is.null(CLASS(object)))
cat(paste(" Original class: '",CLASS(object),"' ",sep=""),"\n")
cat(paste(" xts Attributes: "),"\n")
diff --git a/R/indexClass.R b/R/tclass.R
similarity index 55%
rename from R/indexClass.R
rename to R/tclass.R
index 8c0d29e5..24867e6e 100644
--- a/R/indexClass.R
+++ b/R/tclass.R
@@ -1,5 +1,5 @@
#
-# xts: eXtensible time-series
+# xts: eXtensible time-series
#
# Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com
#
@@ -21,17 +21,35 @@
`convertIndex` <-
function(x,value) {
- indexClass(x) <- value
+ tclass(x) <- value
x
}
-tclass <- indexClass <-
-function(x) {
- class <- attr(attr(x, "index"), "tclass")
- if(is.null(class))
- attr(x, '.indexCLASS')
- else
- class
+tclass <-
+function(x, ...) {
+ UseMethod('tclass')
+}
+
+tclass.xts <-
+function(x, ...) {
+ tclass <- attr(attr(x, "index"), "tclass")
+
+ # For xts objects created pre-0.10.3
+ if (is.null(tclass)) {
+ warning("index does not have a ", sQuote("tclass"), " attribute")
+
+ tclass <- attr(x, "tclass")
+ if (is.null(tclass)) {
+ tclass <- attr(x, ".indexCLASS")
+ }
+ if (is.null(tclass)) {
+ warning("object does not have a ", sQuote("tclass"), " or ",
+ sQuote(".indexCLASS"), " attribute")
+ tclass <- ""
+ }
+ tclass
+ }
+ return(tclass)
}
`tclass<-` <-
@@ -39,35 +57,45 @@ function(x,value) {
UseMethod('tclass<-')
}
+indexClass <-
+function(x) {
+ .Deprecated("tclass", "xts")
+ tclass(x)
+}
+
`indexClass<-` <-
-function(x,value) {
- UseMethod('indexClass<-')
+function(x, value) {
+ .Deprecated("tclass<-", "xts")
+ `tclass<-`(x, value)
}
-`tclass<-.xts` <- `indexClass<-.xts` <-
+`tclass<-.xts` <-
function(x, value) {
if(!is.character(value) && length(value) != 1)
- stop('improperly specified value for indexClass')
+ stop('improperly specified value for tclass')
- # remove 'POSIXt' from value, to prevent indexClass(x) <- 'POSIXt'
+ # remove 'POSIXt' from value, to prevent tclass(x) <- 'POSIXt'
value <- value[!value %in% "POSIXt"]
if(length(value)==0L)
- stop(paste('unsupported',sQuote('indexClass'),'indexing type: POSIXt'))
+ stop(paste('unsupported',sQuote('tclass'),'indexing type: POSIXt'))
if(!value[1] %in% c('dates','chron','POSIXlt','POSIXct','Date','timeDate','yearmon','yearqtr','xtime') )
- stop(paste('unsupported',sQuote('indexClass'),'indexing type:',as.character(value[[1]])))
+ stop(paste('unsupported',sQuote('tclass'),'indexing type:',as.character(value[[1]])))
# Add 'POSIXt' virtual class
if(value %in% c('POSIXlt','POSIXct'))
value <- c(value,'POSIXt')
- attr(x, '.indexCLASS') <- value
# all index related meta-data will be stored in the index
# as attributes
if(any(value %in% .classesWithoutTZ)) {
attr(attr(x,'index'), 'tzone') <- 'UTC'
}
attr(attr(x,'index'), 'tclass') <- value
+
+ # Remove class attrs (object created before 0.10-3)
+ attr(x, ".indexCLASS") <- NULL
+ attr(x, "tclass") <- NULL
+
x
}
-
diff --git a/R/indexFormat.R b/R/tformat.R
similarity index 66%
rename from R/indexFormat.R
rename to R/tformat.R
index 42131f78..c0107168 100644
--- a/R/indexFormat.R
+++ b/R/tformat.R
@@ -19,38 +19,54 @@
# along with this program. If not, see .
-`indexFormat` <-
+`tformat` <-
function(x) {
- UseMethod('indexFormat')
+ UseMethod('tformat')
}
-`indexFormat<-` <-
+`tformat<-` <-
function(x, value) {
- UseMethod('indexFormat<-')
+ UseMethod('tformat<-')
}
-`indexFormat.default` <-
+`tformat.default` <-
function(x) {
- attr(x, '.indexFORMAT')
+ attr(x, 'tformat')
}
-`indexFormat<-.default` <-
+`tormat<-.default` <-
function(x, value) {
- attr(x, '.indexFORMAT') <- value
+ attr(x, '.tformat') <- value
x
}
-`indexFormat.xts` <-
+`tformat.xts` <-
function(x) {
- attr(x, '.indexFORMAT')
+ ix <- .index(x)
+ attr(ix, 'tformat')
}
-`indexFormat<-.xts` <-
+`tformat<-.xts` <-
function(x, value) {
-
+
if(!is.character(value) && !is.null(value))
stop('must provide valid POSIX formatting string')
- attr(x, '.indexFORMAT') <- value
+ # Remove format attrs (object created before 0.10-3)
+ attr(x, ".indexFORMAT") <- NULL
+
+ attr(attr(x, 'index'), 'tformat') <- value
x
}
+
+`indexFormat` <-
+function(x) {
+ .Deprecated("tformat", "xts")
+ tformat(x)
+}
+
+`indexFormat<-` <-
+function(x, value) {
+ .Deprecated("tformat<-", "xts")
+ `tformat<-`(x, value)
+}
diff --git a/R/toperiod.R b/R/toperiod.R
index 2beb4f1f..61504123 100644
--- a/R/toperiod.R
+++ b/R/toperiod.R
@@ -78,9 +78,9 @@ to.period <- to_period <- function(x, period='months', k=1, indexAt=NULL, name=N
if(!is.null(indexAt)) {
if(indexAt=="yearmon" || indexAt=="yearqtr")
- indexClass(xx) <- indexAt
+ tclass(xx) <- indexAt
if(indexAt=="firstof") {
- ix <- as.POSIXlt(c(.index(xx)), tz=indexTZ(xx))
+ ix <- as.POSIXlt(c(.index(xx)), tz=tzone(xx))
if(period %in% c("years","months","quarters","days"))
index(xx) <- firstof(ix$year + 1900, ix$mon + 1)
else
@@ -88,7 +88,7 @@ to.period <- to_period <- function(x, period='months', k=1, indexAt=NULL, name=N
ix$hour, ix$min, ix$sec)
}
if(indexAt=="lastof") {
- ix <- as.POSIXlt(c(.index(xx)), tz=indexTZ(xx))
+ ix <- as.POSIXlt(c(.index(xx)), tz=tzone(xx))
if(period %in% c("years","months","quarters","days"))
index(xx) <- as.Date(lastof(ix$year + 1900, ix$mon + 1))
else
@@ -191,15 +191,15 @@ function(x) {
x <- try.xts(x, error=FALSE)
if(is.xts(x)) {
# if x is xts, drop HHMMSS from index
- if(any(indexClass(x)=='POSIXt')) {
+ if(any(tclass(x)=='POSIXt')) {
# convert index to Date
index(x) <- as.Date(as.POSIXlt(index(x)))
- indexClass(x) <- "Date" # set indexClass to Date
+ tclass(x) <- "Date" # set tclass to Date
}
- if(any(indexClass(x) %in% .classesWithoutTZ)) {
- indexTZ(x) <- "UTC" # set indexTZ to UTC
+ if(any(tclass(x) %in% .classesWithoutTZ)) {
+ tzone(x) <- "UTC" # set tzone to UTC
}
- # force conversion, even if we didn't set indexClass to Date
+ # force conversion, even if we didn't set tclass to Date
# because indexAt yearmon/yearqtr won't drop time from index
index(x) <- index(x)
if(xts.in) x # if input already was xts
diff --git a/R/ts.R b/R/ts.R
index 87b8af8a..c4f51f9b 100644
--- a/R/ts.R
+++ b/R/ts.R
@@ -40,8 +40,6 @@ function(x,...) {
`re.ts` <-
function(x,...) {
- #if(periodicity(x)$units == 'days' & !inherits(indexClass(x),"Date"))
- # indexClass(x) <- "Date"
# major issue with quick reclass. Basically fails on data < 1970...
#tsp.attr <- attr(x,'.tsp')
#freq.attr <- attr(x,'.frequency')
diff --git a/R/indexTZ.R b/R/tzone.R
similarity index 55%
rename from R/indexTZ.R
rename to R/tzone.R
index 8327bfc9..fe4244a6 100644
--- a/R/indexTZ.R
+++ b/R/tzone.R
@@ -20,7 +20,8 @@
indexTZ <- function(x, ...)
{
- UseMethod("indexTZ")
+ .Deprecated("tzone", "xts")
+ tzone(x, ...)
}
tzone <- function(x, ...) {
@@ -28,35 +29,65 @@ tzone <- function(x, ...) {
}
`indexTZ<-` <- function(x, value) {
- UseMethod("indexTZ<-")
+ .Deprecated("tzone<-", "xts")
+ `tzone<-`(x, value)
}
`tzone<-` <- function(x, value) {
UseMethod("tzone<-")
}
-`tzone<-.xts` <- `indexTZ<-.xts` <- function(x, value) {
- if( is.null(value) ) value <- ""
+`tzone<-.xts` <-
+function(x, value)
+{
+ if (is.null(value)) {
+ value <- ""
+ }
- attr(x, ".indexTZ") <- attr(x, "tzone") <- structure(value,.Names="TZ")
- attr(attr(x,"index"),"tzone") <- structure(value,.Names="TZ")
+ tzone <- as.character(value)
+ attr(attr(x, "index"), "tzone") <- tzone
+ # Remove tz attrs (object created before 0.10-3)
+ attr(x, ".indexTZ") <- NULL
+ attr(x, "tzone") <- NULL
x
}
+tzone.default <-
+function(x, ...)
+{
+ attr(x, "tzone")
+}
-tzone.default <- indexTZ.default <- function(x, ...) {
- attr(x, ".indexTZ")
+`tzone<-.default` <-
+function(x, value)
+{
+ if (!is.null(value)) {
+ tzone <- as.character(value)
+ }
+ attr(x, "tzone") <- value
+ x
}
-tzone.xts <- indexTZ.xts <- function(x, ...)
+tzone.xts <-
+function(x, ...)
{
tzone <- attr(attr(x, "index"), "tzone")
- if(is.null(tzone))
- tzone <- attr(x, ".indexTZ")
- if(is.null(tzone))
- return("")
- else
- return(tzone)
+
+ # For xts objects created pre-0.10.3
+ if (is.null(tzone)) {
+ warning("index does not have a ", sQuote("tzone"), " attribute")
+
+ tzone <- attr(x, "tzone")
+ if (is.null(tzone)) {
+ tzone <- attr(x, ".indexTZ")
+ }
+ if (is.null(tzone)) {
+ warning("object does not have a ", sQuote("tzone"), " or ",
+ sQuote(".indexTZ"), " attribute")
+ tzone <- ""
+ }
+ }
+ return(tzone)
}
.classesWithoutTZ <- c("chron","dates","times","Date","yearmon","yearqtr")
@@ -69,19 +100,19 @@ check.TZ <- function(x, ...)
if( !is.null(check) && !check)
return()
STZ <- as.character(Sys.getenv("TZ"))
- if(any(indexClass(x) %in% .classesWithoutTZ)) {
- # warn if indexTZ is not UTC or GMT (GMT is not technically correct, since
+ if(any(tclass(x) %in% .classesWithoutTZ)) {
+ # warn if tzone is not UTC or GMT (GMT is not technically correct, since
# it *is* a timezone, but it should work for all practical purposes)
- if (!(indexTZ(x) %in% c("UTC","GMT")))
+ if (!(tzone(x) %in% c("UTC","GMT")))
warning(paste0("index class is ", paste(class(index(x)), collapse=", "),
", which does not support timezones.\nExpected 'UTC' timezone",
- ", but indexTZ is ", ifelse(indexTZ(x)=="", "''", indexTZ(x))), call.=FALSE)
+ ", but tzone is ", sQuote(tzone(x))), call.=FALSE)
else
return()
}
- if(!is.null(indexTZ(x)) && indexTZ(x) != "" &&
- !identical(STZ, as.character(indexTZ(x))))
- warning(paste("timezone of object (",indexTZ(x),
+ if(!is.null(tzone(x)) && tzone(x) != "" &&
+ !identical(STZ, as.character(tzone(x))))
+ warning(paste("timezone of object (",tzone(x),
") is different than current timezone (",STZ,").",sep=""),
call.=FALSE)
}
diff --git a/R/xts.R b/R/xts.R
index 4bb062c2..5caa7e85 100644
--- a/R/xts.R
+++ b/R/xts.R
@@ -40,7 +40,7 @@ function(x=NULL,
...)
{
if(is.null(x) && missing(order.by))
- return(structure(.xts(,0),index=integer()))
+ return(.xts(NULL, integer()))
if(!timeBased(order.by))
stop("order.by requires an appropriate time-based object")
@@ -95,11 +95,28 @@ function(x=NULL,
x <- structure(.Data=x,
index=structure(index,tzone=tzone,tclass=orderBy),
class=c('xts','zoo'),
- .indexCLASS=orderBy,
- tclass=orderBy,
- .indexTZ=tzone,
- tzone=tzone,
...)
+
+ ctor.call <- match.call(expand.dots = TRUE)
+ if(hasArg(".indexFORMAT")) {
+ warning(sQuote(".indexFORMAT"), " is deprecated, use tformat instead.")
+ if(missing("tformat")) {
+ attr(attr(x, "index"), "tformat") <- eval.parent(ctor.call$.indexFORMAT)
+ }
+ }
+ if(hasArg(".indexCLASS")) {
+ warning(sQuote(".indexCLASS"), " is deprecated, use tclass instead.")
+ if(missing("tclass")) {
+ attr(attr(x, "index"), "tclass") <- eval.parent(ctor.call$.indexCLASS)
+ }
+ }
+ if(hasArg(".indexTZ")) {
+ warning(sQuote(".indexTZ"), " is deprecated, use tzone instead.")
+ if(missing("tzone")) {
+ attr(attr(x, "index"), "tzone") <- eval.parent(ctor.call$.indexTZ)
+ }
+ }
+
if(!is.null(attributes(x)$dimnames[[1]]))
# this is very slow if user adds rownames, but maybe that is deserved :)
dimnames(x) <- dimnames(x) # removes row.names
@@ -109,7 +126,7 @@ function(x=NULL,
`.xts` <-
function(x=NULL, index, tclass=c("POSIXct","POSIXt"),
tzone=Sys.getenv("TZ"),
- check=TRUE, unique=FALSE, .indexCLASS=tclass, ...) {
+ check=TRUE, unique=FALSE, ...) {
if(check) {
if( !isOrdered(index, increasing=TRUE, strictly=unique) )
stop('index is not in ',ifelse(unique, 'strictly', ''),' increasing order')
@@ -129,30 +146,56 @@ function(x=NULL, index, tclass=c("POSIXct","POSIXt"),
x <- vector(storage.mode(x))
} else x <- numeric(0)
+ ctor.call <- match.call(expand.dots = TRUE)
+
+ tformat <- NULL
+ if(hasArg(".indexFORMAT")) {
+ warning(sQuote(".indexFORMAT"), " is deprecated, use tformat instead.")
+ tformat <- eval.parent(ctor.call$.indexFORMAT)
+ } else if(hasArg("tformat")) {
+ tformat <- eval.parent(ctor.call$tformat)
+ } else {
+ 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)")
+ }
+ }
+
+ if(hasArg(".indexTZ")) {
+ warning(sQuote(".indexTZ"), " is deprecated and will be ignored,",
+ " use tzone instead.")
+ }
# don't overwrite index tzone if tzone arg is missing
- if(missing(tzone)) {
+ if(missing("tzone")) {
if(!is.null(index.tz <- attr(index,'tzone')))
tzone <- index.tz
}
# xts' tzone must only contain one element (POSIXlt tzone has 3)
tzone <- tzone[1L]
- # work-around for Ops.xts
+ xx <- .Call("add_xtsCoreAttributes", x, index, tzone, tclass,
+ c('xts','zoo'), tformat, PACKAGE='xts')
+
+ # remove any index attributes that came through '...'
+ # and set any user attributes (and/or dim, dimnames, etc)
dots.names <- eval(substitute(alist(...)))
- if(hasArg(.indexFORMAT))
- .indexFORMAT <- eval(dots.names$.indexFORMAT,parent.frame())
- else
- .indexFORMAT <- NULL
-
- ## restore behaviour from v0.10-2
- tclass <- .indexCLASS
- xx <- .Call("add_xtsCoreAttributes", x, index, .indexCLASS, tzone, tclass,
- c('xts','zoo'), .indexFORMAT, PACKAGE='xts')
- # remove .indexFORMAT and .indexTZ that come through Ops.xts
- dots.names$.indexFORMAT <- dots.names$.indexTZ <- NULL
- # set any user attributes
- if(length(dots.names))
- attributes(xx) <- c(attributes(xx), list(...))
+ if(length(dots.names) > 0L) {
+ dot.attrs <- list(...)
+ drop.attr <- c(".indexFORMAT", "tformat", ".indexCLASS", ".indexTZ")
+ dot.attrs[drop.attr] <- NULL
+ attributes(xx) <- c(attributes(xx), dot.attrs)
+ }
xx
}
@@ -164,7 +207,7 @@ function(x, match.to, error=FALSE, ...) {
stop('incompatible match.to attibutes')
} else return(x)
- if(!is.xts(x)) x <- .xts(coredata(x),.index(match.to), .indexCLASS=indexClass(match.to), tzone=indexTZ(match.to))
+ if(!is.xts(x)) x <- .xts(coredata(x),.index(match.to),tzone=tzone(match.to))
attr(x, ".CLASS") <- CLASS(match.to)
xtsAttributes(x) <- xtsAttributes(match.to)
}
@@ -225,7 +268,7 @@ function(x,value) {
function(x) {
inherits(x,'xts') &&
is.numeric(.index(x)) &&
- !is.null(indexClass(x))
+ !is.null(tclass(x))
}
`as.xts` <-
diff --git a/R/xts.methods.R b/R/xts.methods.R
index 7b7a215c..0585368c 100644
--- a/R/xts.methods.R
+++ b/R/xts.methods.R
@@ -101,7 +101,7 @@ function(x, i, j, drop = FALSE, which.i=FALSE,...)
# must be able to process - and then allow for operations???
i.tmp <- NULL
- tz <- as.character(indexTZ(x)) # ideally this moves to attr(index,"tzone")
+ tz <- as.character(tzone(x))
for(ii in i) {
adjusted.times <- .parseISO8601(ii, .index(x)[1], .index(x)[nr], tz=tz)
@@ -187,8 +187,7 @@ function(x, i, j, drop = FALSE, which.i=FALSE,...)
if(length(j) == 0 || (length(j)==1 && (is.na(j) || j==0))) {
if(missing(i))
i <- seq_len(nr)
- return(.xts(coredata(x)[i,j,drop=FALSE], index=.index(x)[i],
- .indexCLASS=indexClass(x), .indexTZ=indexTZ(x)))
+ return(.xts(coredata(x)[i,j,drop=FALSE], index=.index(x)[i]))
}
if(missing(i))
return(.Call("extract_col", x, as.integer(j), drop, 1, nr, PACKAGE='xts'))
@@ -274,7 +273,7 @@ window_idx <- function(x, index. = NULL, start = NULL, end = NULL)
usr_idx <- TRUE
idx <- .index(x)
- index. <- .toPOSIXct(index., indexTZ(x))
+ index. <- .toPOSIXct(index., tzone(x))
index. <- index.[!is.na(index.)]
if(is.unsorted(index.)) {
# index. must be sorted for index_bsearch
@@ -292,11 +291,11 @@ window_idx <- function(x, index. = NULL, start = NULL, end = NULL)
}
if(!is.null(start)) {
- start <- .toPOSIXct(start, indexTZ(x))
+ start <- .toPOSIXct(start, tzone(x))
}
if(!is.null(end)) {
- end <- .toPOSIXct(end, indexTZ(x))
+ end <- .toPOSIXct(end, tzone(x))
}
firstlast <- index_bsearch(index., start, end)
diff --git a/inst/include/xts.h b/inst/include/xts.h
index 565ab807..212d2513 100644
--- a/inst/include/xts.h
+++ b/inst/include/xts.h
@@ -27,9 +27,7 @@ INTERNAL SYMBOLS
*/
SEXP xts_IndexSymbol;
SEXP xts_ClassSymbol;
-SEXP xts_IndexFormatSymbol;
-SEXP xts_IndexClassSymbol;
-SEXP xts_IndexTZSymbol;
+SEXP xts_IndexTformatSymbol;
SEXP xts_IndexTclassSymbol;
SEXP xts_IndexTzoneSymbol;
@@ -43,18 +41,10 @@ DATA TOOLS
#define GET_xtsIndex(x) getAttrib(x, xts_IndexSymbol)
#define SET_xtsIndex(x,value) setAttrib(x, xts_IndexSymbol, value)
-// attr(x, '.indexCLASS') or indexClass(x)
-#define GET_xtsIndexClass(x) getAttrib(x, xts_IndexClassSymbol)
-#define SET_xtsIndexClass(x,value) setAttrib(x, xts_IndexvalueSymbol, value)
-
// attr(x, '.indexFORMAT') or indexFormat(x)
#define GET_xtsIndexFormat(x) getAttrib(x, xts_IndexFormatSymbol)
#define SET_xtsIndexFormat(x,value) setAttrib(x, xts_IndexFormatSymbol, value)
-// attr(x, '.indexTZ') or indexTZ(x)
-#define GET_xtsIndexTZ(x) getAttrib(x, xts_IndexTZSymbol)
-#define SET_xtsIndexTZ(x,value) setAttrib(x, xts_IndexTZSymbol, value)
-
// attr(x, '.CLASS') or CLASS(x)
#define GET_xtsCLASS(x) getAttrib(x, xts_ClassSymbol)
#define SET_xtsCLASS(x,value) setAttrib(x, xts_ClassSymbol, value)
@@ -70,7 +60,7 @@ FUNCTIONS
*/
SEXP do_xtsAttributes(SEXP x); // xtsAttributes i.e. user-added attributes
SEXP do_xtsCoreAttributes(SEXP x); /* xtsCoreAttributes xts-specific attributes
- CLASS, .indexFORMAT, .indexCLASS & class */
+ CLASS, .indexFORMAT, tclass, & class */
SEXP coredata(SEXP x, SEXP copyAttr);
SEXP coredata_xts(SEXP x);
SEXP add_class(SEXP x, SEXP klass);
diff --git a/inst/unitTests/runit.Ops.R b/inst/unitTests/runit.Ops.R
index e69de29b..19317a85 100644
--- a/inst/unitTests/runit.Ops.R
+++ b/inst/unitTests/runit.Ops.R
@@ -0,0 +1,409 @@
+numeric.modes <- c("double", "integer", "logical")#, "complex")
+ops.math <- c("+", "-", "*", "/", "^", "%%", "%/%")
+ops.logic <- c("&", "|", ">", ">=", "==", "!=", "<=", "<")
+
+ops_numeric_tester <-
+function(e1, e2, mode, op)
+{
+ storage.mode(e1) <- mode
+ storage.mode(e2) <- mode
+ eval(call(op, e1, e2))
+}
+
+### {{{ 2-column objects
+test.math_xts2d_matrix2d_dimnames <- function() {
+
+ X1 <- .xts(cbind(1:3, 4:6), 1:3, dimnames = list(NULL, c("x", "y")))
+ M1 <- as.matrix(X1) * 5
+ M2 <- M1
+ colnames(M2) <- rev(colnames(M2))
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(X1, M1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(coredata(E), M1, m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments should only change column names
+ e <- ops_numeric_tester(M2, X1, m, o)
+ E <- X1
+ colnames(E) <- colnames(M2)
+ E[] <- ops_numeric_tester(M2, coredata(E), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+
+test.math_xts2d_matrix2d_only_colnames <- function() {
+
+ X1 <- .xts(cbind(1:3, 4:6), 1:3, dimnames = list(NULL, c("x", "y")))
+ M1 <- coredata(X1) * 5
+ M2 <- M1
+ colnames(M2) <- rev(colnames(M2))
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(X1, M1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(coredata(E), M1, m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments should only change column names
+ e <- ops_numeric_tester(M2, X1, m, o)
+ E <- X1
+ colnames(E) <- colnames(M2)
+ E[] <- ops_numeric_tester(M2, coredata(E), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+
+test.math_xts2d_matrix2d_only_rownames <- function() {
+
+ X1 <- .xts(cbind(1:3, 4:6), 1:3)
+ M1 <- coredata(X1) * 5
+ rownames(M1) <- format(.POSIXct(1:3))
+ M2 <- M1
+ colnames(M2) <- rev(colnames(M2))
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(X1, M1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(coredata(E), M1, m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments should only change column names
+ e <- ops_numeric_tester(M2, X1, m, o)
+ E <- X1
+ colnames(E) <- colnames(M2)
+ E[] <- ops_numeric_tester(M2, coredata(E), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+
+test.math_xts2d_matrix2d_no_dimnames <- function() {
+ X1 <- .xts(cbind(1:3, 1:3), 1:3)
+ M1 <- coredata(X1) * 5
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(X1, M1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(coredata(E), M1, m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments shouldn't matter
+ e <- ops_numeric_tester(M1, X1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(M1, coredata(E), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+### }}} 2-column objects
+
+### {{{ 1-column objects
+test.math_xts1d_matrix1d_dimnames <- function() {
+ X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x"))
+ M1 <- as.matrix(X1) * 5
+ M2 <- M1
+ colnames(M2) <- "y"
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(X1, M1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(coredata(E), M1, m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments should only change column names
+ e <- ops_numeric_tester(M2, X1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(M2, coredata(E), m, o)
+ colnames(E) <- "y"
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+
+test.math_xts1d_matrix1d_only_colnames <- function() {
+ X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x"))
+ M1 <- coredata(X1) * 5
+ M2 <- M1
+ colnames(M2) <- "y"
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(X1, M1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(coredata(E), M1, m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments should only change column names
+ e <- ops_numeric_tester(M2, X1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(M2, coredata(E), m, o)
+ colnames(E) <- "y"
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+
+test.math_xts1d_matrix1d_only_rownames <- function() {
+
+ X1 <- .xts(1:3, 1:3)
+ M1 <- coredata(X1) * 5
+ rownames(M1) <- format(.POSIXct(1:3))
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(X1, M1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(coredata(E), M1, m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments shouldn't matter
+ e <- ops_numeric_tester(M1, X1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(M1, coredata(E), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+
+test.math_xts1d_matrix1d_no_dimnames <- function() {
+
+ X1 <- .xts(1:3, 1:3)
+ M1 <- coredata(X1) * 5
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(X1, M1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(coredata(E), M1, m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments shouldn't matter
+ e <- ops_numeric_tester(M1, X1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(M1, coredata(E), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+
+test.math_xts1d_xts1d <- function() {
+ X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x"))
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+ e <- ops_numeric_tester(X1, X1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(coredata(X1), coredata(X1), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+
+test.math_xts1d_xts1d_different_index <- function() {
+ X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x"))
+ X2 <- .xts(2:4, 2:4, dimnames = list(NULL, "y"))
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(X1, X2, m, o)
+ E <- X1[2:3,]
+ E[] <- ops_numeric_tester(coredata(E), coredata(X2[1:2,]), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments should only change column names
+ e <- ops_numeric_tester(X2, X1, m, o)
+ E <- X2[1:2,]
+ E[] <- ops_numeric_tester(coredata(X1[2:3,]), coredata(E), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+
+test.math_xts1d_xts1d_no_common_index <- function() {
+ X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x"))
+ X2 <- .xts(4:6, 4:6 * 1.0, dimnames = list(NULL, "y"))
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+ e <- ops_numeric_tester(X1, X2, m, o)
+ # only coredata should change
+ E <- drop(.xts(coredata(e)[0], .index(e)[0]))
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+### }}} 1-column objects
+
+### {{{ xts with dim, vector
+test.math_xts2d_vector_no_names <- function() {
+ X1 <- .xts(cbind(1:3, 4:6), 1:3, dimnames = list(NULL, c("x", "y")))
+ V1 <- as.vector(coredata(X1[,1L])) * 5
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(X1, V1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(coredata(E), V1, m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments shouldn't matter
+ e <- ops_numeric_tester(V1, X1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(V1, coredata(E), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+
+test.math_xts2d_vector_names <- function() {
+ X1 <- .xts(cbind(1:3, 4:6), 1:3, dimnames = list(NULL, c("x", "y")))
+ V1 <- setNames(as.vector(X1[,1L]), index(X1)) * 5
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(X1, V1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(coredata(E), V1, m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments shouldn't matter
+ e <- ops_numeric_tester(V1, X1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(V1, coredata(E), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+
+test.math_xts1d_vector_no_names <- function() {
+ X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x"))
+ V1 <- as.vector(coredata(X1[,1L])) * 5
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(X1, V1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(coredata(E), V1, m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments shouldn't matter
+ e <- ops_numeric_tester(V1, X1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(V1, coredata(E), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+
+test.math_xts1d_vector_names <- function() {
+ X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x"))
+ V1 <- setNames(as.vector(X1[,1L]), index(X1)) * 5
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(X1, V1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(coredata(E), V1, m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments shouldn't matter
+ e <- ops_numeric_tester(V1, X1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(V1, coredata(E), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+### }}} xts with dim, vector
+
+### {{{ xts no dims, matrix/vector
+test.math_xts_no_dim_matrix1d <- function() {
+ X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x"))
+ Xv <- drop(X1)
+ M1 <- coredata(X1) * 5
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(Xv, M1, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(coredata(Xv), M1, m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments shouldn't matter
+ e <- ops_numeric_tester(M1, Xv, m, o)
+ E <- X1
+ E[] <- ops_numeric_tester(M1, coredata(Xv), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+
+test.math_xts_no_dim_matrix2d <- function() {
+ X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x"))
+ Xv <- drop(X1)
+ X2 <- merge(x = Xv * 2, y = Xv * 5)
+ M2 <- coredata(X2)
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(Xv, M2, m, o)
+ E <- X2
+ E[] <- ops_numeric_tester(coredata(Xv), M2, m, o)
+ # results no identical because attributes change order
+ checkEquals(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments shouldn't matter
+ e <- ops_numeric_tester(M2, Xv, m, o)
+ E <- X2
+ E[] <- ops_numeric_tester(M2, coredata(Xv), m, o)
+ # results no identical because attributes change order
+ checkEquals(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+
+test.math_xts_no_dim_vector <- function() {
+ X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x"))
+ Xv <- drop(X1)
+ V1 <- 4:6
+
+ for (o in ops.math) {
+ for (m in numeric.modes) {
+
+ e <- ops_numeric_tester(Xv, V1, m, o)
+ E <- Xv
+ E[] <- ops_numeric_tester(coredata(Xv), V1, m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+
+ # order of arguments shouldn't matter
+ e <- ops_numeric_tester(V1, Xv, m, o)
+ E <- Xv
+ E[] <- ops_numeric_tester(V1, coredata(Xv), m, o)
+ checkIdentical(e, E, sprintf("op: %s, type: %s", o, m))
+ }
+ }
+}
+### }}} xts vector, matrix/vector
diff --git a/inst/unitTests/runit.all.equal.R b/inst/unitTests/runit.all.equal.R
new file mode 100644
index 00000000..4846630b
--- /dev/null
+++ b/inst/unitTests/runit.all.equal.R
@@ -0,0 +1,15 @@
+test.attr_on_object_equal_to_attr_on_index <- function() {
+ # ensure xts objects with index attributes attached are equal to
+ # xts objects with index attributes on the index only
+ attrOnObj <-
+ structure(1:3, index = structure(1:3, tzone = "UTC", tclass = "Date"),
+ class = c("xts", "zoo"), dim = c(3L, 1L),
+ .indexCLASS = "Date", .indexTZ = "UTC",
+ tclass = "Date", tzone = "UTC",
+ dimnames = list(NULL, "x"))
+ attrOnIndex <-
+ structure(1:3, index = structure(1:3, tzone = "UTC", tclass = "Date"),
+ class = c("xts", "zoo"), dim = c(3L, 1L),
+ dimnames = list(NULL, "x"))
+ checkTrue(all.equal(attrOnIndex, attrOnObj))
+}
diff --git a/inst/unitTests/runit.matrix.R b/inst/unitTests/runit.matrix.R
index 5b9ef33e..c28f4b8b 100644
--- a/inst/unitTests/runit.matrix.R
+++ b/inst/unitTests/runit.matrix.R
@@ -35,3 +35,11 @@ test.zero_width_xts_to_matrix <- function() {
zm <- as.matrix(as.zoo(x))
checkIdentical(xm, zm)
}
+
+# dim-less xts to matrix
+test.dimless_xts_to_matrix <- function() {
+ ix <- structure(1:3, tclass = c("POSIXct", "POSIXt"), tzone = "")
+ x <- structure(1:3, index = ix, class = c("xts", "zoo"))
+ m <- matrix(1:3, 3, 1, dimnames = list(format(.POSIXct(1:3)), "x"))
+ checkIdentical(as.matrix(x), m)
+}
diff --git a/inst/unitTests/runit.tclass.R b/inst/unitTests/runit.tclass.R
new file mode 100644
index 00000000..15227e0c
--- /dev/null
+++ b/inst/unitTests/runit.tclass.R
@@ -0,0 +1,60 @@
+# These tests check the time class attribute is attached to the expected
+# component of the xts object. The xts constructors should no longer add
+# 'tclass' or '.indexClass' attributes to the xts object itself. Only the index
+# should have a 'tclass' attribute. Construct xts objects using structure() to
+# test behavior when functions encounter xts objects created before 0.10-3.
+x <-
+structure(1:5, .Dim = c(5L, 1L),
+ index = structure(1:5, tzone = "", tclass = c("POSIXct", "POSIXt")),
+ .indexCLASS = c("POSIXct", "POSIXt"),
+ tclass = c("POSIXct", "POSIXt"),
+ .indexTZ = "UTC", tzone = "UTC",
+ class = c("xts", "zoo"))
+
+test.get_tclass <- function() {
+ checkIdentical(tclass(x), c("POSIXct", "POSIXt"))
+}
+
+test.get_indexClass_warns <- function() {
+ op <- options(warn = 2)
+ on.exit(options(warn = op$warn))
+ checkException(indexClass(x))
+}
+
+test.set_indexClass_warns <- function() {
+ op <- options(warn = 2)
+ on.exit(options(warn = op$warn))
+ checkException(indexClass(x) <- "Date")
+}
+
+test.set_tclass_drops_xts_tclass_indexCLASS <- function() {
+ y <- x
+ tclass(y) <- "POSIXct"
+ checkIdentical(NULL, attr(y, "tclass"))
+ checkIdentical(NULL, attr(y, ".indexCLASS"))
+}
+
+test.set_tclass_changes_index_tclass <- function() {
+ y <- x
+ tclass(y) <- "Date"
+ checkIdentical("Date", attr(attr(y, "index"), "tclass"))
+}
+
+test.get_coredata_drops_xts_tclass_indexCLASS <- function() {
+ y <- coredata(x)
+ checkIdentical(NULL, attr(y, "tclass"))
+ checkIdentical(NULL, attr(y, ".indexCLASS"))
+}
+
+test.get_xtsAttributes_excludes_tclass_indexCLASS <- function() {
+ y <- xtsAttributes(x)
+ checkIdentical(NULL, y$tclass)
+ checkIdentical(NULL, y$.indexCLASS)
+}
+
+test.set_xtsAttributes_removes_tclass_indexClass <- function() {
+ y <- x
+ xtsAttributes(y) <- xtsAttributes(x)
+ checkIdentical(NULL, attr(y, "tclass"))
+ checkIdentical(NULL, attr(y, ".indexCLASS"))
+}
diff --git a/inst/unitTests/runit.tformat.R b/inst/unitTests/runit.tformat.R
new file mode 100644
index 00000000..3608d02d
--- /dev/null
+++ b/inst/unitTests/runit.tformat.R
@@ -0,0 +1,60 @@
+# These tests check the 'tformat' attribute is attached to the expected
+# component of the xts object. The xts constructors should no longer add the
+# '.indexFORMAT' attribute to the xts object itself. Only the index should
+# have a 'tformat' attribute. Construct xts objects using structure() to
+# test behavior when functions encounter xts objects created before 0.10-3.
+x <-
+structure(1:5, .Dim = c(5L, 1L),
+ index = structure(1:5, tzone = "",
+ tclass = c("POSIXct", "POSIXt"),
+ tformat = "%Y-%m-%d"),
+ .indexCLASS = c("POSIXct", "POSIXt"),
+ tclass = c("POSIXct", "POSIXt"),
+ .indexTZ = "UTC", tzone = "UTC",
+ .indexFORMAT = "%Y-%m-%d %H:%M:%S",
+ class = c("xts", "zoo"))
+
+test.get_tformat <- function() {
+ checkIdentical(tformat(x), "%Y-%m-%d")
+}
+
+test.get_indexFORMAT_warns <- function() {
+ op <- options(warn = 2)
+ on.exit(options(warn = op$warn))
+ checkException(indexFormat(x))
+}
+
+test.set_indexFORMAT_warns <- function() {
+ op <- options(warn = 2)
+ on.exit(options(warn = op$warn))
+ checkException(indexFormat(x) <- "GMT")
+}
+
+test.set_tformat_drops_xts_indexFORMAT <- function() {
+ y <- x
+ tformat(y) <- "%Y-%m-%d %H:%M"
+ checkIdentical(NULL, attr(y, ".indexFORMAT"))
+}
+
+test.set_tformat_changes_index_tformat <- function() {
+ y <- x
+ fmt <- "%Y-%m-%d %H:%M"
+ tformat(y) <- fmt
+ checkIdentical(fmt, attr(attr(y, "index"), "tformat"))
+}
+
+test.get_coredata_drops_xts_indexFORMAT <- function() {
+ y <- coredata(x)
+ checkIdentical(NULL, attr(y, ".indexFORMAT"))
+}
+
+test.get_xtsAttributes_excludes_indexFORMAT <- function() {
+ y <- xtsAttributes(x)
+ checkIdentical(NULL, y$.indexFORMAT)
+}
+
+test.set_xtsAttributes_removes_indexFORMAT <- function() {
+ y <- x
+ xtsAttributes(y) <- xtsAttributes(x)
+ checkIdentical(NULL, attr(y, ".indexFORMAT"))
+}
diff --git a/inst/unitTests/runit.tzone.R b/inst/unitTests/runit.tzone.R
new file mode 100644
index 00000000..7c8f28da
--- /dev/null
+++ b/inst/unitTests/runit.tzone.R
@@ -0,0 +1,66 @@
+# These tests check the timezone attribute is attached to the expected
+# component of the xts object. The xts constructors should no longer add
+# 'tzone' or '.indexTZ' attributes to the xts object itself. Only the index
+# should have a 'tzone' attribute. Construct xts objects using structure() to
+# test behavior when functions encounter xts objects created before 0.10-3.
+x <-
+structure(1:5, .Dim = c(5L, 1L),
+ index = structure(1:5, tzone = "", tclass = c("POSIXct", "POSIXt")),
+ .indexCLASS = c("POSIXct", "POSIXt"),
+ tclass = c("POSIXct", "POSIXt"),
+ .indexTZ = "UTC", tzone = "UTC",
+ class = c("xts", "zoo"))
+
+test.get_tzone <- function() {
+ checkIdentical(tzone(x), "")
+}
+
+test.get_indexTZ_warns <- function() {
+ op <- options(warn = 2)
+ on.exit(options(warn = op$warn))
+ checkException(indexTZ(x))
+}
+
+test.set_indexTZ_warns <- function() {
+ op <- options(warn = 2)
+ on.exit(options(warn = op$warn))
+ checkException(indexTZ(x) <- "GMT")
+}
+
+test.set_tzone_drops_xts_tzone_indexTZ <- function() {
+ y <- x
+ tzone(y) <- "GMT"
+ checkIdentical(NULL, attr(y, "tzone"))
+ checkIdentical(NULL, attr(y, ".indexTZ"))
+}
+
+test.set_tzone_changes_index_tzone <- function() {
+ y <- x
+ tzone(y) <- "GMT"
+ checkIdentical("GMT", attr(attr(y, "index"), "tzone"))
+}
+
+test.set_tzone_to_NULL_sets_empty_string <- function() {
+ y <- x
+ tzone(y) <- NULL
+ checkIdentical("", attr(attr(y, "index"), "tzone"))
+}
+
+test.get_coredata_drops_xts_tzone_indexTZ <- function() {
+ y <- coredata(x)
+ checkIdentical(NULL, attr(y, "tzone"))
+ checkIdentical(NULL, attr(y, ".indexTZ"))
+}
+
+test.get_xtsAttributes_excludes_tzone_indexTZ <- function() {
+ y <- xtsAttributes(x)
+ checkIdentical(NULL, y$tzone)
+ checkIdentical(NULL, y$.indexTZ)
+}
+
+test.set_xtsAttributes_removes_tzone_indexTZ <- function() {
+ y <- x
+ xtsAttributes(y) <- xtsAttributes(x)
+ checkIdentical(NULL, attr(y, "tzone"))
+ checkIdentical(NULL, attr(y, ".indexTZ"))
+}
diff --git a/inst/unitTests/runit.xts.R b/inst/unitTests/runit.xts.R
index f360a3b7..7c1c1bdd 100644
--- a/inst/unitTests/runit.xts.R
+++ b/inst/unitTests/runit.xts.R
@@ -52,6 +52,60 @@ test.xts_only_use_first_tzone_element <- function() {
checkIdentical(tz, tzone(y))
}
+test.xts_no_args_has_index_with_tzone_tclass <- function() {
+ x <- xts()
+ checkTrue(!is.null(attr(.index(x), "tclass")))
+ checkTrue(!is.null(attr(.index(x), "tzone")))
+}
+
+# don't add index attributes to xts object
+test.ctors_dont_add_tclass_indexCLASS_to_object <- function() {
+ x <- xts(1, as.Date("2018-05-02"))
+ checkIdentical(NULL, attr(x, "tclass"))
+ checkIdentical(NULL, attr(x, ".indexCLASS"))
+ y <- .xts(1, 1)
+ checkIdentical(NULL, attr(y, "tclass"))
+ checkIdentical(NULL, attr(y, ".indexCLASS"))
+}
+
+test.ctors_dont_add_tzone_indexTZ_to_object <- function() {
+ x <- xts(1, as.Date("2018-05-02"))
+ checkIdentical(NULL, attr(x, "tzone"))
+ checkIdentical(NULL, attr(x, ".indexTZ"))
+ y <- .xts(1, 1)
+ checkIdentical(NULL, attr(y, "tzone"))
+ checkIdentical(NULL, attr(y, ".indexTZ"))
+}
+
+test.ctors_dont_add_indexFORMAT_to_object <- function() {
+ x <- xts(1, as.Date("2018-05-02"))
+ checkIdentical(NULL, attr(x, ".indexFORMAT"))
+ y <- .xts(1, 1)
+ checkIdentical(NULL, attr(y, ".indexFORMAT"))
+}
+
+# warn if deprecated arguments passed to constructor
+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() {
+ op <- options(warn = 2)
+ on.exit(options(warn = op$warn))
+ checkException(x <- xts(1, as.Date("2018-05-02"), .indexTZ = "UTC"))
+ checkException(x <- .xts(1, as.Date("2018-05-02"), .indexTZ = "UTC"))
+}
+
+test.xts_ctor_warns_for_indexFORMAT_arg <- function() {
+ op <- options(warn = 2)
+ on.exit(options(warn = op$warn))
+ checkException(x <- xts(1, as.Date("2018-05-02"), .indexFORMAT = "%Y"))
+ checkException(x <- .xts(1, as.Date("2018-05-02"), .indexFORMAT = "%Y"))
+}
+
# .xts()
test..xts_dimnames_in_dots <- function() {
x <- .xts(1:5, 1:5, dimnames = list(NULL, "x"))
@@ -59,34 +113,90 @@ 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)
+}
+
+### Check that index format attribute precedence is:
+### .indexFORMAT argument > tformat argument > tformat index attribute
+test..xts_index_format_precedence <- function() {
+ fmt <- "%Y-%m-%d"
+ checkXtsFormat(.xts(1, 1), NULL)
+ checkXtsFormat(.xts(1, 1, tformat=fmt), fmt)
+ checkXtsFormat(.xts(1, 1, .indexFORMAT=fmt), fmt)
+ checkXtsFormat(.xts(1, 1, tformat="%Y", .indexFORMAT=fmt), fmt)
+
+ ## check constructor arguments override existing index attribute
+ idx <- structure(1, tzone="", tclass="yearmon", tformat="%Y-%b")
+ fmt <- "%Y-%m"
+ checkXtsFormat(.xts(1, idx), "%Y-%b")
+ checkXtsFormat(.xts(1, idx, tformat=fmt), fmt)
+ checkXtsFormat(.xts(1, idx, .indexFORMAT=fmt), fmt)
+ checkXtsFormat(.xts(1, idx, tformat="%b%y", .indexFORMAT=fmt), fmt)
+}
+
+test..xts_user_attributes <- function() {
+ x <- .xts(1, 1, tformat = "%Y", .indexCLASS = "Date", .indexTZ = "UTC",
+ user = "attribute", hello = "world", dimnames = list(NULL, "x"))
+ checkIdentical(NULL, attr(x, "tformat"))
+ checkIdentical(NULL, attr(x, "tclass"))
+ checkIdentical(NULL, attr(x, "tzone"))
+ checkIdentical(NULL, attr(x, ".indexCLASS"))
+ checkIdentical(NULL, attr(x, ".indexTZ"))
+ checkIdentical("attribute", attr(x, "user"))
+ checkIdentical("world", attr(x, "hello"))
+ checkIdentical("x", colnames(x))
+}
+
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) {
checkEquals(tzone(xts), tzone)
- checkEquals(indexTZ(xts), tzone)
checkEquals(attr(attr(xts, "index"), "tzone"), tzone)
}
### Check that tzone is honoured and .indexTZ ignored
-test..xts_tzone <- function() {
+### Check that index timezone attribute precedence is:
+### .indexTZ argument > tzone argument > tzone index attribute
+### tzone argument > tzone argument > tzone index attribute
+test..xts_index_tzone_precedence <- function() {
sysTZ <- Sys.getenv("TZ")
Sys.setenv(TZ = "UTC")
on.exit(Sys.setenv(TZ = sysTZ), add = TRUE)
@@ -98,8 +208,9 @@ test..xts_tzone <- function() {
checkXtsTz(.xts(1, 1, tzone="Europe/London", .indexTZ="America/New_York"), "Europe/London")
## Cases where tzone is specified in the index
- checkXtsTz(.xts(1, structure(1, tzone="Asia/Tokyo",tclass="yearmon")), "Asia/Tokyo")
- checkXtsTz(.xts(1, structure(1, tzone="Asia/Tokyo",tclass="yearmon"), tzone="Europe/London"), "Europe/London")
- checkXtsTz(.xts(1, structure(1, tzone="Asia/Tokyo",tclass="yearmon"), .indexTZ="America/New_York"), "Asia/Tokyo")
- checkXtsTz(.xts(1, structure(1, tzone="Asia/Tokyo",tclass="yearmon"), tzone="Europe/London", .indexTZ="America/New_York"), "Europe/London")
+ idx <- structure(1, tzone="Asia/Tokyo",tclass="yearmon")
+ checkXtsTz(.xts(1, idx), "Asia/Tokyo")
+ checkXtsTz(.xts(1, idx, tzone="Europe/London"), "Europe/London")
+ checkXtsTz(.xts(1, idx, .indexTZ="America/New_York"), "Asia/Tokyo")
+ checkXtsTz(.xts(1, idx, tzone="Europe/London", .indexTZ="America/New_York"), "Europe/London")
}
diff --git a/man/subset.xts.Rd b/man/subset.xts.Rd
index ff8a3131..53da0e8d 100644
--- a/man/subset.xts.Rd
+++ b/man/subset.xts.Rd
@@ -83,7 +83,7 @@ provide the most performance efficiency.
As \code{xts} uses POSIXct time representations
of all user-level index classes internally, the fastest
timeBased subsetting will always be from POSIXct objects,
-regardless of the \code{indexClass} of the original
+regardless of the \code{tclass} of the original
object. All non-POSIXct time classes
are converted to character first to preserve
consistent TZ behavior.
diff --git a/man/indexClass.Rd b/man/tclass.Rd
similarity index 87%
rename from man/indexClass.Rd
rename to man/tclass.Rd
index 7069577b..1fb48ffb 100644
--- a/man/indexClass.Rd
+++ b/man/tclass.Rd
@@ -1,10 +1,12 @@
-\name{indexClass}
-\alias{indexClass}
+\name{tclass}
\alias{tclass}
+\alias{tformat}
+\alias{indexClass}
\alias{indexFormat}
\alias{convertIndex}
\alias{indexClass<-}
\alias{tclass<-}
+\alias{tformat<-}
\alias{indexFormat<-}
\alias{index.xts}
\alias{index<-.xts}
@@ -37,11 +39,11 @@ of an xts object.
indexClass(x)
indexClass(x) <- value
-tclass(x)
+tclass(x, ...)
tclass(x) <- value
-indexFormat(x)
-indexFormat(x) <- value
+tformat(x)
+tformat(x) <- value
convertIndex(x,value)
@@ -80,28 +82,28 @@ xts object. Upon a standard \code{index} call, this is used
to convert the numeric value to the desired class.
It is possible to view and set the class of the time-index
-of a given \code{xts} object via the \code{indexClass} function.
+of a given \code{xts} object via the \code{tclass} function.
To retrieve the raw numeric data a new accessor function (and replacement) has been
added \code{.index}. This is primarily for internal use, but may be useful for
end-users.
\code{.indexXXX} functions are useful to extract time
-components of the underlying time index. The \sQuote{indexClass}
+components of the underlying time index. The \sQuote{tclass}
is virtual, and as such suitable conversions are made depending
on the component requested.
The specified value for
-\code{indexClass<-} must be a character string containing
+\code{tclass<-} must be a character string containing
one of the following: \code{Date}, \code{POSIXct},
\code{chron}, \code{yearmon}, \code{yearqtr} or \code{timeDate}.
-\code{indexFormat} only manages the manner in which the object
+\code{tformat} only manages the manner in which the object
is displayed via \code{print} (also called automatically
when the object is returned) and in conversion to other
classes such as \code{matrix}. The valid values
-for indexFormat are the same for \code{format.POSIXct},
+for \code{tformat} are the same for \code{format.POSIXct},
as this is the function that does the conversion internally.
\code{convertIndex} returns a modified \code{xts} object, and
@@ -121,7 +123,7 @@ x <- xts(1:length(x), x)
x[.indexhour(x) \%in\% c(8,15) & .indexmin(x) \%in\% c(0:5,57:59)]
# change the index format
-indexFormat(x) <- "\%Y-\%b-\%d \%H:\%M:\%OS3"
+tformat(x) <- "\%Y-\%b-\%d \%H:\%M:\%OS3"
head(x)
}
diff --git a/man/indexTZ.Rd b/man/tzone.Rd
similarity index 90%
rename from man/indexTZ.Rd
rename to man/tzone.Rd
index 09b2c213..c696cb04 100644
--- a/man/indexTZ.Rd
+++ b/man/tzone.Rd
@@ -29,7 +29,7 @@ Going forward from 0.7-4, the TZ variable is now
also stored in the index itself, in the \code{tzone}
attribute. This is to facilitate the transition to
removing the xts-specific attributes referenced by
-\code{indexTZ}, \code{indexFormat}, and \code{indexClass}.
+\code{tzone}, \code{indexFormat}, and \code{indexClass}.
These accessor functions will continue to behave the
same under the new internals. Additionally, there is a new
getter/setter method with \code{tzone} and \code{tzone<-}.
@@ -54,9 +54,9 @@ where the index was stored in its native format (i.e. class).
The ability to create an index using any of the supported
timeBased classes (POSIXct, Date, dates, chron, timeDate,
yearmon, yearqtr) is managed at the user-interaction point,
-and the class is merely stored in another hidden attribute
-names \code{.indexCLASS}. This is accessible via
-the \code{indexClass} and \code{indexClass(x)<-} functions.
+and the class is merely stored in another index attribute,
+which is named \sQuote{tclass}. This is accessible and changeable
+via the \code{tclass} and \code{tclass(x)<-} functions.
In most cases, all of this makes the subsetting by time strings
possible, and also allows for consistent and fast manipulation
@@ -79,8 +79,7 @@ is not needed, it is often best to set the system TZ to "GMT" or
\seealso{ \code{\link{POSIXt}} }
\examples{
x <- xts(1:10, Sys.Date()+1:10)
-indexTZ(x)
-
+#indexTZ(x) # Deprecated(?)
# same, preferred as of 0.9-1
tzone(x)
str(x)
diff --git a/man/xtsAPI.Rd b/man/xtsAPI.Rd
index effe9104..b73826e1 100644
--- a/man/xtsAPI.Rd
+++ b/man/xtsAPI.Rd
@@ -5,11 +5,12 @@
This help file is to help in development of xts, as well
as provide some clarity and insight into its purpose and implementation.
-Last modified: 2013-01-16 by Jeffrey A. Ryan and Dirk Eddelbuettel
-Version: 0.9-2 and above
+By Jeffrey A. Ryan, Dirk Eddelbuettel, and Joshua M. Ulrich
+Last modified: 2018-05-02
+Version: 0.10-3 and above
-At present the \pkg{xts} API has publically available
-interfaces to the following functions (as defined in \code{xtsAPI.h}:
+At present the \pkg{xts} API has publicly available
+interfaces to the following functions (as defined in \code{xtsAPI.h}):
\preformatted{
Callable from other R packages:
@@ -30,8 +31,6 @@ Internal use macros:
xts_COREATTRIB(x)
GET_xtsIndex(x)
SET_xtsIndex(x,value)
- GET_xtsIndexClass(x)
- SET_xtsIndexClass(x,value)
GET_xtsIndexFormat(x)
SET_xtsIndexFormat(x,value)
GET_xtsCLASS(x)
@@ -41,7 +40,6 @@ Internal use SYMBOLS:
xts_IndexSymbol
xts_ClassSymbol
xts_IndexFormatSymbol
- xts_IndexClassSymbol
Callable from R:
SEXP mergeXts(SEXP args)
diff --git a/src/attr.c b/src/attr.c
index 6815d206..417ab602 100644
--- a/src/attr.c
+++ b/src/attr.c
@@ -45,9 +45,6 @@ SEXP do_xtsAttributes(SEXP x)
for( /* a=ATTRIB(a) */; a != R_NilValue; a = CDR(a) ) {
if(TAG(a) != xts_IndexSymbol &&
TAG(a) != xts_ClassSymbol &&
- TAG(a) != xts_IndexFormatSymbol &&
- TAG(a) != xts_IndexClassSymbol &&
- TAG(a) != xts_IndexTZSymbol &&
TAG(a) != R_ClassSymbol &&
TAG(a) != R_DimSymbol &&
TAG(a) != R_DimNamesSymbol &&
@@ -90,9 +87,6 @@ SEXP do_xtsCoreAttributes(SEXP x)
*/
for( /* a=ATTRIB(a) */; a != R_NilValue; a = CDR(a) ) {
if(TAG(a) == xts_ClassSymbol ||
- TAG(a) == xts_IndexFormatSymbol ||
- TAG(a) == xts_IndexClassSymbol ||
- TAG(a) == xts_IndexTZSymbol ||
TAG(a) == R_ClassSymbol)
{
SET_VECTOR_ELT(values, i, CAR(a));
@@ -178,8 +172,8 @@ SEXP ca (SEXP x, SEXP y)
return R_NilValue;
}
-SEXP add_xtsCoreAttributes(SEXP _x, SEXP _index, SEXP _indexClass, SEXP _tzone,
- SEXP _tclass, SEXP _class, SEXP _indexFormat)
+SEXP add_xtsCoreAttributes(SEXP _x, SEXP _index, SEXP _tzone,
+ SEXP _tclass, SEXP _class, SEXP _tformat)
{
int P=0;
if(MAYBE_SHARED(_index)) {
@@ -188,23 +182,15 @@ SEXP add_xtsCoreAttributes(SEXP _x, SEXP _index, SEXP _indexClass, SEXP _tzone,
/* add tzone and tclass to index */
setAttrib(_index, xts_IndexTclassSymbol, _tclass);
setAttrib(_index, xts_IndexTzoneSymbol, _tzone);
+ setAttrib(_index, xts_IndexTformatSymbol, _tformat);
if(MAYBE_SHARED(_x)) {
PROTECT(_x = duplicate(_x)); P++;
//_x = duplicate(_x);
}
setAttrib(_x, xts_IndexSymbol, _index); /* index */
- setAttrib(_x, xts_IndexClassSymbol, _indexClass); /* .indexClass */
- setAttrib(_x, xts_IndexTZSymbol, _tzone); /* .indexTZ */
- setAttrib(_x, xts_IndexTclassSymbol, _tclass); /* tclass */
- setAttrib(_x, xts_IndexTzoneSymbol, _tzone); /* tzone */
setAttrib(_x, R_ClassSymbol, _class); /* class */
- /* .indexFormat is only here because it's set in Ops.xts
- * This should go away once this attribute is on the index */
- if(_indexFormat != R_NilValue)
- setAttrib(_x, xts_IndexFormatSymbol, _indexFormat);
-
UNPROTECT(P);
return(_x);
}
diff --git a/src/diff.c b/src/diff.c
index 950273a5..a108a22b 100644
--- a/src/diff.c
+++ b/src/diff.c
@@ -205,9 +205,6 @@ SEXP lagXts(SEXP x, SEXP k, SEXP pad)
setAttrib(result, R_DimNamesSymbol, getAttrib(x, R_DimNamesSymbol));
}
setAttrib(result, xts_ClassSymbol, getAttrib(x, xts_ClassSymbol));
- setAttrib(result, xts_IndexFormatSymbol, getAttrib(x, xts_IndexFormatSymbol));
- setAttrib(result, xts_IndexTZSymbol, getAttrib(x, xts_IndexTZSymbol));
- setAttrib(result, xts_IndexClassSymbol, getAttrib(x, xts_IndexClassSymbol));
UNPROTECT(P);
return result;
diff --git a/src/init.c b/src/init.c
index 005d1553..83fed709 100644
--- a/src/init.c
+++ b/src/init.c
@@ -68,9 +68,7 @@ static void SymbolShortcuts(void)
{
xts_IndexSymbol = install("index");
xts_ClassSymbol = install(".CLASS");
- xts_IndexFormatSymbol = install(".indexFORMAT");
- xts_IndexClassSymbol = install(".indexCLASS");
- xts_IndexTZSymbol = install(".indexTZ");
+ xts_IndexTformatSymbol = install("tformat");
xts_IndexTclassSymbol = install("tclass");
xts_IndexTzoneSymbol = install("tzone");
}
diff --git a/src/merge.c b/src/merge.c
index daa0ecd9..768d5fd1 100644
--- a/src/merge.c
+++ b/src/merge.c
@@ -1000,9 +1000,6 @@ SEXP do_merge_xts (SEXP x, SEXP y,
setAttrib(result, xts_IndexSymbol, index);
if(LOGICAL(retclass)[0])
setAttrib(result, R_ClassSymbol, getAttrib(x, R_ClassSymbol));
- setAttrib(result, xts_IndexClassSymbol, getAttrib(x, xts_IndexClassSymbol));
- setAttrib(result, xts_IndexTZSymbol, getAttrib(x, xts_IndexTZSymbol));
- setAttrib(result, xts_IndexFormatSymbol, getAttrib(x, xts_IndexFormatSymbol));
setAttrib(result, xts_ClassSymbol, getAttrib(x, xts_ClassSymbol));
copy_xtsAttributes(x, result);
@@ -1285,7 +1282,6 @@ SEXP mergeXts (SEXP args) // mergeXts {{{
}
SET_xtsIndex(result, GET_xtsIndex(_INDEX));
- SET_xtsIndexTZ(result, GET_xtsIndexTZ(_INDEX));
copy_xtsCoreAttributes(_INDEX, result);
copy_xtsAttributes(_INDEX, result);
@@ -1314,7 +1310,6 @@ SEXP mergeXts (SEXP args) // mergeXts {{{
}
copyMostAttrib(getAttrib(_x,xts_IndexSymbol), index_tmp);
setAttrib(result, xts_IndexSymbol, index_tmp);
- setAttrib(result, xts_IndexTZSymbol, getAttrib(index_tmp, xts_IndexTzoneSymbol));
UNPROTECT(P);
return(result);
diff --git a/src/rbind.c b/src/rbind.c
index 2a1c1a64..98057fc4 100644
--- a/src/rbind.c
+++ b/src/rbind.c
@@ -108,8 +108,6 @@ if(TYPEOF(xindex)==INTSXP) {
PROTECT(newindex = allocVector(TYPEOF(xindex), len)); P++;
PROTECT(result = allocVector(TYPEOF(x), len * ncx)); P++;
- copyMostAttrib(xindex, newindex);
-
switch( TYPEOF(x) ) {
case INTSXP:
int_x = INTEGER(x);
@@ -498,10 +496,9 @@ return(result);
if(truelen != len) {
PROTECT(newindex = lengthgets(newindex, truelen)); P++;
}
+ copyMostAttrib(xindex, newindex);
+
setAttrib(result, xts_IndexSymbol, newindex);
- setAttrib(result, xts_IndexClassSymbol, getAttrib(x, xts_IndexClassSymbol));
- setAttrib(result, xts_IndexTZSymbol, getAttrib(x, xts_IndexTZSymbol));
- setAttrib(result, xts_IndexFormatSymbol, getAttrib(x, xts_IndexFormatSymbol));
setAttrib(result, xts_ClassSymbol, getAttrib(x, xts_ClassSymbol));
copy_xtsAttributes(x, result);
UNPROTECT(P);
diff --git a/src/runSum.c b/src/runSum.c
index 81835b8d..f6af7b48 100644
--- a/src/runSum.c
+++ b/src/runSum.c
@@ -141,8 +141,6 @@ SEXP runSum (SEXP x, SEXP n)
setAttrib(result, R_DimSymbol, getAttrib(x, R_DimSymbol));
setAttrib(result, R_ClassSymbol, getAttrib(x, R_ClassSymbol));
setAttrib(result, xts_IndexSymbol, getAttrib(x, xts_IndexSymbol));
- setAttrib(result, xts_IndexFormatSymbol, getAttrib(x, xts_IndexFormatSymbol));
- setAttrib(result, xts_IndexClassSymbol, getAttrib(x, xts_IndexClassSymbol));
UNPROTECT(P);
return result;
diff --git a/vignettes/xts-faq.Rnw b/vignettes/xts-faq.Rnw
index 295b5081..9fb2e614 100644
--- a/vignettes/xts-faq.Rnw
+++ b/vignettes/xts-faq.Rnw
@@ -222,7 +222,7 @@ sample.xts <- as.xts(transform(sample.xts, ABC=1))
You might also have to reset the index timezone:
<>=
-indexTZ(sample.xts) <- Sys.getenv("TZ")
+tzone(sample.xts) <- Sys.getenv("TZ")
@
\q{Why can't I use the \code{\&} operator in \pkg{xts} objects when querying
diff --git a/vignettes/xts.Rnw b/vignettes/xts.Rnw
index dddb3c81..a6ddc76a 100644
--- a/vignettes/xts.Rnw
+++ b/vignettes/xts.Rnw
@@ -236,7 +236,7 @@ zoo or matrix objects will simply work as expected.
A quick tour of some of the methods leveraged by {\tt xts}
will be presented here, including subsetting via ``{\tt [}'',
-indexing objects with {\tt indexClass} and {\tt convertIndex},
+indexing objects with {\tt tclass} and {\tt convertIndex},
and a quick look at plotting {\tt xts} objects with the {\tt plot}
function.
@@ -329,13 +329,13 @@ the replacement function {\tt index<-}.
It is also possible to directly query and set the
index class of an {\tt xts} object by using the respective functions
-{\tt indexClass} and {\tt indexClass<-}.
+{\tt tclass} and {\tt tclass<-}.
Temporary conversion, resulting in a new object with the requested
index class, can be accomplished via the {\tt convertIndex} function.
-<>=
-indexClass(matrix_xts)
-indexClass(convertIndex(matrix_xts,'POSIXct'))
+<>=
+tclass(matrix_xts)
+tclass(convertIndex(matrix_xts,'POSIXct'))
@
\pagebreak
\subsubsection*{Plotting}