[Rd] Formatting difftime objects

[Jeffrey Horner]

I like the new difftime functionality. Here's a dataframe of 5k run times:
 > r5k
          race                date     totaltime          pace     mile
1     RUDOLPH 2004-12-03 19:00:00 27.76667 mins 8.937224 mins 3.106856
2     RUDOLPH 2005-12-02 18:30:00 25.28333 mins 8.137916 mins 3.106856
3   FROSTBITE 2005-12-10 07:00:00 24.75000 mins 7.966253 mins 3.106856
4    JUDICATA 2006-03-04 08:00:00 25.51667 mins 8.213019 mins 3.106856
5    TOM KING 2006-03-18 07:00:00 23.71667 mins 7.633655 mins 3.106856
6     RUDOLPH 2006-12-01 18:30:00 24.21667 mins 7.794589 mins 3.106856
7  FATHERHOOD 2006-06-24 07:00:00 23.51667 mins 7.569281 mins 3.106856
8 FIRECRACKER 2006-07-04 07:00:00 23.53333 mins 7.574646 mins 3.106856
9  FANGTASTIC 2007-02-10 10:00:00 22.86667 mins 7.360067 mins 3.106856

But I thought the formatting could use some help, so I re-wrote 
base::format.difftime and added support for the conversion 
specifications '%W', '%d', '%H', '%M', and '%S' (borrowed from 
strftime). It also honors getOption("digits") and 
getOption(digits.secs") for '%S'. I added support for a "format" 
attribute as well:

 > attr(r5k$pace,"format") <- "%M:%S"
 > attr(r5k$totaltime,"format") <- "%M:%S"
 > r5k
          race                date totaltime  pace     mile
1     RUDOLPH 2004-12-03 19:00:00     27:46 08:56 3.106856
2     RUDOLPH 2005-12-02 18:30:00     25:17 08:08 3.106856
3   FROSTBITE 2005-12-10 07:00:00     24:45 07:58 3.106856
4    JUDICATA 2006-03-04 08:00:00     25:31 08:13 3.106856
5    TOM KING 2006-03-18 07:00:00     23:43 07:38 3.106856
6     RUDOLPH 2006-12-01 18:30:00     24:13 07:48 3.106856
7  FATHERHOOD 2006-06-24 07:00:00     23:31 07:34 3.106856
8 FIRECRACKER 2006-07-04 07:00:00     23:32 07:34 3.106856
9  FANGTASTIC 2007-02-10 10:00:00     22:52 07:22 3.106856

Formats can also be passed as an argument:

 > format(sum(r5k$totaltime),"%W:%d:%H:%M:%S")
[1] "00:00:03:41:10"
 > format(sum(r5k$totaltime),"%W:%d")
[1] "00:0.1535880"
 > format(sum(r5k$totaltime),"%W")
[1] "0.0219411"

My code is a little verbose, and I'm looking for some optimizations. If 
anyone has comments, suggestions, I'd be much obliged.

Here's the code:
format.difftime <- function (x,format=NULL,...)
{
     # Look for a "format" attribute, if null then return basics
     if (is.null(format)){
         if (is.null(attr(x,"format")))
             return(paste(format(unclass(x),...), units(x)))
         else
             format <- rep(attr(x,"format"),length(x))
     } else {
         format <- rep(format,length(x))
     }

     units(x)<-'secs'

     rem <- unclass(x)

     w <- d <- h <- m <- s <- array(0,length(x))
     lunit <- ""
     if (length(grep('%W',format,fixed=TRUE)) > 0 ){
         w     <- rem %/% (7 * 86400)
         rem   <- rem - w * 7 * 86400
         lunit <- "weeks"
     }
     if (length(grep('%d',format,fixed=TRUE)) > 0){
         d     <- rem %/% 86400
         rem   <- rem - d * 86400
         lunit <- "days"
     }
     if (length(grep('%H',format,fixed=TRUE)) > 0){
         h     <- rem %/% 3600
         rem   <- rem - h * 3600
         lunit <- "hours"
     }
     if (length(grep('%M',format,fixed=TRUE)) > 0){
         m     <- rem %/% 60
         rem   <- rem  - m *  60
         lunit <- "mins"
     }
     if (length(grep('%S',format,fixed=TRUE)) > 0){
         s     <- rem
         rem   <- rem - s
         lunit <- "secs"
     }

     # Find precision formatting
     digits <-
         ifelse(is.null(getOption("digits")),
             0,
             as.integer(getOption("digits"))
         )
     digits.secs <-
         ifelse(is.null(getOption("digits.secs")),
             0,
             as.integer(getOption("digits.secs"))
         )

     # Place remainder in last unit we saw.
     # Also set formatting.
     wf <- df <- hf <- mf <- sf <- "%02.f"
     if (lunit != ""){
         if (lunit == "weeks"){
             w <- w + rem / (7 * 86400)
             wf <- paste("%02.",digits,"f",sep='')
         } else if (lunit == "days"){
             d <- d + rem / 86400
             df <- paste("%02.",digits,"f",sep='')
         } else if (lunit == "hours"){
             h <- h + rem / 3600
             hf <- paste("%02.",digits,"f",sep='')
         } else if (lunit == "mins"){
             m <- m + rem / 60
             mf <- paste("%02.",digits,"f",sep='')
         } else if (lunit == "secs"){
             sf <- paste("%02.",digits.secs,"f",sep='')
         }
     }


     # Do substitution
     for (i in 1:length(format)){
         format[i] <- gsub('%W',sprintf(wf,w[i]),format[i],fixed=TRUE)
         format[i] <- gsub('%d',sprintf(df,d[i]),format[i],fixed=TRUE)
         format[i] <- gsub('%H',sprintf(hf,h[i]),format[i],fixed=TRUE)
         format[i] <- gsub('%M',sprintf(mf,m[i]),format[i],fixed=TRUE)
         format[i] <- gsub('%S',sprintf(sf,s[i]),format[i],fixed=TRUE)
     }

     format
}


Cheers,

Jeff
-- 
http://biostat.mc.vanderbilt.edu/JeffreyHorner