[Xts-commits] r640 - pkg/xtsExtra/R/xtsdf

[noreply at r-forge.r-project.org]

Author: weylandt
Date: 2012-06-19 19:32:30 +0200 (Tue, 19 Jun 2012)
New Revision: 640

Added:
   pkg/xtsExtra/R/xtsdf/simpleS3.xtsdf.R
Modified:
   pkg/xtsExtra/R/xtsdf/subset.print.xtsdf.R
   pkg/xtsExtra/R/xtsdf/xtsdf.R
Log:
str method for xtsdf

Added: pkg/xtsExtra/R/xtsdf/simpleS3.xtsdf.R
===================================================================
--- pkg/xtsExtra/R/xtsdf/simpleS3.xtsdf.R	                        (rev 0)
+++ pkg/xtsExtra/R/xtsdf/simpleS3.xtsdf.R	2012-06-19 17:32:30 UTC (rev 640)
@@ -0,0 +1,30 @@
+#   xtsExtra: Extensions to xts during GSOC-2012
+#
+#   Copyright (C) 2012  Michael Weylandt: michael.weylandt at gmail.com
+#
+#   This program is free software: you can redistribute it and/or modify
+#   it under the terms of the GNU General Public License as published by
+#   the Free Software Foundation, either version 3 of the License, or
+#   (at your option) any later version.
+#
+#   This program is distributed in the hope that it will be useful,
+#   but WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#   GNU General Public License for more details.
+#
+#   You should have received a copy of the GNU General Public License
+#   along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+## A collection of simple but useful S3 generics
+
+index.xtsdf <- function(x, ...) index(x[[1]], ...)
+
+as.list.xtsdf <- function(x, ...) unclass(x)
+
+dim.xtsdf <- function(x) c(length(x[[1]]), length(x))
+
+dimnames.xtsdf <- function(x) list(index(x), names(x))
+
+as.zoo.xtsdf <- function(x, ...) as.zoo(as.xts(x, ...), ...)
+

Modified: pkg/xtsExtra/R/xtsdf/subset.print.xtsdf.R
===================================================================
--- pkg/xtsExtra/R/xtsdf/subset.print.xtsdf.R	2012-06-19 16:33:00 UTC (rev 639)
+++ pkg/xtsExtra/R/xtsdf/subset.print.xtsdf.R	2012-06-19 17:32:30 UTC (rev 640)
@@ -21,4 +21,22 @@
   print(as.data.frame(x, row.names = index(x)), ...)
 }
 
-str.xtsdf <- function(object, ...) {}
+str.xtsdf <- function(object, ...) {
+  cat(paste("An", sQuote("xtsdf"), "object from", index(first(object[[1]])), 
+            "to", index(last(object[[1]])),"containing",NROW(object),"observations of",NCOL(object),"variables:\n\n"))
+  
+  for(i in seq_len(NCOL(object))){
+    # Should align names more attractively? 
+    
+    cat(" ", names(object)[i],"$: ")
+    str(coredata(object[[i]]))
+  }
+  cat("\n")
+  cat(paste("  Indexed by objects of class: "))
+  cat(paste("[", paste(indexClass(object), collapse = ","), 
+            "] ", sep = ""))
+  cat(paste("TZ: ", indexTZ(object), "\n", sep = ""))
+  if (!is.null(CLASS(object))) 
+    cat(paste("  Original class: '", CLASS(object), "' ", 
+              sep = ""), "\n")
+}

Modified: pkg/xtsExtra/R/xtsdf/xtsdf.R
===================================================================
--- pkg/xtsExtra/R/xtsdf/xtsdf.R	2012-06-19 16:33:00 UTC (rev 639)
+++ pkg/xtsExtra/R/xtsdf/xtsdf.R	2012-06-19 17:32:30 UTC (rev 640)
@@ -69,7 +69,3 @@
   xts(do.call("cbind", x), ...)
 }
 
-index.xtsdf <- function(x, ...) index(x[[1]], ...)
-
-as.list.xtsdf <- function(x, ...) unclass(x)
-