SCM

SCM Repository

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

Annotation of /pkg/R/segplot.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 184 - (view) (download)

1 : deepayan 2
2 :    
3 :     ## Want to plot intervals from start to end, color coded by decoded,
4 :     ## and several in a panel according to source
5 :    
6 :     ## since there are colors involved and levelplot already
7 :     ## has a colorkey, we'll use that
8 :    
9 :    
10 :     prepanel.segplot <-
11 :     function(x, y, z, subscripts, horizontal = TRUE, ...)
12 :     {
13 :     ans <-
14 :     list(xlim = range(x[subscripts], y[subscripts], finite = TRUE),
15 : deepayan 153 ylim = if (is.factor(z)) levels(z) else range(z[subscripts], finite = TRUE),
16 : deepayan 150 yat = if (is.factor(z)) sort(unique(as.numeric(z[subscripts]))) else NULL)
17 : deepayan 2 if (horizontal) ans
18 : deepayan 150 else with(ans, list(xlim = ylim, ylim = xlim, xat = yat))
19 : deepayan 2 }
20 :    
21 : deepayan 153 ## prepanel.segplot <-
22 :     ## function(x, y, z, subscripts, horizontal = TRUE, ...)
23 :     ## {
24 :     ## isnum.z <- is.numeric(z)
25 :     ## ans <-
26 :     ## list(xlim = range(x[subscripts], y[subscripts], finite = TRUE),
27 :     ## ylim = if (isnum.z) range(z[subscripts], finite = TRUE) else levels(z),
28 :     ## yat = if (isnum.z) NULL else sort(unique(as.numeric(z[subscripts]))))
29 :     ## if (horizontal) ans
30 :     ## else with(ans, list(xlim = ylim, ylim = xlim, xat = yat))
31 :     ## }
32 : deepayan 2
33 : deepayan 153
34 : deepayan 2 panel.segplot <-
35 :     function(x, y, z, level = NULL, subscripts,
36 :     at,
37 :     draw.bands = is.factor(z),
38 : deepayan 27 col = if (draw.bands) plot.polygon$col else plot.line$col,
39 :     alpha = if (draw.bands) plot.polygon$alpha else plot.line$alpha,
40 :     lty = if (draw.bands) plot.polygon$lty else plot.line$lty,
41 :     lwd = if (draw.bands) plot.polygon$lwd else plot.line$lwd,
42 :     border = if (draw.bands) plot.polygon$border else "transparent",
43 : deepayan 184 col.symbol = col, alpha.symbol = alpha,
44 : deepayan 2 col.regions = regions$col,
45 :     band.height = 0.6,
46 :     horizontal = TRUE,
47 :     ...,
48 : deepayan 117 segments.fun = panel.segments,
49 : deepayan 2 centers = NULL,
50 :     pch = 16)
51 :     {
52 :     plot.line <- trellis.par.get("plot.line")
53 :     plot.polygon <- trellis.par.get("plot.polygon")
54 :     regions <- trellis.par.get("regions")
55 :     x1 <- as.numeric(x[subscripts])
56 :     x2 <- as.numeric(y[subscripts])
57 :     z <- z[subscripts]
58 :     if (!is.null(level))
59 :     {
60 :     ## col is overridden
61 :     level <- as.numeric(level[subscripts])
62 :     col <- level.colors(level, at, col.regions, colors = TRUE)
63 :     }
64 :     if (draw.bands)
65 :     {
66 :     if (horizontal)
67 :     panel.rect(x = 0.5 * (x1 + x2),
68 :     width = x2 - x1,
69 :     y = as.numeric(z), height = band.height,
70 : deepayan 27 border = border, col = col, alpha = alpha,
71 : deepayan 2 lty = lty, lwd = lwd,
72 :     ...)
73 :     else
74 :     panel.rect(y = 0.5 * (x1 + x2),
75 :     height = x2 - x1,
76 :     x = as.numeric(z), width = band.height,
77 : deepayan 27 border = border, col = col, alpha = alpha,
78 : deepayan 2 lty = lty, lwd = lwd,
79 :     ...)
80 :     }
81 :     else
82 :     {
83 :     if (horizontal)
84 : deepayan 117 segments.fun(x1, as.numeric(z), x2, as.numeric(z),
85 :     col = col, alpha = alpha, lty = lty, lwd = lwd,
86 :     ...)
87 : deepayan 2 else
88 : deepayan 117 segments.fun(as.numeric(z), x1, as.numeric(z), x2,
89 :     col = col, alpha = alpha, lty = lty, lwd = lwd,
90 :     ...)
91 : deepayan 2
92 :     }
93 :     if (!is.null(centers))
94 :     {
95 :     if (horizontal)
96 :     panel.points(x = as.numeric(centers[subscripts]),
97 :     y = as.numeric(z),
98 : deepayan 184 col = col.symbol, alpha = alpha.symbol,
99 : deepayan 2 pch = pch, ...)
100 :     else
101 :     panel.points(y = as.numeric(centers[subscripts]),
102 :     x = as.numeric(z),
103 : deepayan 184 col = col.symbol, alpha = alpha.symbol,
104 : deepayan 2 pch = pch, ...)
105 :    
106 :     }
107 :     }
108 :    
109 :    
110 :     segplot <- function(x, data, ...) UseMethod("segplot")
111 :    
112 :    
113 :     segplot.formula <-
114 :     function(x, data = parent.frame(),
115 :     level = NULL, centers = NULL,
116 :     prepanel = prepanel.segplot,
117 :     panel = panel.segplot,
118 :     xlab = NULL, ylab = NULL,
119 :     horizontal = TRUE,
120 :     ...,
121 :     at, cuts = 30, colorkey = !is.null(level))
122 :     {
123 :     level <- eval(substitute(level), data, parent.frame())
124 :     centers <- eval(substitute(centers), data, parent.frame())
125 :     if (!is.null(level))
126 :     {
127 :     rng <- lattice:::extend.limits(range(as.numeric(level), finite = TRUE))
128 :     if (missing(at)) at <- do.breaks(rng, cuts + 1)
129 :     }
130 : felix 107 foo <- levelplot(x, data, level = level, centers = centers,
131 : deepayan 2 ...,
132 :     default.scales =
133 :     if (horizontal) list(y = list(alternating = FALSE, tck = 0))
134 :     else list(x = list(alternating = FALSE, tck = 0)),
135 :     xlab = xlab,
136 :     ylab = ylab,
137 :     at = at,
138 :     colorkey = colorkey,
139 :     horizontal = horizontal,
140 :     prepanel = prepanel,
141 :     panel = panel)
142 : felix 107 foo$call <- sys.call(sys.parent()); foo$call[[1]] <- quote(segplot)
143 :     foo
144 : deepayan 2 }
145 :    
146 :    
147 :     ## green.red <- function(n, gamma = 1, power = 1)
148 :     ## {
149 :     ## m <- ceiling(n/2)
150 :     ## c(hsv(h = 0.33, s = seq(1, 0, length = m)^power, gamma = gamma),
151 :     ## hsv(h = 1, s = seq(0, 1, length = m)^power, gamma = gamma))
152 :     ## }
153 :    
154 :    
155 :    
156 :     ## segplot(1:100 ~ rnorm(100) + runif(100), data = parent.frame())
157 :    
158 :    

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