SCM

SCM Repository

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

Diff of /pkg/R/horizonplot.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 148, Tue Jun 1 11:51:52 2010 UTC revision 161, Sat Jul 24 03:50:13 2010 UTC
# Line 2  Line 2 
2  ## Copyright (c) 2010 Felix Andrews <felix@nfrac.org>  ## Copyright (c) 2010 Felix Andrews <felix@nfrac.org>
3  ## GPL version 2 or newer  ## GPL version 2 or newer
4    
   
5  horizonplot <- function(x, data, ...)  horizonplot <- function(x, data, ...)
6      UseMethod("horizonplot")      UseMethod("horizonplot")
7    
8  horizonplot.default <-  horizonplot.default <-
9      function(x, data = NULL, ...,      function(x, data = NULL, ...,
10                 origin = function(y) na.omit(y)[1],
11                 horizonscale = NA,
12                 colorkey = FALSE, legend = NULL,
13               panel = panel.horizonplot,               panel = panel.horizonplot,
14               prepanel = prepanel.horizonplot,               prepanel = prepanel.horizonplot,
15                 col.regions = c("#B41414","#E03231","#F7A99C","#9FC8DC","#468CC8","#0165B3"),
16               strip = FALSE, strip.left = TRUE,               strip = FALSE, strip.left = TRUE,
17               par.strip.text = list(cex = 0.6),               par.strip.text = list(cex = 0.6),
18                 colorkey.digits = 3,
19               #layout = c(1, NA), ## TODO pending new lattice release               #layout = c(1, NA), ## TODO pending new lattice release
20               groups = NULL,               groups = NULL,
21               default.scales =               default.scales =
22                 list(y = list(relation = "sliced", axs = "i",                 list(y = list(relation = "free", axs = "i",
23                               draw = FALSE, tick.number = 2)))                               draw = FALSE, tick.number = 2)))
24  {  {
25      if (!is.null(groups))      if (!is.null(groups))
26          stop("'groups' does not work in this plot")          stop("'groups' does not work in this plot")
27      ans <- xyplot(x, data = data, ...,      ans <- xyplot(x, data = data, ...,
28                      origin = origin, horizonscale = horizonscale,
29                    panel = panel, prepanel = prepanel,                    panel = panel, prepanel = prepanel,
30                      col.regions = col.regions,
31                    strip = strip, strip.left = strip.left,                    strip = strip, strip.left = strip.left,
32                    par.strip.text = par.strip.text,                    par.strip.text = par.strip.text,
33                    #layout = layout,                    #layout = layout,
34                    default.scales = default.scales)                    default.scales = default.scales)
35      ans$call <- match.call()      ans$call <- match.call()
36        ## add colorkey
37        if (isTRUE(colorkey)) {
38            colorkey <- list()
39        }
40        if (is.list(colorkey)) {
41            if (ans$y.scales$relation == "same") {
42                origin <- ans$y.limits[1]
43                horizonscale <- diff(ans$y.limits)
44            }
45            if (is.na(horizonscale)) {
46                labels <- expression(
47                    - 3 * Delta[i], - 2 * Delta[i], - 1 * Delta[i], 0,
48                    + 1 * Delta[i], + 2 * Delta[i], + 3 * Delta[i], 0)
49                if (is.numeric(origin)) {
50                    labels[4] <- origin
51                } else {
52                    labels[4] <- "origin"
53                }
54            } else {
55                if (is.numeric(origin)) {
56                    labels <- round(origin + (-3:3) * horizonscale, colorkey.digits)
57                } else {
58                    labels <- paste(ifelse(-3:3>=0,"+","-"),
59                                    round(abs(-3:3) * horizonscale, colorkey.digits))
60                    labels[4] <- "origin"
61                }
62            }
63            ii <- round((0:5 / 5) * (length(col.regions)-1)) + 1
64            colorkey <-
65                modifyList(list(col = col.regions[ii], at = -3:3,
66                                labels = list(labels = labels, at = -3:3)),
67                           colorkey)
68            space <- colorkey$space
69            if (is.null(space)) space <- "right"
70            if (is.null(legend)) legend <- list()
71            legend[[space]] <- list(fun = "draw.colorkey",
72                                    args = list(colorkey))
73            ans <- update(ans, legend = legend)
74        }
75      ans      ans
76  }  }
77    
78    
79  panel.horizonplot <-  panel.horizonplot <-
80      function(x, y, ..., origin,      function(x, y, ..., border = NA,
81               border = NA, col.regions = regions$col)               col.regions = c("#B41414","#E03231","#F7A99C","#9FC8DC","#468CC8","#0165B3"),
82                 origin) ## catch origin, don't pass to panel.xyarea!
83  {  {
84      regions <- trellis.par.get("regions")      regions <- trellis.par.get("regions")
85      origin <- current.panel.limits()$y[1]      origin <- current.panel.limits()$y[1]
86      scale <- diff(current.panel.limits()$y)      scale <- diff(current.panel.limits()$y)
87      ## ordered for drawing, from least extreme to most extreme      ## ordered for drawing, from least extreme to most extreme
88      sections <- c(0, -1, 1, -2, 2, -3, 3, -4) ## these are the lower bounds      sections <- c(0, -1, 1, -2, 2, -3) ## these are the lower bounds
89      ii <- quantile(seq_along(col.regions),      ii <- round(((sections + 3) / 5) * (length(col.regions)-1)) + 1
                    (sections - min(sections)) / (length(sections)-1),  
                    type = 1)  
90      col <- col.regions[ii]      col <- col.regions[ii]
91      for (i in seq_along(sections)) {      for (i in seq_along(sections)) {
92          section <- sections[i]          section <- sections[i]
# Line 61  Line 105 
105  }  }
106    
107  prepanel.horizonplot <-  prepanel.horizonplot <-
108      function(x, y, ..., origin = function(y) na.omit(y)[1])      function(x, y, ..., origin = function(y) na.omit(y)[1],
109                 horizonscale = NA)
110  {  {
111      if (is.function(origin))      if (is.function(origin))
112          origin <- origin(y)          origin <- origin(y)
113      ans <- prepanel.default.xyplot(x, y, ...)      ans <- prepanel.default.xyplot(x, y, ...)
114      scale <- max(abs(ans$ylim - origin)) / 3      if (is.na(horizonscale))
115      ans$ylim <- origin + c(0, scale)          horizonscale <- max(abs(ans$ylim - origin)) / 3
116        ans$ylim <- origin + c(0, horizonscale)
117      ans      ans
118  }  }

Legend:
Removed from v.148  
changed lines
  Added in v.161

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