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"

xts子类子集方法

1 个答案: