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
|
panel.2dsmoother <-
function(x, y, z, subscripts = TRUE,
form = z ~ x * y, method = "loess", ...,
args = list(), n = 100)
{
if (length(subscripts) == 0)
return()
## allow 'form' to be passed as the first argument
missing.x <- missing(x)
if (!missing.x && inherits(x, "formula")) {
form <- x
missing.x <- TRUE
}
## use 'x', 'y', 'z' if given
## otherwise try to find them in the formula environment
if (missing.x)
x <- environment(form)$x
if (missing(y))
y <- environment(form)$y
if (missing(z))
z <- environment(form)$z
x <- x[subscripts]
y <- y[subscripts]
z <- z[subscripts]
ok <- is.finite(x) & is.finite(y) & is.finite(z)
if (sum(ok) < 1)
return()
x <- as.numeric(x)[ok]
y <- as.numeric(y)[ok]
z <- as.numeric(z)[ok]
mod <- do.call(method,
c(alist(form, data = list(x = x, y = y, z = z)),
args))
## use the limits of the data, or panel limits, whichever is smaller
lims <- current.panel.limits()
xrange <- c(max(min(lims$x), min(x)), min(max(lims$x), max(x)))
yrange <- c(max(min(lims$y), min(y)), min(max(lims$y), max(y)))
xseq <- seq(xrange[1], xrange[2], length = n)
yseq <- seq(yrange[1], yrange[2], length = n)
zseq <- seq(min(z), max(z), length = n)
grid <- expand.grid(x = xseq, y = yseq)
fit <- predict(mod, grid)
panel.levelplot(x = grid$x, y = grid$y, z = fit, subscripts = TRUE,
...)
}
|