SCM

SCM Repository

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

Annotation of /pkg/R/horizonplot.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 193 - (view) (download)

1 : felix 148 ##
2 :     ## Copyright (c) 2010 Felix Andrews <felix@nfrac.org>
3 :     ## GPL version 2 or newer
4 :    
5 :     horizonplot <- function(x, data, ...)
6 :     UseMethod("horizonplot")
7 :    
8 :     horizonplot.default <-
9 :     function(x, data = NULL, ...,
10 : deepayan 193 nbands = 3L,
11 : felix 164 horizonscale = NA,
12 : felix 161 origin = function(y) na.omit(y)[1],
13 :     colorkey = FALSE, legend = NULL,
14 : felix 148 panel = panel.horizonplot,
15 :     prepanel = prepanel.horizonplot,
16 : deepayan 192 col.regions = brewer.pal(n = 2 * nbands, name = "RdYlBu"),
17 : felix 148 strip = FALSE, strip.left = TRUE,
18 :     par.strip.text = list(cex = 0.6),
19 : deepayan 193 colorkey.digits = 3,
20 :     layout = c(1, NA),
21 : felix 148 groups = NULL,
22 :     default.scales =
23 : felix 161 list(y = list(relation = "free", axs = "i",
24 : felix 148 draw = FALSE, tick.number = 2)))
25 :     {
26 :     if (!is.null(groups))
27 :     stop("'groups' does not work in this plot")
28 :     ans <- xyplot(x, data = data, ...,
29 : felix 161 origin = origin, horizonscale = horizonscale,
30 : felix 148 panel = panel, prepanel = prepanel,
31 : felix 161 col.regions = col.regions,
32 : felix 148 strip = strip, strip.left = strip.left,
33 :     par.strip.text = par.strip.text,
34 : deepayan 193 layout = layout,
35 : deepayan 192 default.scales = default.scales,
36 :     nbands = nbands)
37 : felix 148 ans$call <- match.call()
38 : felix 161 ## add colorkey
39 : deepayan 192 if (isTRUE(colorkey)) colorkey <- list()
40 :     if (is.list(colorkey))
41 :     {
42 :     bands.at <- seq(-nbands, nbands)
43 : felix 161 if (ans$y.scales$relation == "same") {
44 :     origin <- ans$y.limits[1]
45 :     horizonscale <- diff(ans$y.limits)
46 :     }
47 :     if (is.na(horizonscale)) {
48 : deepayan 192 ## labels <- expression(
49 :     ## - 3 * Delta[i], - 2 * Delta[i], - 1 * Delta[i], 0,
50 :     ## + 1 * Delta[i], + 2 * Delta[i], + 3 * Delta[i], 0)
51 :     labels <- parse(text = sprintf("%+d * Delta[i]", bands.at))
52 :     labels[nbands + 1] <- if (is.numeric(origin)) origin else "origin"
53 :     }
54 :     else {
55 : felix 161 if (is.numeric(origin)) {
56 : deepayan 192 labels <- round(origin + bands.at * horizonscale, colorkey.digits)
57 : felix 161 } else {
58 : deepayan 192 labels <- sprintf("%+g", round(bands.at * horizonscale, colorkey.digits))
59 :     labels[nbands + 1] <- "origin"
60 : felix 161 }
61 :     }
62 : deepayan 192 ii <- round(seq(1, length(col.regions), length.out = 2 * nbands))
63 : felix 161 colorkey <-
64 : deepayan 192 modifyList(list(col = col.regions[ii], at = bands.at,
65 :     labels = list(labels = labels, at = bands.at)),
66 : felix 161 colorkey)
67 :     space <- colorkey$space
68 :     if (is.null(space)) space <- "right"
69 :     if (is.null(legend)) legend <- list()
70 :     legend[[space]] <- list(fun = "draw.colorkey",
71 : deepayan 192 args = list(colorkey))
72 : felix 161 ans <- update(ans, legend = legend)
73 :     }
74 : felix 148 ans
75 :     }
76 :    
77 :    
78 :     panel.horizonplot <-
79 : felix 161 function(x, y, ..., border = NA,
80 : deepayan 192 nbands = 3L,
81 :     col.regions = brewer.pal(n = 2 * nbands, name = "RdYlBu"),
82 : felix 161 origin) ## catch origin, don't pass to panel.xyarea!
83 : felix 148 {
84 :     regions <- trellis.par.get("regions")
85 : deepayan 192 origin <- current.panel.limits()$ylim[1]
86 :     scale <- diff(current.panel.limits()$ylim)
87 : felix 148 ## ordered for drawing, from least extreme to most extreme
88 : deepayan 192 #sections <- c(0, -1, 1, -2, 2, -3) ## these are the lower bounds
89 :     sections <- as.vector(rbind(seq_len(nbands)-1, -seq_len(nbands)))
90 :     #ii <- round(((sections + 3) / 5) * (length(col.regions)-1)) + 1
91 :     ii <- round(((sections + nbands) / (2*nbands-1)) * (length(col.regions)-1)) + 1
92 :     #ii <- sections + nbands + 1
93 : felix 148 col <- col.regions[ii]
94 :     for (i in seq_along(sections)) {
95 :     section <- sections[i]
96 :     yi <- y
97 :     if (section < 0) {
98 :     yi <- origin + origin - y
99 :     section <- abs(section) - 1
100 :     }
101 :     baseline <- origin + section * scale
102 :     if (all(yi <= baseline, na.rm = TRUE))
103 :     next
104 :     yi <- yi - baseline
105 :     yi <- origin + pmax(pmin(yi, scale), 0)
106 : felix 179 panel.xyarea(x, yi, border = border, col = col[i], col.line = col[i], ...)
107 : felix 148 }
108 :     }
109 :    
110 :     prepanel.horizonplot <-
111 : felix 164 function(x, y, ..., horizonscale = NA,
112 : deepayan 193 nbands = 3L,
113 :     origin = function(y) na.omit(y)[1])
114 : felix 148 {
115 :     if (is.function(origin))
116 :     origin <- origin(y)
117 :     ans <- prepanel.default.xyplot(x, y, ...)
118 : felix 161 if (is.na(horizonscale))
119 : deepayan 192 horizonscale <- max(abs(ans$ylim - origin)) / nbands
120 : felix 161 ans$ylim <- origin + c(0, horizonscale)
121 : felix 148 ans
122 :     }

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