From d0748c389ad84c8fb19e5b2abc9cbd39a322f8dc Mon Sep 17 00:00:00 2001 From: Joshua Ulrich Date: Fri, 20 Apr 2018 06:46:50 -0500 Subject: [PATCH] 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 | 2 +- R/Ops.xts.R | 2 - R/align.time.R | 4 +- R/coredata.xts.R | 5 ++- R/index.R | 10 ++--- R/irts.R | 2 +- R/lag.xts.R | 2 +- R/periodicity.R | 2 +- R/str.R | 2 +- R/{indexClass.R => tclass.R} | 64 ++++++++++++++++++++++--------- R/toperiod.R | 10 ++--- R/ts.R | 2 - R/tzone.R | 2 +- R/xts.R | 16 ++++---- R/xts.methods.R | 3 +- inst/include/xts.h | 7 +--- inst/unitTests/runit.tclass.R | 65 ++++++++++++++++++++++++++++++++ man/subset.xts.Rd | 2 +- man/{indexClass.Rd => tclass.Rd} | 12 +++--- man/tzone.Rd | 6 +-- man/xtsAPI.Rd | 12 +++--- src/attr.c | 6 +-- src/diff.c | 1 - src/init.c | 1 - src/merge.c | 1 - src/rbind.c | 1 - src/runSum.c | 1 - vignettes/xts.Rnw | 10 ++--- 28 files changed, 165 insertions(+), 88 deletions(-) rename R/{indexClass.R => tclass.R} (55%) create mode 100644 inst/unitTests/runit.tclass.R rename man/{indexClass.Rd => tclass.Rd} (93%) diff --git a/NAMESPACE b/NAMESPACE index 2a756fc9..a1f6e68e 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/Ops.xts.R b/R/Ops.xts.R index acea1ceb..149e9493 100644 --- a/R/Ops.xts.R +++ b/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) ) } diff --git a/R/align.time.R b/R/align.time.R index 17f85ea6..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=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) { diff --git a/R/coredata.xts.R b/R/coredata.xts.R index 63f6e7c5..9897aa04 100644 --- a/R/coredata.xts.R +++ b/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 } diff --git a/R/index.R b/R/index.R index 5b148c49..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) } 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/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/str.R b/R/str.R index 13f83585..e59caa64 100644 --- a/R/str.R +++ b/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") 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/toperiod.R b/R/toperiod.R index 89b0f47c..543b0cc5 100644 --- a/R/toperiod.R +++ b/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 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/tzone.R b/R/tzone.R index e18c241d..b33c9043 100644 --- a/R/tzone.R +++ b/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"))) diff --git a/R/xts.R b/R/xts.R index 44079bd7..229e3b1e 100644 --- a/R/xts.R +++ b/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` <- diff --git a/R/xts.methods.R b/R/xts.methods.R index 9c0f7e30..2d7da5ae 100644 --- a/R/xts.methods.R +++ b/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')) diff --git a/inst/include/xts.h b/inst/include/xts.h index da6dbad4..59ecf001 100644 --- a/inst/include/xts.h +++ b/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); diff --git a/inst/unitTests/runit.tclass.R b/inst/unitTests/runit.tclass.R new file mode 100644 index 00000000..af62955c --- /dev/null +++ b/inst/unitTests/runit.tclass.R @@ -0,0 +1,65 @@ +# 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_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.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.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/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 93% rename from man/indexClass.Rd rename to man/tclass.Rd index 7069577b..43629b4e 100644 --- a/man/indexClass.Rd +++ b/man/tclass.Rd @@ -1,6 +1,6 @@ -\name{indexClass} -\alias{indexClass} +\name{tclass} \alias{tclass} +\alias{indexClass} \alias{indexFormat} \alias{convertIndex} \alias{indexClass<-} @@ -37,7 +37,7 @@ of an xts object. indexClass(x) indexClass(x) <- value -tclass(x) +tclass(x, ...) tclass(x) <- value indexFormat(x) @@ -80,20 +80,20 @@ 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}. diff --git a/man/tzone.Rd b/man/tzone.Rd index ea9c5866..385b4be5 100644 --- a/man/tzone.Rd +++ b/man/tzone.Rd @@ -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 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 9fe9f820..8058c9b2 100644 --- a/src/attr.c +++ b/src/attr.c @@ -46,7 +46,6 @@ SEXP do_xtsAttributes(SEXP x) if(TAG(a) != xts_IndexSymbol && TAG(a) != xts_ClassSymbol && TAG(a) != xts_IndexFormatSymbol && - TAG(a) != xts_IndexClassSymbol && TAG(a) != R_ClassSymbol && TAG(a) != R_DimSymbol && TAG(a) != R_DimNamesSymbol && @@ -90,7 +89,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) == R_ClassSymbol) { SET_VECTOR_ELT(values, i, CAR(a)); @@ -176,7 +174,7 @@ SEXP ca (SEXP x, SEXP y) return R_NilValue; } -SEXP add_xtsCoreAttributes(SEXP _x, SEXP _index, SEXP _indexClass, SEXP _tzone, +SEXP add_xtsCoreAttributes(SEXP _x, SEXP _index, SEXP _tzone, SEXP _tclass, SEXP _class, SEXP _indexFormat) { int P=0; @@ -192,8 +190,6 @@ SEXP add_xtsCoreAttributes(SEXP _x, SEXP _index, SEXP _indexClass, SEXP _tzone, //_x = duplicate(_x); } setAttrib(_x, xts_IndexSymbol, _index); /* index */ - setAttrib(_x, xts_IndexClassSymbol, _indexClass); /* .indexClass */ - setAttrib(_x, xts_IndexTclassSymbol, _tclass); /* tclass */ setAttrib(_x, R_ClassSymbol, _class); /* class */ /* .indexFormat is only here because it's set in Ops.xts diff --git a/src/diff.c b/src/diff.c index 83ed7b83..15217c4f 100644 --- a/src/diff.c +++ b/src/diff.c @@ -206,7 +206,6 @@ SEXP lagXts(SEXP x, SEXP k, SEXP pad) } setAttrib(result, xts_ClassSymbol, getAttrib(x, xts_ClassSymbol)); setAttrib(result, xts_IndexFormatSymbol, getAttrib(x, xts_IndexFormatSymbol)); - setAttrib(result, xts_IndexClassSymbol, getAttrib(x, xts_IndexClassSymbol)); UNPROTECT(P); return result; diff --git a/src/init.c b/src/init.c index 8f8e1202..ad7f30dd 100644 --- a/src/init.c +++ b/src/init.c @@ -69,7 +69,6 @@ static void SymbolShortcuts(void) xts_IndexSymbol = install("index"); xts_ClassSymbol = install(".CLASS"); xts_IndexFormatSymbol = install(".indexFORMAT"); - xts_IndexClassSymbol = install(".indexCLASS"); xts_IndexTclassSymbol = install("tclass"); xts_IndexTzoneSymbol = install("tzone"); } diff --git a/src/merge.c b/src/merge.c index 3c308d96..7cc4d3fd 100644 --- a/src/merge.c +++ b/src/merge.c @@ -984,7 +984,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_IndexFormatSymbol, getAttrib(x, xts_IndexFormatSymbol)); setAttrib(result, xts_ClassSymbol, getAttrib(x, xts_ClassSymbol)); copy_xtsAttributes(x, result); diff --git a/src/rbind.c b/src/rbind.c index c201cba0..7b4fca45 100644 --- a/src/rbind.c +++ b/src/rbind.c @@ -499,7 +499,6 @@ return(result); PROTECT(newindex = lengthgets(newindex, truelen)); P++; } setAttrib(result, xts_IndexSymbol, newindex); - setAttrib(result, xts_IndexClassSymbol, getAttrib(x, xts_IndexClassSymbol)); setAttrib(result, xts_IndexFormatSymbol, getAttrib(x, xts_IndexFormatSymbol)); setAttrib(result, xts_ClassSymbol, getAttrib(x, xts_ClassSymbol)); copy_xtsAttributes(x, result); diff --git a/src/runSum.c b/src/runSum.c index 81835b8d..bbc4c40b 100644 --- a/src/runSum.c +++ b/src/runSum.c @@ -142,7 +142,6 @@ SEXP runSum (SEXP x, SEXP n) 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.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}