new indexFormat'ing

coredata and print both now will respect formatting options git-svn-id: svn+ssh://svn.r-forge.r-project.org/svnroot/xts/dev/pkg@179 edb9625f-4e0d-4859-8d74-9fd3b1da38cb
joshuaulrich · Jul 29, 2008 · ef23f1c · ef23f1c
1 parent b223b2f
commit ef23f1c
Show file tree

Hide file tree

Showing 6 changed files with 68 additions and 14 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -25,9 +25,11 @@ export(reclass)
 export(endpoints)
 export(CLASS)
 export('CLASS<-')
+export(indexFormat)
+export('indexFormat<-')
 export(indexClass)
-export(convertIndex)
 export('indexClass<-')
+export(convertIndex)
 export(nseconds,
        nminutes,
        nhours,
@@ -93,10 +95,11 @@ S3method(as.xts,xts)
 S3method('[',xts)
 S3method(str,xts)
 S3method(na.omit,xts)
-#S3method(print,xts)
+S3method(print,xts)
 S3method(print,CLASS)
 S3method('CLASS<-',xts)
 S3method('indexClass<-',xts)
+S3method('indexFormat<-',xts)
 S3method('index',xts)
 S3method('index<-',xts)
 S3method('time<-',xts)

diff --git a/R/coredata.xts.R b/R/coredata.xts.R
@@ -1,7 +1,18 @@
 `coredata.xts` <-
-function(x,...) {
+function(x, fmt=FALSE, ...) {
   x.attr <- attributes(x)
 
+  if(is.character(fmt)) {
+    indexFormat(x) <- fmt
+    fmt <- TRUE
+  }
+
+  if(fmt) {
+    if(!is.null(indexFormat(x))) {
+      x.attr$dimnames[[1]] <- format(index(x), format=indexFormat(x))
+      indexFormat(x) <- NULL  # remove before printing
+    }  
+  }
   xx <- structure(x,dimnames=x.attr$dimnames) #,index=x.attr$index)
 
   # attributes not to be kept
@@ -85,7 +96,8 @@ function(x,value) {
     }
   } else
   for(nv in names(value)) {
-    if(!nv %in% c('dim','dimnames','index','class','.CLASS','.ROWNAMES','.CLASSnames'))
+    if(!nv %in% c('dim','dimnames','index','class','.CLASS','.ROWNAMES','.CLASSnames',
+                  '.indexCLASS','.indexFORMAT'))
       attr(x,nv) <- value[[nv]]
   }
   x

diff --git a/R/indexFormat.R b/R/indexFormat.R
@@ -0,0 +1,19 @@
+`indexFormat` <-
+function(x) {
+  attr(x, '.indexFORMAT')
+}
+
+`indexFormat<-` <-
+function(x, value) {
+  UseMethod('indexFormat<-')
+}
+
+`indexFormat<-.xts` <-
+function(x, value) {
+
+  if(!is.character(value) && !is.null(value))
+    stop('must provide valid POSIX formatting string')
+
+  attr(x, '.indexFORMAT') <- value
+  x
+}
diff --git a/R/print.R b/R/print.R
@@ -1,10 +1,12 @@
 `print.xts` <-
-function(x,...) {
-  x.tmp <- x
-  attributes(x.tmp) <- NULL
-  zoo:::print.zoo(structure(x.tmp,
-                            class='zoo',
-                            index=index(x),
-                            dim=dim(x),dimnames=dimnames(x)),...)
+function(x,fmt,...) {
+  if(missing(fmt)) 
+    fmt <- indexFormat(x)
+
+  xx <- as.matrix(x)
+  if(!is.null(fmt)) {
+    rownames(xx) <- format(index(x), fmt)
+  }
+  print(xx)
 }
 
diff --git a/man/coredata.xts.Rd b/man/coredata.xts.Rd
@@ -8,13 +8,14 @@ Mechanism to extract and replace the core data of an
 \code{xts} object.
 }
 \usage{
-\method{coredata}{xts}(x, ...)
+\method{coredata}{xts}(x, fmt=TRUE, ...)
 
 xcoredata(x,...)
 xcoredata(x) <- value
 }
 \arguments{
   \item{x}{ an \code{xts} object }
+  \item{fmt}{ should the rownames be formated in a non-standard way }
   \item{value}{ non-core attributes to assign }
   \item{\dots}{ further arguments [unused] }
 }
@@ -24,6 +25,13 @@ all attributes except \code{dim} and \code{dimnames} and
 returning a matrix object with rownames converted from
 the index of the \code{xts} object.
 
+The \code{fmt} argument, if TRUE, allows the internal
+index formatting specified by the user to be used. Alternatively,
+it may be a valid formatting string to be passed to \code{format}.
+Setting to FALSE will return the row names by simply
+coercing the index class to a character string in the default
+manner.
+
 \code{xcoredata} is the functional complement to
 \code{coredata}, returning all of the attributes
 normally removed by \code{coredata}.  Its purpose,

diff --git a/man/indexClass.Rd b/man/indexClass.Rd
@@ -1,21 +1,26 @@
 \name{indexClass}
 \alias{indexClass}
+\alias{indexFormat}
 \alias{convertIndex}
 \alias{indexClass<-}
+\alias{indexFormat<-}
 \title{ Extracting/Replacing the Class of an xts Index }
 \description{
-Generic functions to extract and replace the class of the index
+Generic functions to extract, replace, and format the class of the index
 of an xts object.
 }
 \usage{
 indexClass(x)
 indexClass(x) <- value
 
+indexFormat(x)
+indexFormat(x) <- value
+
 convertIndex(x,value)
 }
 \arguments{
   \item{x}{ xts object }
-  \item{value}{ desired new class. See details }
+  \item{value}{ desired new class or format. See details }
 }
 \details{
 It is possible to view and set the class of the time-index
@@ -25,6 +30,11 @@ The specified format must be a character string containing
 one of the following: \code{Date}, \code{POSIXct},
 \code{chron}, \code{yearmon}, \code{yearqtr} or \code{timeDate}.
 
+\code{indexFormat} only manages the manner in which the object
+is displayed via \code{print} (also called automatically
+when the object is returned).  The valid values
+for indexFormat are the same for \code{strptime} and \code{format}.
+
 \code{convertIndex} returns a modified \code{xts} object, and
 does \emph{not} alter the original.