R 如何创建POSIXct的矩阵

当我在R3.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)

---

x一种粗略的方法是将类和属性重新分配给矩阵：

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

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

R似乎不太支持这种类型的对象。S3对象系统非常有限，创建POSIXct矩阵需要设置matrix和POSIXct（以及POSIXt，它似乎总是与POSIXct一起标记）S3类。事实上，根据我的经验，任何对象从多个显式S3类继承都是非常罕见的，可能POSIXct+POSIXt和POSIXlt+POSIXt的情况除外

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

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

我试图尽可能地遵循
base:：matrix（）
的设计，以避免在
matrix.POSIXct（）
中默认缺少参数


对，忘了索引。这是另一个有问题的案例。默认的
base:：`[.POSIXct`（）
索引函数有点便宜（无可否认，有点像我上面的一些填充代码）因为它只是暂时删除向量的类，将其传递给下一个S3特定的类，然后恢复原始类。这意味着矩阵的
drop
参数将得到尊重，如果设置为TRUE（默认值）下标是这样的，matrixness被删除，这意味着
dim
属性从返回的对象中删除

问题是廉价包装中的类还原还原了我们的矩阵类，因此，当廉价包装返回时，我们收到一个没有
dim
属性的矩阵类对象

当我们尝试打印子集向量时，
print.POSIXct（）
shim实际上会发出我们遇到的确切错误（“为函数“print”选择方法时计算参数“x”的错误：base:：matrix（…）：非数值矩阵范围中的错误”）是由
nrow（x）引起的
返回NULL，因此
matrix（）
调用接收nrow=NULL

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

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

这个新函数的创建很复杂，因为便宜的包装器使用
NextMethod（）
调用下一个S3特定的函数，如果从直接调用的调用中调用，则该函数无效，而与S3调度过程无关。因此，正如您在下面的代码中所看到的，我使用了一些技巧来“插入”将廉价包装器的主体放入我们的shim函数中，从而将
NextMethod（）
调用移动到我们的shim中，因此必须通过泛型
`[`（）
调用它（通常）：

演示：

另一种方法是在存储到矩阵和数组中时接受丢失S3信息，并在需要时转换为POSIXct

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

asPOSIXctFromNumeric我调整了@bgoldst的答案，对class属性进行了重新排序，使矩阵排在第一位：

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
}

因此，它的使用仍然非常不安全。
为什么不将它们存储在
data.frame中
@mtoto：我看到POSIXct可以很好地处理data.frames。但是，最终我想将这项工作扩展到多维数组。此外，在其他数值变量上重新构造现有代码以实现一致性也不是一个好的选择。然后
m
是长度为6的向量，不再是矩阵。@patrickrooks-
是.matrix（m）
=
TRUE
-尝试打印.default（m）
，你会看到它确实是一个矩阵。这是非常好的，尽管其他一些方法，例如，
格式，
difftime
，…，需要进行调整才能真正有用。非常好。你可能会将%class（x）
中的
矩阵“%s”更改为
继承（x，“矩阵”）
than适用于此解决方案。现在我了解了不同S3类的竞争方法的麻烦。虽然它似乎工作得很好，但已经有一个简单的子集造成了麻烦：
m[1，]
产生了一个错误
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()

`[.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 <- 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 <- function(x,...) {
    if (inherits(x,'matrix') && !is.null(dim(x)))
        summary(as.data.frame(x),...)
    else
        base::summary.POSIXct(x,...);
}; ## end summary.POSIXct()

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

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]