1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
if(FALSE) {
panel.abwplot <- function(x, y, box.ratio = 1, means=TRUE,
font = box.dot$font, pch = box.dot$pch,
cex = box.dot$cex,
col = box.dot$col, ...)
{
ok <- !is.na(x) & !is.na(y)
x <- x[ok]
y <- y[ok]
y.unique <- sort(unique(y))
width <- box.ratio/(1 + box.ratio)
w <- width/2
lineopts <- trellis.par.get("box.rectangle")
for(Y in y.unique) {
X <- x[y == Y]
q <- quantile(X, c(.01,.05,.1,.25,.75,.9,.95,.99,.5))
median.value <- list(x = q[9], y = Y)
z <- c(1, .01,
2, .01,
2, .05,
3, .05,
3, .10,
4, .10,
4, .25,
5, .25,
5, .10,
6, .10,
6, .05,
7, .05,
7, .01,
8, .01,
8,-.01,
7,-.01,
7,-.05,
6,-.05,
6,-.10,
5,-.10,
5,-.25,
4,-.25,
4,-.10,
3,-.10,
3,-.05,
2,-.05,
2,-.01,
1,-.01,
1, .01)
box.dot <- trellis.par.get("box.dot")
box.dot.par <- c(list(pch = pch, cex = cex, col = col, font = font), ...)
do.call('lines',c(list(x=q[z[seq(1,length(z),by=2)]],
y=Y + 4*w*z[seq(2,length(z),by=2)]),lineopts))
##do.call('segments',c(list(x1=q[c(2:7)],y1=Y+rep(-w,6),
## x2=q[c(2:7)],y2=Y+rep(w,6)),
## lineopts))
do.call("points", c(median.value, box.dot.par))
if(means)
do.call('lines',c(list(x=rep(mean(X),2),y=Y+c(-w,w)),
lineopts, lty=2))
}
}
NULL
}
|
