如何创建 POSIXct 矩阵

How to create a matrix of POSIXct

当我在 R 3.1.2 中创建给定 POSIXct 向量的矩阵时,矩阵的条目是数字而不是 POSIXct:

x <- as.POSIXct("2012-02-25 19:00:00")
x
attributes(x)

m <- matrix(x, nrow=2, ncol=3)
m
attributes(m)

创建 POSIXct 值矩阵的最佳方法是什么?

一种粗略的方法是将class和属性重新分配给矩阵:

x <- as.POSIXct("2012-02-25 19:00:00")
m <- matrix(x, nrow=2, ncol=3)
assignPOSIXct <- function(m,x){
    class(m) <- c("matrix",class(x)) 
    attr(m,"tzone") <- attr(x,"tzone")
    return(m)
}
m <- assignPOSIXct(m,x)
m

但这很麻烦而且容易出错。在一个循环中,我必须检查条目是否为 POSIXct。

我认为我以前从未见过有人创建 POSIXct 值矩阵,尽管不难想象这样一个对象的用例。

R 好像不太支持这种类型的对象。 S3 对象系统非常有限,创建 POSIXct 矩阵需要同时设置矩阵和 POSIXct(以及 POSIXt,它似乎总是与 POSIXct 一起标记)S3 classes。事实上,根据我的经验,任何对象从多个显式 S3 classes 继承是很不寻常的,也许 POSIXct+POSIXt 和 POSIXlt+POSIXt 的情况除外。

我想通过创建一个新的矩阵构造函数 matrix.POSIXct() 来填充这种类型的对象。为了方便起见,为了提供 S3 调度,我还创建了一个新的泛型 matrix() 和默认的 matrix.default() 委托给普通的 base::matrix()。请注意,matrix() 的泛化有时是由 R 包完成的,例如 gmp。他们将泛化函数限制在他们的包环境中,但我只是将这些函数转储到全局环境中。

不幸的是,默认的 POSIXct 打印函数 print.POSIXct() 不够智能,无法处理也被 class 编辑为矩阵的 POSIXct 向量,因此任何此类矩阵都将打印为普通的旧向量。为了解决这个问题,我还创建了一个新的 print.POSIXct() 函数,它拦截任何 POSIXct-classed 对象的打印并检查它是否也被 classed 作为矩阵,在这种情况下,为了以最少的工作提供合理的实现,我构建了一个新矩阵,其数据值由 POSIXct 值的字符表示组成,然后打印该矩阵。如果它不是 classed 作为矩阵,我只是将参数传递给普通的 base::print.POSIXct() 函数来打印普通的旧非矩阵 POSIXct 向量。

关于 matrix.POSIXct().

中缺少参数的默认设置,我尝试尽可能地遵循 base::matrix() 的设计
matrix <- function(x,...) UseMethod('matrix');
matrix.default <- function(...) base::matrix(...);

matrix.POSIXct <- function(data=NA,nrow,ncol,byrow=F,dimnames=NULL,...) {
    if (missing(nrow)) {
        if (missing(ncol)) {
            nrow <- length(data);
            ncol <- 1L;
        } else {
            nrow <- ceiling(length(data)/ncol);
        }; ## end if
    } else {
        if (missing(ncol))
            ncol <- ceiling(length(data)/nrow);
    }; ## end if
    data <- rep(as.POSIXct(data,tz=attr(data,'tzone'),...),len=nrow*ncol);
    if (byrow) {
        dim(data) <- c(ncol,nrow);
        data <- t(data);
    } else
        dim(data) <- c(nrow,ncol);
    if (!is.null(dimnames))
        base::dimnames(data) <- dimnames;
    class(data) <- c(class(data),'matrix');
    data;
}; ## end matrix.POSIXct()

print.POSIXct <- function(x,...) {
    if (inherits(x,'matrix') && !is.null(nrow(x))) {
        print(matrix(as.character(x,usetz=T),nrow(x),dimnames=dimnames(x)),...);
        invisible(x);
    } else
        base::print.POSIXct(x,...);
}; ## end print.POSIXct()

您的数据演示:

x <- as.POSIXct('2012-02-25 19:00:00');
m <- matrix(x,2L,3L);
m;
##      [,1]                      [,2]                      [,3]
## [1,] "2012-02-25 19:00:00 EST" "2012-02-25 19:00:00 EST" "2012-02-25 19:00:00 EST"
## [2,] "2012-02-25 19:00:00 EST" "2012-02-25 19:00:00 EST" "2012-02-25 19:00:00 EST"
attributes(m);
## $class
## [1] "POSIXct" "POSIXt"  "matrix"
##
## $tzone
## [1] ""
##
## $dim
## [1] 2 3

这里是 format.POSIXct():

format.POSIXct <- function(x,...) {
    if (inherits(x,'matrix') && !is.null(nrow(x)))
        matrix(base::format.POSIXct(x,...),nrow(x),dimnames=dimnames(x))
    else
        base::format.POSIXct(x,...);
}; ## end format.POSIXct()

对了,忘记索引了。这是另一个有问题的案例。默认的 base::`[.POSIXct`() 索引函数有点便宜(诚然有点像我上面的一些垫片代码)因为它只是暂时删除向量的 classes,将它传递给下一个特定的 S3 , 然后恢复原来的 classes。这意味着矩阵的 drop 参数被尊重,如果设置为 TRUE(默认值)并且下标使得矩阵性被丢弃,则意味着 dim 属性从返回的对象中删除。

问题是廉价包装器中的class恢复恢复了我们的矩阵class,所以,当廉价包装器returns,我们收到一个矩阵-classed 没有 dim 属性的对象。

我们 运行 进入的确切错误,实际上是由 print.POSIXct() 垫片发出的,如果我们尝试打印子集向量 ("error in evaluating the argument 'x' in selecting a method for function 'print': Error in base::matrix(...) : non-numeric matrix extent") 是由 nrow(x) 返回 NULL,因此 matrix() 调用接收到 nrow=NULL。

我做了两件事来解决这个问题。首先,我改进了 print.POSIXct() 函数以防止 nrow(x) 返回 NULL 的情况,在这种情况下它不会将要打印的对象视为矩阵。因此,如果它收到一个没有 dim 属性的矩阵 classed 对象(尽管这不应该发生),它会将其打印为普通的旧 POSIXct 向量。

其次,我编写了另一个索引函数来检测 dim 属性的删除,并在这种情况下相应地删除矩阵 class。

这个新函数的创建很复杂,因为便宜的包装器使用 NextMethod() 来调用下一个 S3 特定的,如果从直接调用的调用中调用它是无效的,独立于S3 调度过程。因此,正如您在下面的代码中看到的那样,我使用了一些技巧将廉价包装器的主体 "insert" 放入我们的 shim 函数中,从而将 NextMethod() 调用移动到我们的 shim 中,从而必须通过通用 `[`() 调用(像往常一样):

`[.POSIXct` <- function(x,...) {
    res <- blah;
    if (inherits(x,'matrix') && !'dim'%in%names(attributes(res)))
        class(res) <- class(res)[class(res)!='matrix'];
    res;
};
body(`[.POSIXct`)[[2]][[3]] <- body(base::`[.POSIXct`);

演示:

x <- as.POSIXct('2016-02-05 00:00:00')+0:8;
m <- matrix(x,3L,byrow=T);
m;
##      [,1]                      [,2]                      [,3]
## [1,] "2016-02-05 00:00:00 EST" "2016-02-05 00:00:01 EST" "2016-02-05 00:00:02 EST"
## [2,] "2016-02-05 00:00:03 EST" "2016-02-05 00:00:04 EST" "2016-02-05 00:00:05 EST"
## [3,] "2016-02-05 00:00:06 EST" "2016-02-05 00:00:07 EST" "2016-02-05 00:00:08 EST"
m[1];
## [1] "2016-02-05 EST"
m[1:3];
## [1] "2016-02-05 00:00:00 EST" "2016-02-05 00:00:03 EST" "2016-02-05 00:00:06 EST"
m[1:3,1];
## [1] "2016-02-05 00:00:00 EST" "2016-02-05 00:00:03 EST" "2016-02-05 00:00:06 EST"
m[1:3,1,drop=F];
##      [,1]
## [1,] "2016-02-05 00:00:00 EST"
## [2,] "2016-02-05 00:00:03 EST"
## [3,] "2016-02-05 00:00:06 EST"
m[1:3,1:2];
##      [,1]                      [,2]
## [1,] "2016-02-05 00:00:00 EST" "2016-02-05 00:00:01 EST"
## [2,] "2016-02-05 00:00:03 EST" "2016-02-05 00:00:04 EST"
## [3,] "2016-02-05 00:00:06 EST" "2016-02-05 00:00:07 EST"

这是一个 as.data.frame.POSIXct():

as.data.frame.POSIXct <- function(x,...) {
    if (inherits(x,'matrix') && !is.null(dim(x))) {
        class(x) <- class(x)[!class(x)%in%c('POSIXct','POSIXt')];
        res <- as.data.frame(x,...);
        for (ci in seq_along(res))
            res[[ci]] <- as.POSIXct(res[[ci]],tz=attr(x,'tzone'),origin='1970-01-01');
        res;
    } else
        base::as.data.frame.POSIXct(x,...);
}; ## end as.data.frame.POSIXct()

演示:

m <- matrix(as.POSIXct('2016-02-05 00:00:00')+0:8,3);
m;
##      [,1]                      [,2]                      [,3]
## [1,] "2016-02-05 00:00:00 EST" "2016-02-05 00:00:03 EST" "2016-02-05 00:00:06 EST"
## [2,] "2016-02-05 00:00:01 EST" "2016-02-05 00:00:04 EST" "2016-02-05 00:00:07 EST"
## [3,] "2016-02-05 00:00:02 EST" "2016-02-05 00:00:05 EST" "2016-02-05 00:00:08 EST"
as.data.frame(m);
##                    V1                  V2                  V3
## 1 2016-02-05 00:00:00 2016-02-05 00:00:03 2016-02-05 00:00:06
## 2 2016-02-05 00:00:01 2016-02-05 00:00:04 2016-02-05 00:00:07
## 3 2016-02-05 00:00:02 2016-02-05 00:00:05 2016-02-05 00:00:08

这里是 summary.POSIXct():

summary.POSIXct <- function(x,...) {
    if (inherits(x,'matrix') && !is.null(dim(x)))
        summary(as.data.frame(x),...)
    else
        base::summary.POSIXct(x,...);
}; ## end summary.POSIXct()

另一种方法是在存储到矩阵和数组中并在需要时转换为 POSIXct 时接受丢失 S3 信息。这可以通过以下函数完成

asPOSIXctFromNumeric <- function(
    ### convert numeric to POSIXct with default origin and time zone 
    x       ##<< numeric vector to convert
    ,origin='1970-01-01'    ##<< default origin
    ,tz='GMT'               ##<< default time zone
){
    ##details<<
    ## Sometime POSIXct becomes converted to numeric, e.g. when stored
    ## in a matrix.
    ## The defaults of this routing convert it back to POSIXct with      
    ## the same origin, and a default time zone
    as.POSIXct(as.numeric(x),origin=origin, tz=tz)
}

我通过重新排序 class 属性来调整@bgoldst 的答案,以便矩阵排在第一位:

matrix <- function(x,...) UseMethod('matrix');
matrix.default <- function(...) base::matrix(...);

matrix.POSIXct <- function(data=NA,nrow,ncol,byrow=F,dimnames=NULL,...) {
    if (missing(nrow)) {
        if (missing(ncol)) {
            nrow <- length(data);
            ncol <- 1L;
        } else {
            nrow <- ceiling(length(data)/ncol);
        }; ## end if
    } else {
        if (missing(ncol))
            ncol <- ceiling(length(data)/nrow);
    }; ## end if
    data <- rep(as.POSIXct(data,tz=attr(data,'tzone'),...),len=nrow*ncol);
    if (byrow) {
        dim(data) <- c(ncol,nrow);
        data <- t(data);
    } else
        dim(data) <- c(nrow,ncol);
    if (!is.null(dimnames))
        base::dimnames(data) <- dimnames;
    class(data) <- c('matrix',class(data));
    data;
}; ## end matrix.POSIXct()

as.data.frame.matrix <- function (x, ...) 
{
    value <- base::as.data.frame.matrix(x,...)
    if( inherits(x,"POSIXct") ) {
        for (i in 1:ncol(value)){   
            attributes(value[[i]])$tzone <- attributes(x)$tzone
            class(value[[i]]) <- c("POSIXct","POSIXt")
        } 
    }
    value
}

结果更接近我的预期。但是,一些原始函数仍然存在问题。以下结果为向量而不是矩阵:

t(m)
m[1, ,drop=FALSE]

因此,使用起来还是很不安全的。