Remove .indexTZ and tzone attrs from xts object

Mark `indexTZ()` and `indexTZ<-` as deprecated, if only to make their usage easier to find during testing and reverse dependency checks. Remove their S3 methods and call their respective "tzone" function instead. Replace calls to indexTZ() with calls to tzone(). Remove all uses of 'xts_IndexTZSymbol' in C code, including the macros 'GET_xtsIndexTZ' and 'SET_xtsIndexTZ'. Opportunistically remove .indexTZ and tzone attributes from objects created using prior versions of xts. Also remove "TZ" name attribute from `tzone<-.xts`. Rename R/indexTZ.R to R/tzone.R, and man/indexTZ.Rd to man/tzone.Rd. See #245.
joshuaulrich · May 29, 2018 · fc2344b · fc2344b
1 parent 4d9b9d1
commit fc2344b
Show file tree

Hide file tree

Showing 21 changed files with 152 additions and 77 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -234,8 +234,6 @@ S3method('tclass<-',xts)
 S3method('indexFormat',xts)
 S3method('indexFormat<-',xts)
 
-S3method(indexTZ,xts)
-S3method('indexTZ<-',xts)
 S3method(tzone,xts)
 S3method('tzone<-',xts)
 

diff --git a/R/Ops.xts.R b/R/Ops.xts.R
@@ -54,13 +54,12 @@ function(e1, e2)
     if(is.xts(e1)) {
       .xts(e, .index(e1), 
               .indexCLASS=indexClass(e1), 
-              .indexFORMAT=indexFormat(e1), 
-              .indexTZ=indexTZ(e1))
+              .indexFORMAT=indexFormat(e1)
+          )
     } else {
       .xts(e, .index(e2),
               .indexCLASS=indexClass(e2), 
-              .indexFORMAT=indexFormat(e2), 
-              .indexTZ=indexTZ(e2)
+              .indexFORMAT=indexFormat(e2)
           )
     }
   } else {

diff --git 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=indexClass(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=indexClass(x))
 }
 
 is.index.unique <- is.time.unique <- function(x) {

diff --git a/R/coredata.xts.R b/R/coredata.xts.R
@@ -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 {
@@ -132,8 +133,11 @@ function(x,value) {
   } else
   for(nv in names(value)) {
     if(!nv %in% c('dim','dimnames','index','class','.CLASS','.ROWNAMES','.CLASSnames',
-                  '.indexCLASS','.indexFORMAT','.indexTZ'))
+                  '.indexCLASS','.indexFORMAT'))
       attr(x,nv) <- value[[nv]]
   }
+  # Remove tz attrs (object created before 0.10-3)
+  attr(x, ".indexTZ") <- NULL
+  attr(x, "tzone") <- NULL
   x
 }
diff --git 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
@@ -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/plot.R b/R/plot.R
@@ -681,7 +681,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, ...)
   }
 
@@ -821,7 +821,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)?
@@ -1043,7 +1043,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/str.R b/R/str.R
@@ -32,7 +32,7 @@ function(object,...) {
   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("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/toperiod.R b/R/toperiod.R
@@ -80,15 +80,15 @@ to.period <- to_period <- function(x, period='months', k=1, indexAt=NULL, name=N
     if(indexAt=="yearmon" || indexAt=="yearqtr")
       indexClass(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
         index(xx) <- firstof(ix$year + 1900, ix$mon + 1, ix$mday,
                              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
@@ -195,7 +195,7 @@ function(x) {
       indexClass(x) <- "Date"  # set indexClass to Date
     }
     if(any(indexClass(x) %in% .classesWithoutTZ)) {
-      indexTZ(x) <- "UTC"  # set indexTZ to UTC
+      tzone(x) <- "UTC"  # set tzone to UTC
     }
     # force conversion, even if we didn't set indexClass to Date
     # because indexAt yearmon/yearqtr won't drop time from index

diff --git a/R/indexTZ.R → R/tzone.R b/R/indexTZ.R → R/tzone.R
@@ -20,43 +20,64 @@
 
 indexTZ <- function(x, ...)
 {
-  UseMethod("indexTZ")
+  .Deprecated("tzone", "xts")
+  tzone(x, ...)
 }
 
 tzone <- function(x, ...) {
   UseMethod("tzone")
 }
 
 `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 <- indexTZ.default <- function(x, ...) {
-  attr(x, ".indexTZ")
+tzone.default <-
+function(x, ...)
+{
+  attr(x, "tzone")
 }
 
-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")
@@ -70,18 +91,18 @@ check.TZ <- function(x, ...)
     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
+    # 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
@@ -94,8 +94,6 @@ function(x=NULL,
             class=c('xts','zoo'),
             .indexCLASS=orderBy,
             tclass=orderBy,
-            .indexTZ=tzone,
-            tzone=tzone,
             ...)
   if(!is.null(attributes(x)$dimnames[[1]]))
     # this is very slow if user adds rownames, but maybe that is deserved :)
@@ -134,8 +132,8 @@ function(x=NULL, index, tclass=c("POSIXct","POSIXt"),
 
   structure(.Data=x,
             index=structure(index,tzone=tzone,tclass=.indexCLASS),
-            .indexCLASS=.indexCLASS,.indexTZ=tzone,
-            tclass=.indexCLASS,tzone=tzone,
+            .indexCLASS=.indexCLASS,
+            tclass=.indexCLASS,
             class=c('xts','zoo'), ...)
 }
 
@@ -174,8 +172,8 @@ function(x=NULL, index, tclass=c("POSIXct","POSIXt"),
     .indexFORMAT <- NULL
   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
+  # remove .indexFORMAT that come through Ops.xts
+  dots.names$.indexFORMAT <- NULL
   # set any user attributes
   if(length(dots.names))
     attributes(xx) <- c(attributes(xx), ...)
@@ -190,7 +188,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), .indexCLASS=indexClass(match.to), tzone=tzone(match.to))
     CLASS(x) <- CLASS(match.to)
     xtsAttributes(x) <- xtsAttributes(match.to)
   }

diff --git a/R/xts.methods.R b/R/xts.methods.R
@@ -79,7 +79,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))
       i_len <- length(i)
 
       for(ii in i) {
@@ -165,7 +165,7 @@ function(x, i, j, drop = FALSE, which.i=FALSE,...)
       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)))
+                  .indexCLASS=indexClass(x)))
     } 
     if(missing(i))
       return(.Call("extract_col", x, as.integer(j), drop, 1, nr, PACKAGE='xts'))

diff --git a/inst/include/xts.h b/inst/include/xts.h
@@ -29,7 +29,6 @@ SEXP xts_IndexSymbol;
 SEXP xts_ClassSymbol;
 SEXP xts_IndexFormatSymbol;
 SEXP xts_IndexClassSymbol;
-SEXP xts_IndexTZSymbol;
 SEXP xts_IndexTclassSymbol;
 SEXP xts_IndexTzoneSymbol;
 
@@ -51,10 +50,6 @@ DATA TOOLS
 #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)