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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
prepanel.ecdfplot <-
function(x, f.value = NULL, ...)
{
ans <-
prepanel.default.qqmath(x,
f.value = f.value,
distribution = qunif)
with(ans, list(xlim = ylim, ylim = c(0, 1),
dx = dy, dy = dx))
}
panel.ecdfplot <-
function(x, f.value = NULL, type = "s",
groups = NULL, qtype = 7,
ref = TRUE,
...)
{
if (ref)
{
reference.line <- trellis.par.get("reference.line")
do.call(panel.abline, c(list(h = c(0, 1)), reference.line))
}
x <- as.numeric(x)
distribution <- qunif
nobs <- sum(!is.na(x))
if (!is.null(groups))
{
panel.superpose(x, y = NULL,
f.value = f.value, type = type,
distribution = distribution,
qtype = qtype,
groups = groups,
panel.groups = panel.ecdfplot,
...)
}
else if (nobs)
{
if (is.null(f.value))
{
panel.xyplot(x = sort(x),
y = seq_len(nobs) / nobs,
type = type,
...)
}
else
{
p <- if (is.numeric(f.value)) f.value else f.value(nobs)
panel.xyplot(x = quantile(x, p, names = FALSE, type = qtype, na.rm = TRUE),
y = distribution(p),
type = type,
...)
}
}
}
ecdfplot <-
function (x, data, ...)
UseMethod("ecdfplot")
ecdfplot.formula <-
function (x, data = NULL,
prepanel = "prepanel.ecdfplot",
panel = "panel.ecdfplot",
ylab = gettext("Empirical CDF"),
...)
{
ccall <- match.call()
ocall <- sys.call(sys.parent()); ocall[[1]] <- quote(ecdfplot) ## for nice $call
ccall$data <- data
ccall$prepanel <- prepanel
ccall$panel <- panel
ccall$ylab <- ylab
ccall[[1]] <- quote(lattice::densityplot)
ans <- eval.parent(ccall)
ans$call <- ocall
ans
}
ecdfplot.numeric <-
function (x, data = NULL, xlab = deparse(substitute(x)), ...)
{
ccall <- match.call()
ocall <- sys.call(sys.parent()); ocall[[1]] <- quote(ecdfplot) ## for nice $call
if (!is.null(ccall$data))
warning("explicit 'data' specification ignored")
ccall$data <- list(x = x)
ccall$xlab <- xlab
ccall$x <- ~x
ccall[[1]] <- quote(latticeExtra::ecdfplot)
ans <- eval.parent(ccall)
ans$call <- ocall
ans
}
|