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"