Question

I would like to ask for an advice regarding xts subclass. I am using xtsAttributes to add metadata information for every column of my xts numeric matrix. The metadata holds a character string with a description for each column.

So ncol(myxtsobject) = length(metadata). And I add a new class to the object as well, say myclass. Now I want to write method [.myclass extending [.xts function to also subset accordingly my metadata when subsetting xts matrix.

For example: d <- myobject[,c(2,3,23)] would produce d with 3 columns and appropriate 3 entries in metadata attributes.

Could somebody give me directions how to do it while rationally employing existing xts and matrix subsetting functions?

More details ….
There is the structure of my object below (just an minimalistic example):

# creating the object
n <- 10
ind <- Sys.time() + 1:n
col <- sin(seq(from=0, to=2*pi, length.out=n))
col2 <- cos(seq(from=0, to=2*pi, length.out=n))
d <- xts(x=cbind(col,col2), order.by=ind)
KEY1 <- paste("desc k1 -",1:ncol(d))
KEY2 <- paste("desc k2 -",1:ncol(d))
xtsAttributes(d) <- data.frame(KEY1,KEY2,stringsAsFactors=F)
d <- structure(d, class = c("dm", "xts", "zoo"))
# resulting structure
str(d)

Now, with such an object I would like to develop set of functions allowing subsetting consitent with object metadata KEY1, KEY2 so if I drop/select column 2, I will drop/select corresponding member from KEY1 and KEY2.

I am currently usig this code, which so far works. Reusing data.frame and xts subset.
These getMeta.dm(x) and is.dm(x) are my functions with obvious function.

#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: subset.dm
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
subset.dm <- function(x,i,j,...)  {
# get my metadata, returns data.frame
md <- getMeta.dm(x)
# metadata subset
md <- md[j,]
# xts subset
myclass <- class(x)
x <- as.xts(x)
x <- x[i,j,...]
# now again assembling md object
# TODO fu() for creating dm objects
xtsAttributes(x) <- md
class(x) <- myclass
if(is.dm(x)) return(x) else stop("result is not dm object")
}

`[.dm` <- subset.dm

Answer 1

You need to create a subsetting function for your subclass that handles the columnar metadata attributes:

`[.dm` <- function(x, i, j, drop=FALSE, which.i=FALSE, ...) {
  # Include all args from [.xts (check by running args(xts:::`[.xts`))
  # Call the regular xts subsetting function
  res <- xts:::`[.xts`(x, i, j, drop, which.i, ...)
  cnx <- colnames(x)   # Get colnames from x
  ncn <- is.null(cnx)  # Check if there are no colnames
  if(ncn)              # If there are no colnames, add them
    colnames(x) <- sprintf("X%d",1:ncol(x))
  # Determine which columns are in the resulting object
  cols <- which(cnx %in% colnames(res))
  # Get the 'KEY' attributes from x
  xa <- xtsAttributes(x)
  # Replace the 'KEY' attributes with values from columns we keep
  xtsAttributes(res) <- list(KEY1=xa$KEY1[cols], KEY2=xa$KEY2[cols])
  if(ncn)              # Remove our colnames from res
    colnames(res) <- NULL
  res                  # return result
}

Now that we’ve defined the subclass subsetting function, let’s test it:

> str(d[,1])
An ‘xts’ object from 2012-08-07 16:08:47 to 2012-08-07 16:08:56 containing:
  Data: num [1:10, 1] 0 0.643 0.985 0.866 0.342 ...
 - attr(*, "dimnames")=List of 2
  ..$ : NULL
  ..$ : chr "col"
  Indexed by objects of class: [POSIXct,POSIXt] TZ: 
  xts Attributes:  
List of 4
 $ tclass: chr [1:2] "POSIXct" "POSIXt"
 $ tzone : chr ""
 $ KEY1  : chr "desc k1 - 1"
 $ KEY2  : chr "desc k2 - 1"
> str(d[,2])
An ‘xts’ object from 2012-08-07 16:08:47 to 2012-08-07 16:08:56 containing:
  Data: num [1:10, 1] 1 0.766 0.174 -0.5 -0.94 ...
 - attr(*, "dimnames")=List of 2
  ..$ : NULL
  ..$ : chr "col2"
  Indexed by objects of class: [POSIXct,POSIXt] TZ: 
  xts Attributes:  
List of 4
 $ tclass: chr [1:2] "POSIXct" "POSIXt"
 $ tzone : chr ""
 $ KEY1  : chr "desc k1 - 2"
 $ KEY2  : chr "desc k2 - 2"

Looks good. Note that you can continue to use the xts-style subsetting functionality:

> str(d["2012-08-07 16:08:50",1])
An ‘xts’ object from 2012-08-07 16:08:50 to 2012-08-07 16:08:50 containing:
  Data: num [1, 1] 0.866
 - attr(*, "dimnames")=List of 2
  ..$ : NULL
  ..$ : chr "col"
  Indexed by objects of class: [POSIXct,POSIXt] TZ: 
  xts Attributes:  
List of 4
 $ tclass: chr [1:2] "POSIXct" "POSIXt"
 $ tzone : chr ""
 $ KEY1  : chr "desc k1 - 1"
 $ KEY2  : chr "desc k2 - 1"
> str(d["2012-08-07 16:08:50",2])
An ‘xts’ object from 2012-08-07 16:08:50 to 2012-08-07 16:08:50 containing:
  Data: num [1, 1] -0.5
 - attr(*, "dimnames")=List of 2
  ..$ : NULL
  ..$ : chr "col2"
  Indexed by objects of class: [POSIXct,POSIXt] TZ: 
  xts Attributes:  
List of 4
 $ tclass: chr [1:2] "POSIXct" "POSIXt"
 $ tzone : chr ""
 $ KEY1  : chr "desc k1 - 2"
 $ KEY2  : chr "desc k2 - 2"