r - xts 子类子集化方法

Question

我想征求有关 xts 子类的建议。我正在使用 xtsAttributes为我的 xts 数字矩阵的每一列添加元数据信息。元数据包含一个字符串，其中包含每列的描述。

所以ncol(myxtsobject) = length(metadata) .我也向对象添加了一个新类，比如 myclass .现在我想写方法[.myclass延伸 [.xts函数在子集 xts 矩阵时也相应地子集我的元数据。

例如:d <- myobject[,c(2,3,23)]会产生 d在元数据属性中有 3 列和适当的 3 个条目。

有人可以指导我如何在合理使用现有 xts 和矩阵子集函数的同时做到这一点吗？

更多细节 ....
下面是我的对象的结构(只是一个简单的例子):

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

现在，有了这样一个对象，我想开发一组函数，允许子集与对象元数据 KEY1、KEY2 一致，因此如果我删除/选择第 2 列，我将从 KEY1 和 KEY2 中删除/选择相应的成员。

我目前正在使用这个代码，到目前为止它是有效的。重用 data.frame 和 xts 子集。
这些 getMeta.dm(x) 和 is.dm(x) 是我的函数，具有明显的功能。

#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: 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

您需要为处理列元数据属性的子类创建子集函数:

`[.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
}

现在我们已经定义了子类子集函数，让我们测试一下:

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

看起来挺好的。请注意，您可以继续使用 xts 样式的子集功能:

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