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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
dispersion<-function (x,y,ulim,llim=ulim,intervals=TRUE,
arrow.cap=0.01,arrow.gap=NA,type="a",fill=NA,lty=NA,pch=NA,border=NA,...) {
if(is.list(x) && length(x[[1]]) == length(x[[2]])) {
y<-x$y
x<-x$x
}
if(missing(y) && !missing(x)) {
y<-x
x<-1:length(x)
}
# if absolute values are passed, convert them to intervals
if(!intervals) {
llim<-y-llim
ulim<-ulim-y
}
plotlim<-par("usr")
npoints<-length(x)
if(is.na(arrow.gap)) arrow.gap<-strheight("O")/1.5
for(i in 1:npoints) {
if(toupper(type) == "A") {
if(!is.na(llim[i])) {
if(arrow.gap >= llim[i] * 0.9) {
caplen<-arrow.cap * diff(par("usr")[1:2])
x0<-x[i]-caplen
x1<-x[i]+caplen
y0<-rep(y[i]-llim[i],2)
y1<-rep(y[i]-llim[i],2)
segments(x0,y0,x1,y1,...)
}
else {
caplen<-arrow.cap*par("pin")[1]
x0<-x1<-rep(x[i],2)
y0<-y[i]-arrow.gap
y1<-y[i]-llim[i]
arrows(x0,y0,x1,y1,length=caplen,angle=90,...)
}
}
else {
x0<-x1<-rep(x[i],2)
y0<-y[i]-arrow.gap
y1<-plotlim[3]
segments(x0,y0,x1,y1,...)
}
if(!is.na(ulim[i])) {
if(arrow.gap >= ulim[i] * 0.9) {
caplen<-arrow.cap * diff(par("usr")[1:2])
x0<-x[i]-caplen
x1<-x[i]+caplen
y0<-rep(y[i]+ulim[i],2)
y1<-rep(y[i]+ulim[i],2)
segments(x0,y0,x1,y1,...)
}
else {
caplen<-arrow.cap*par("pin")[1]
x0<-x1<-rep(x[i],2)
y0<-y[i]+arrow.gap
y1<-y[i]+ulim[i]
arrows(x0,y0,x1,y1,length=caplen,angle=90,...)
}
}
else {
x0<-x1<-rep(x[i],2)
y0<-y[i]+arrow.gap
y1<-plotlim[4]
segments(x0,y0,x1,y1,...)
}
}
}
if(toupper(type) == "L") {
if(!is.na(fill)) {
polygon(c(x,rev(x)),c(y+ulim,rev(y-llim)),col=fill,border=NA)
if(!is.na(pch)) {
if(is.na(lty)) points(x,y,pch=pch)
else lines(x,y,lty=lty,pch=pch,type="b")
}
else {
if(!is.na(lty)) lines(x,y,lty=lty)
}
}
if(!is.na(border)) {
lines(x,y+ulim,lty=border,...)
lines(x,y-llim,lty=border,...)
}
}
}
|
