How to create a matrix of POSIXct

半腔热情 提交于 2021-01-28 03:23:58

问题


When I create a matrix given POSIXct vector in R 3.1.2 , the entries of the matrix are numeric instead of POSIXct:

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

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

What is the best way to create a matrix of POSIXct values?


回答1:


I don't think I've ever seen someone create a matrix of POSIXct values before, although it's not difficult to imagine use-cases for such an object.

R doesn't seem to support this type of object very well. The S3 object system is quite limited, and creating a matrix of POSIXct requires setting both matrix and POSIXct (and POSIXt, which always seems to tag along with POSIXct) S3 classes. In fact, in my experience, it's quite unusual for any object to inherit from multiple explicit S3 classes, perhaps excepting the case of POSIXct+POSIXt and POSIXlt+POSIXt.

I've whipped up an attempt to shim this type of object by creating a new matrix constructor function matrix.POSIXct(). For convenience, to provide S3 dispatch, I also created a new generic matrix() and default matrix.default() that delegates to the normal base::matrix(). Note that this genericization of matrix() is sometimes done by R packages, such as gmp. They confine their genericization functions to their package environment, but I'm just dumping these functions into the global environment.

Unfortunately, the default POSIXct print function print.POSIXct() is not smart enough to handle POSIXct vectors that are also classed as a matrix, so any such matrix would print as a plain old vector. To solve this problem, I also created a new print.POSIXct() function that intercepts the printing of any POSIXct-classed object and checks if it's also classed as a matrix, in which case, to provide a sensible implementation with minimal work, I build a new matrix whose data values consist of the character representation of the POSIXct values, and then I print that matrix. If it's not classed as a matrix, I simply pass the arguments to the normal base::print.POSIXct() function to print the plain old non-matrix POSIXct vector.

I've tried to follow the design of base::matrix() as closely as possible with respect to defaulting missing arguments in 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()

Demo on your data:

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

Here's a 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()

Right, forgot about indexing. This was another problematic case. The default base::`[.POSIXct`() indexing function is kind of cheap (sort of like some of my shim code above, admittedly) in that it just temporarily removes the classes of the vector, passes it to the next S3 specific, and then restores the original classes. This means the drop argument for matrices is respected, which, if set to TRUE (the default) and the subscripts are such that the matrixness is dropped, means the dim attribute is removed from the returned object.

The problem is that the class restoration in the cheap wrapper restores our matrix class, and so, when the cheap wrapper returns, we receive a matrix-classed object with no dim attribute.

The exact error we run into, which is actually emitted by the print.POSIXct() shim if and when we attempt to print the subsetted vector ("error in evaluating the argument 'x' in selecting a method for function 'print': Error in base::matrix(...) : non-numeric matrix extent") is caused by nrow(x) returning NULL, and thus the matrix() call receives nrow=NULL.

I've done two things to fix this. First, I improved the print.POSIXct() function to guard against the case of nrow(x) returning NULL, in which case it won't treat the object-to-print as a matrix after all. Thus, if it ever receives a matrix-classed object with no dim attribute (although this properly shouldn't happen) it will print it as a plain old POSIXct vector.

Second, I wrote another indexing function to detect the removal of the dim attribute and accordingly remove the matrix class in that case.

The creation of this new function was complicated by the fact that the cheap wrapper uses NextMethod() to invoke the next S3 specific, which is not valid if called from a call that was invoked directly, independent of the S3 dispatch process. Thus, as you can see in the code below, I use a bit of a hack to "insert" the body of the cheap wrapper into our shim function, thereby moving the NextMethod() invocation into our shim, which thus must be called via the generic `[`() (as usual):

`[.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`);

Demo:

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"

Here's an 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()

Demo:

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

Here's a 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()



回答2:


A crude method is to reassign the class and the attributes to the matrix:

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

But this is cumbersome and error-prone. In a loop I would have to check if the the entry is POSIXct or not.




回答3:


Another resort is to accept loosing the S3 information when storing into matrix and arrays and converting to POSIXct when needed. This can be done with the following function

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



回答4:


I adjusted the answer of @bgoldst by reordering the class attribute so that matrix comes first:

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
}

The result works closer to what I expect. However, there is still trouble with some primitive functions. The following result in vectors instead of matrices:

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

Hence, its still very unsafe to use.



来源:https://stackoverflow.com/questions/35172317/how-to-create-a-matrix-of-posixct

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!