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 2 - (view) (download)

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

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