SCM

SCM Repository

[latticeextra] Annotation of /pkg/R/timeseries.R
ViewVC logotype

Annotation of /pkg/R/timeseries.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 65 - (view) (download)

1 : deepayan 2
2 : felix 65
3 :     xyplot.ts <-
4 :     function(x, data = NULL, type = 'l',
5 :     auto.key = TRUE,
6 :     cut = FALSE,
7 :     default.scales = list(),
8 :     ...)
9 :     ## TODO: a way to specify styles for each series in 'x'? (by name?)
10 :     ## TODO: and allow series in 'x' to be grouped into separate panels?
11 :     {
12 :     stopifnot(is.null(data))
13 :     ocall <- sys.call(sys.parent())
14 :     data <- as.data.frame(x)
15 :     nm <- names(data)
16 :     unm <- make.names(c(nm, "Time"), unique = TRUE)
17 :     names(data) <- unm[-length(unm)]
18 :     tnm <- unm[length(unm)]
19 :     data[[tnm]] <- as.vector(time(x))
20 :     if (is.logical(cut) && cut) cut <- list()
21 :     if (is.list(cut))
22 :     {
23 :     ecargs <- list(x = data[[tnm]])
24 :     ecargs <- lattice:::updateList(ecargs, cut)
25 :     data[[tnm]] <- do.call(equal.count, ecargs)
26 :     ## tnm will work as numeric x-variable too
27 :     form <-
28 :     as.formula(sprintf("%s ~ %s | %s",
29 :     paste(lapply(unm[-length(unm)], as.name), collapse = "+"),
30 :     tnm, tnm))
31 :     default.scales <-
32 :     lattice:::updateList(list(x = list(relation = "sliced")),
33 :     default.scales)
34 :     }
35 :     else
36 :     {
37 :     form <-
38 :     as.formula(sprintf("%s ~ %s",
39 :     paste(lapply(unm[-length(unm)], as.name), collapse = "+"),
40 :     tnm))
41 :     }
42 :     if (is.logical(auto.key) && auto.key) auto.key <- list()
43 :     if (is.list(auto.key))
44 :     auto.key <-
45 :     modifyList(list(lines = TRUE, points = FALSE),
46 :     auto.key)
47 :     ans <- xyplot(form, data = data, type = type, auto.key = auto.key,
48 :     default.scales = default.scales, ...)
49 :     ans$call <- ocall
50 :     ans
51 :     }
52 :    
53 :     llines.ts <-
54 :     function(x, y = NULL, ...)
55 :     {
56 :     if (!is.null(y)) {
57 :     llines(as.vector(x), y = y, ...)
58 :     } else {
59 :     llines(as.vector(time(x)), y = as.vector(x), ...)
60 :     }
61 :     }
62 :    
63 :    
64 : felix 54 xyplot.stl <-
65 : deepayan 2 function(x, data = NULL,
66 :     outer = TRUE,
67 :     layout = c(1, 4),
68 : felix 54 strip = FALSE,
69 : deepayan 2 strip.left = TRUE,
70 :     as.table = TRUE,
71 :     ylab = "",
72 :     between = list(y = 0.5),
73 : felix 54 panel =
74 : deepayan 2 function(..., type) {
75 :     if (packet.number() == 4) type <- "h"
76 :     panel.xyplot(..., type = type)
77 :     },
78 :     ...)
79 :     {
80 :     stopifnot(is.null(data))
81 :     mstrip <- missing(strip.left)
82 :     sers <- x$time.series
83 :     ## ncomp <- ncol(sers)
84 :     data <- rowSums(sers)
85 :     X <- cbind(data, sers)
86 :     colnames(X) <- c("data", colnames(sers))
87 : felix 54 ans <-
88 : deepayan 2 xyplot(X,
89 : felix 54 outer = outer,
90 : deepayan 2 layout = layout,
91 : felix 54 strip = strip,
92 : deepayan 2 strip.left = strip.left,
93 :     as.table = as.table,
94 :     ylab = ylab,
95 :     between = between,
96 :     panel = panel,
97 :     ...,
98 : felix 54 default.scales =
99 : deepayan 2 list(x = list(axs = "i"),
100 : felix 54 y =
101 :     list(relation = "free",
102 : deepayan 2 tick.number = 3,
103 :     rot = 0)))
104 :     if (mstrip)
105 :     {
106 :     mx <- min(rx <- abs(sapply(ans$y.limits, diff)))
107 :     int <- cbind(-mx / rx, mx / rx)
108 : felix 54 ans <-
109 :     update(ans,
110 :     strip.left =
111 : deepayan 2 strip.custom(horizontal = FALSE,
112 :     strip.names = FALSE,
113 :     strip.levels = TRUE,
114 :     shingle.intervals = int))
115 :     }
116 :     ans
117 :     }
118 :    
119 :    
120 :    

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge