Remove .indexCLASS and tclass attrs from xts object

Mark `indexClass()` and `indexClass<-` 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 "tclass"
function instead.

Replace calls to indexClass() with calls to tclass(). Remove all uses
of 'xts_IndexClassSymbol' in C code, including the macros
'GET_xtsIndexClass' and 'SET_xtsIndexClass'.

Opportunistically remove .indexCLASS and tclass attributes from
objects created using prior versions of xts.

Rename R/indexClass.R to R/tclass.R and man/indexClass.Rd to
man/tclass.Rd.

See #245.

NAMESPACE

@@ -229,7 +229,7 @@ S3method(window,xts)
 S3method(dimnames, xts)
 S3method('dimnames<-', xts)
 
-S3method('indexClass<-',xts)
+S3method(tclass,xts)
 S3method('tclass<-',xts)
 
 S3method('indexFormat',xts)

R/Ops.xts.R

@@ -53,12 +53,10 @@ function(e1, e2)
   if(is.null(attr(e,'index'))) {
     if(is.xts(e1)) {
       .xts(e, .index(e1), 
-              .indexCLASS=indexClass(e1), 
               .indexFORMAT=indexFormat(e1)
           )
     } else {
       .xts(e, .index(e2),
-              .indexCLASS=indexClass(e2), 
               .indexFORMAT=indexFormat(e2)
           )
     }

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=tzone(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=tzone(x), tclass=indexClass(x))
+  .xts(x, .index(x) + n, tzone=tzone(x), tclass=tclass(x))
 }
 
 is.index.unique <- is.time.unique <- function(x) {

R/coredata.xts.R

@@ -133,11 +133,14 @@ function(x,value) {
   } else
   for(nv in names(value)) {
     if(!nv %in% c('dim','dimnames','index','class','.CLASS','.ROWNAMES','.CLASSnames',
-                  '.indexCLASS','.indexFORMAT'))
+                  '.indexFORMAT'))
       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
   x
 }

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)
 }

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)

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")

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)))

R/str.R

@@ -31,7 +31,7 @@ function(object,...) {
   cat(paste("  Data:"))
   str(coredata(object))
   cat(paste("  Indexed by objects of class: "))
-  cat(paste('[',paste(indexClass(object),collapse=','),'] ',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")

R/indexClass.R → 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,53 +21,81 @@
 
 `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<-` <-
 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
 }
-

R/toperiod.R

@@ -78,7 +78,7 @@ 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=tzone(xx))
       if(period %in% c("years","months","quarters","days"))
@@ -191,13 +191,13 @@ 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')) {
-      indexClass(x) <- "Date"  # set indexClass to Date
+    if(any(tclass(x)=='POSIXt')) {
+      tclass(x) <- "Date"  # set tclass to Date
     }
-    if(any(indexClass(x) %in% .classesWithoutTZ)) {
+    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

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')

R/tzone.R

@@ -90,7 +90,7 @@ check.TZ <- function(x, ...)
   if( !is.null(check) && !check)
     return()
   STZ <- as.character(Sys.getenv("TZ"))
-  if(any(indexClass(x) %in% .classesWithoutTZ)) {
+  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 (!(tzone(x) %in% c("UTC","GMT")))

R/xts.R

@@ -95,8 +95,6 @@ function(x=NULL,
   x <- structure(.Data=x,
             index=structure(index,tzone=tzone,tclass=orderBy),
             class=c('xts','zoo'),
-            .indexCLASS=orderBy,
-            tclass=orderBy,
             ...)
   if(!is.null(attributes(x)$dimnames[[1]]))
     # this is very slow if user adds rownames, but maybe that is deserved :)
@@ -107,7 +105,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')
@@ -143,8 +141,12 @@ function(x=NULL, index, tclass=c("POSIXct","POSIXt"),
     .indexFORMAT <- NULL
 
   ## restore behaviour from v0.10-2
-  tclass <- .indexCLASS
-  xx <- .Call("add_xtsCoreAttributes", x, index, .indexCLASS, tzone, tclass,
+  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'), .indexFORMAT, PACKAGE='xts')
   # remove .indexFORMAT that come through Ops.xts
   dots.names$.indexFORMAT <- NULL
@@ -162,7 +164,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=tzone(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)
   }
@@ -223,7 +225,7 @@ function(x,value) {
 function(x) {
   inherits(x,'xts') &&
   is.numeric(.index(x)) &&
-  !is.null(indexClass(x))
+  !is.null(tclass(x))
 }
 
 `as.xts` <-

R/xts.methods.R

@@ -164,8 +164,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)))
+      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'))

inst/include/xts.h

@@ -28,7 +28,6 @@ INTERNAL SYMBOLS
 SEXP xts_IndexSymbol;
 SEXP xts_ClassSymbol;
 SEXP xts_IndexFormatSymbol;
-SEXP xts_IndexClassSymbol;
 SEXP xts_IndexTclassSymbol;
 SEXP xts_IndexTzoneSymbol;
 
@@ -42,10 +41,6 @@ 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)
@@ -65,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);