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
|
probplot <- function(x, qdist=qnorm, probs=NULL, line=TRUE,
xlab=NULL, ylab="Probability in %", ...)
{
DOTARGS <- as.list(substitute(list(...)))[-1]
DOTARGS <- paste(names(DOTARGS), DOTARGS, sep="=",
collapse=", ")
xlab=deparse(substitute(x))
x <- sort(x)
QNAME <- deparse(substitute(qdist))
DOTS <- list(...)
qdist <- match.fun(qdist)
QFUN <- function(p){
args=DOTS
args$p=p
do.call("qdist", args)
}
y <- QFUN(ppoints(length(x)))
if(is.null(probs)){
probs <- c(.01, .05, seq(.1,.9, by=.1), .95, .99)
if(length(x)>=1000)
probs <- c(0.001, probs, .999)
}
qprobs <- QFUN(probs)
plot(x, y, axes=FALSE, type="n", ylim=range(c(y,qprobs)),
xlab=xlab, ylab=ylab)
box()
abline(h=qprobs, col="grey")
axis(1)
axis(2, at=qprobs, labels=100*probs)
points(x, y)
QTEXT <- paste("Quantile: ", QNAME, sep="")
if(nchar(DOTARGS))
QTEXT <- paste(QTEXT, DOTARGS, sep=", ")
mtext(QTEXT, side=1, line=3, adj=1)
xl <- quantile(x, c(0.25, 0.75))
yl <- qdist(c(0.25, 0.75), ...)
slope <- diff(yl)/diff(xl)
int <- yl[1] - slope * xl[1]
if(line){
abline(int, slope, col="red")
}
z <- list(qdist=QFUN, int=int, slope=slope)
class(z) <- "probplot"
invisible(z)
}
lines.probplot <- function(x, h=NULL, v=NULL, bend=FALSE, ...)
{
if(is.null(h) & is.null(v)){
abline(x$int, x$slope, ...)
}
pu <- par("usr")
if(!is.null(h)){
h <- x$qdist(h)
if(!bend){
abline(h=h, ...)
}
else{
v <- c(v, (h-x$int)/x$slope)
}
}
if(!is.null(v)){
if(!bend){
abline(v=v, ...)
}
else{
h <- v*x$slope+x$int
segments(v, pu[3], v, h, ...)
segments(pu[1], h, v, h, ...)
}
}
}
|
