r - 如何创建POSIXct矩阵

Question

当我在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值矩阵的最佳方法是什么？

Answer 1

我认为我以前从未见过有人创建POSIXct值矩阵，尽管不难想象此类对象的用例。

R似乎不太支持这种类型的对象。 S3对象系统非常有限，并且创建POSIXct矩阵需要同时设置矩阵和POSIXct（以及POSIXt，这似乎总是与POSIXct一起标记）S3类。实际上，以我的经验，任何对象都可以从多个显式S3类继承，这是很不寻常的，也许是POSIXct + POSIXt和POSIXlt + POSIXt除外。

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

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

对于默认的base::matrix()缺少参数，我尝试尽可能遵循matrix.POSIXct()的设计。

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`()索引功能是便宜的（诚然，类似于我上面的一些匀场代码），因为它只是临时删除向量的类，将其传递给下一个特定的S3，然后恢复原始的类。这意味着将尊重矩阵的drop参数，如果将其设置为TRUE（默认值），并且下标使矩阵不可见，则表示将dim属性从返回的对象中删除。

问题在于廉价包装器中的类还原将还原我们的矩阵类，因此，当廉价包装器返回时，我们会收到没有dim属性的矩阵类对象。

我们遇到的确切错误，如果并且当我们尝试打印子集的矢量时，实际上是由print.POSIXct()垫片发出的（“在选择函数'print'的方法时评估参数'x'的错误：base的错误:: matrix（...）：非数字矩阵范围“）由nrow(x)返回NULL引起，因此matrix()调用接收到nrow = NULL。

我已经做了两件事来解决这个问题。首先，我改进了print.POSIXct()函数，以防止nrow(x)返回NULL的情况，在这种情况下，它根本不会将要打印的对象视为矩阵。因此，如果它接收到没有dim属性的矩阵分类的对象（尽管不应正确执行此操作），它将把它打印为普通的旧POSIXct向量。

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

廉价包装器使用NextMethod()来调用下一个特定的S3的事实使该新函数的创建变得复杂，如果从直接调用的调用中进行调用而与S3调度过程无关，则该无效。因此，如您在下面的代码中所见，我使用了一些技巧将便宜包装的主体“插入”到我们的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()