[Rd] Request: make as.POSIXlt generic

jhallman at frb.gov jhallman at frb.gov
Fri Feb 16 04:24:56 CET 2007


In the base package, as.POSIXct() is an S3 generic function, but
as.POSIXlt() is not.  As shown below, the current implementation is
already crying out to be refactored into a generic function with methods
for various classes.  It calls "inherits" five times. Not only is this
bad style, it also disallows me or anyone else from making as.POSIXlt()
work with other kinds of time-ish objects, such as the 'ti' (Time Index)
class in my fame package.

I would also like to see three other functions made generic: rowSums(),
rowMeans(), and filter().  This would enable Gabor to create methods for
his 'zoo' series, and let me create methods for my 'tis' (Time Indexed
Series).  But these are not as urgent as cleaning up as.POSIXlt().

Jeff Hallman



The current as.POSIXlt() implementation:

as.POSIXlt <- function(x, tz = ""){
    fromchar <- function(x) {
	xx <- x[1]
        if(is.na(xx)) {
            j <- 1
            while(is.na(xx) && (j <- j+1) <= length(x))
                xx <- x[j]
            if(is.na(xx)) f <- "%Y-%m-%d" # all NAs
        }
	if(is.na(xx) ||
           !is.na(strptime(xx, f <- "%Y-%m-%d %H:%M:%OS")) ||
	   !is.na(strptime(xx, f <- "%Y/%m/%d %H:%M:%OS")) ||
	   !is.na(strptime(xx, f <- "%Y-%m-%d %H:%M")) ||
	   !is.na(strptime(xx, f <- "%Y/%m/%d %H:%M")) ||
	   !is.na(strptime(xx, f <- "%Y-%m-%d")) ||
	   !is.na(strptime(xx, f <- "%Y/%m/%d")))
        {
	    res <- strptime(x, f)
            if(nchar(tz)) attr(res, "tzone") <- tz
            return(res)
        }
	stop("character string is not in a standard unambiguous format")
    }

    if(inherits(x, "POSIXlt")) return(x)
    if(inherits(x, "Date")) return(.Internal(Date2POSIXlt(x)))
    tzone <- attr(x, "tzone")
    if(inherits(x, "date") || inherits(x, "dates")) x <- as.POSIXct(x)
    if(is.character(x)) return(fromchar(unclass(x))) # precaution PR7826
    if(is.factor(x))	return(fromchar(as.character(x)))
    if(is.logical(x) && all(is.na(x))) x <- as.POSIXct.default(x)
    if(!inherits(x, "POSIXct"))
        stop(gettextf("do not know how to convert '%s' to class \"POSIXlt\"",
                      deparse(substitute(x))))
    if(missing(tz) && !is.null(tzone)) tz <- tzone[1]
    .Internal(as.POSIXlt(x, tz))
}



More information about the R-devel mailing list