[Xts-commits] r645 - in pkg/xtsExtra: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jun 20 01:09:56 CEST 2012
Author: weylandt
Date: 2012-06-20 01:09:56 +0200 (Wed, 20 Jun 2012)
New Revision: 645
Added:
pkg/xtsExtra/R/groupGenerics.R
Modified:
pkg/xtsExtra/NAMESPACE
pkg/xtsExtra/R/bind.merge.R
pkg/xtsExtra/R/simpleS3.xtsdf.R
pkg/xtsExtra/R/xtsdf.R
Log:
Group generics and a few more S3 methods
Modified: pkg/xtsExtra/NAMESPACE
===================================================================
--- pkg/xtsExtra/NAMESPACE 2012-06-19 21:43:11 UTC (rev 644)
+++ pkg/xtsExtra/NAMESPACE 2012-06-19 23:09:56 UTC (rev 645)
@@ -38,18 +38,23 @@
S3method(HoltWinters, xts)
# WHY DON'T DEPENDENCIES COVER THESE IMPORTS?
+import(stats)
+import(utils)
+import(xts)
+import(zoo)
-importFrom("stats", pacf)
-importFrom("xts", as.xts, indexTZ)
-importFrom("zoo", index, as.zoo)
-
## Data frame capability
+S3method(Ops, xtsdf)
+S3method(Summary, xtsdf)
+S3method(Math, xtsdf)
export("xtsdf")
export("as.xtsdf")
S3method(as.xtsdf, xts)
S3method(as.xtsdf, data.frame)
+S3method(as.xtsdf, xtsdf)
+S3method(as.xtsdf, matrix)
S3method(as.data.frame, xtsdf)
S3method(as.xts, xtsdf)
@@ -65,11 +70,22 @@
export(is.xtsdf)
S3method(index, xtsdf)
+S3method(time, xtsdf)
+S3method(indexTZ, xtsdf)
+
+S3method(`index<-`, xtsdf)
+S3method(`time<-`, xtsdf)
+S3method(`indexTZ<-`, xtsdf)
+
S3method(as.list, xtsdf)
S3method(dim, xtsdf)
S3method(dimnames, xtsdf)
S3method(as.zoo, xtsdf)
-S3method(indexTZ, xtsdf)
+S3method(lag, xtsdf)
+S3method(summary, xtsdf)
+S3method(head, xtsdf)
+S3method(tail, xtsdf)
+S3method(coredata, xtsdf)
#### NEED TO MAKE INDEX CLASS A S3 GENERIC FOR NOW
export("indexClass")
Modified: pkg/xtsExtra/R/bind.merge.R
===================================================================
--- pkg/xtsExtra/R/bind.merge.R 2012-06-19 21:43:11 UTC (rev 644)
+++ pkg/xtsExtra/R/bind.merge.R 2012-06-19 23:09:56 UTC (rev 645)
@@ -15,6 +15,8 @@
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
+# When to do joins/merges xts style and df style?
+
c.xtsdf <- function(...){
}
Added: pkg/xtsExtra/R/groupGenerics.R
===================================================================
--- pkg/xtsExtra/R/groupGenerics.R (rev 0)
+++ pkg/xtsExtra/R/groupGenerics.R 2012-06-19 23:09:56 UTC (rev 645)
@@ -0,0 +1,33 @@
+# 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/>.
+
+# Not at all committed to this --
+# should we use inner joins/merges first? Date alignment like xts? Both? Neither?
+
+Ops.xtsdf <- function(e1, e2 = NULL){
+ as.xtsdf(match.fun(.Generic)(as.data.frame(e1), e2), order.by = index(e1))
+}
+
+# This one seems solid
+Math.xtsdf <- function(x, ...){
+ .Class <- "data.frame"
+ as.xtsdf(NextMethod(.Generic), order.by = index(x))
+}
+
+Summary.xtsdf <- function(..., na.rm){
+ do.call(match.fun(.Generic), c(lapply(..., as.data.frame), na.rm = na.rm))
+}
\ No newline at end of file
Modified: pkg/xtsExtra/R/simpleS3.xtsdf.R
===================================================================
--- pkg/xtsExtra/R/simpleS3.xtsdf.R 2012-06-19 21:43:11 UTC (rev 644)
+++ pkg/xtsExtra/R/simpleS3.xtsdf.R 2012-06-19 23:09:56 UTC (rev 645)
@@ -20,6 +20,17 @@
index.xtsdf <- function(x, ...) index(x[[1]], ...)
+time.xtsdf <- index.xtsdf
+
+`index<-.xtsdf` <- function(x, value) {
+ for(i in seq_along(x)){
+ index(x[[i]]) <- value
+ }
+ x
+}
+
+`time<-.xtsdf` <- `index<-.xtsdf`
+
as.list.xtsdf <- function(x, ...) unclass(x)
dim.xtsdf <- function(x) c(length(x[[1]]), length(x))
@@ -30,11 +41,37 @@
indexTZ.xtsdf <- function(x, ...) indexTZ(x[[1]])
+`indexTZ<-.xtsdf` <- function(x, value) {
+ for(i in seq_along(x)){
+ indexTZ(x[[i]]) <- value
+ }
+ x
+}
+lag.xtsdf <- function(x, k = 1, na.pad = TRUE, ...) {
+ ans <- lapply(x, lag, k = 1, na.pad = TRUE, ...)
+ class(ans) <- "xtsdf"
+ ans
+}
+
+summary.xtsdf <- function(object, ...) summary(cbind(index = index(object),
+ as.data.frame(object)), ...)
+
+head.xtsdf <- utils:::head.data.frame
+tail.xtsdf <- utils:::tail.data.frame
+
+coredata.xtsdf <- function(x, ...) as.data.frame(x)
+
#### NEED TO MAKE INDEX CLASS A S3 GENERIC FOR NOW
indexClass <- function(x) UseMethod("indexClass")
indexClass.xts <- xts::indexClass
-indexClass.xtsdf <- function(x) indexClass(x[[1]])
\ No newline at end of file
+indexClass.xtsdf <- function(x) indexClass(x[[1]])
+
+`indexClass<-.xtsdf` <- function(x, value){
+ for(i in seq_along(x)){
+ indexClass(x[[i]]) <- value
+ }
+}
\ No newline at end of file
Modified: pkg/xtsExtra/R/xtsdf.R
===================================================================
--- pkg/xtsExtra/R/xtsdf.R 2012-06-19 21:43:11 UTC (rev 644)
+++ pkg/xtsExtra/R/xtsdf.R 2012-06-19 23:09:56 UTC (rev 645)
@@ -60,6 +60,8 @@
ans
}
+as.xtsdf.matrix <- function(x, ...) as.xtsdf(as.data.frame(x), ...)
+
as.data.frame.xtsdf <- function(x, row.names = NULL, optional = FALSE, ...){
row.names <- if(is.null(row.names)) index(x) else row.names
@@ -70,3 +72,4 @@
xts(do.call("cbind", x), ...)
}
+as.xtsdf.xtsdf <- function(x, ...) x
More information about the Xts-commits
mailing list