xts子类子集方法

Question

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

因此ncol(myxtsobject) = length(metadata)。并且我还为该对象添加了一个新类，例如myclass。现在我想编写方法[.myclass延伸[.xts函数也相应地子集xts矩阵时我的元数据。

例如：d <- myobject[,c(2,3,23)]将生成d，其中有3列，并且元数据属性中有3个条目。

有人可以告诉我怎么做，而理性地使用现有的XT和矩阵子集功能？

更多细节.... 还有就是我的目标如下（只是一个简约的例子）结构：

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

现在，有了这样的目标，我想开发一套允许子集化consitent功能使用对象元数据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"