I propose an extesion of the settings available for the
type parameter in panel.superpose(), thus:
type if "p" points are plotted, if "l", the points are
joined by lines, if "b" there are points and lines,
if "s" there are points and a smooth fitted curve,
if "S" there is a curve.
Example:
library(mass)
data(cabbages)
xyplot(HeadWt~VitC|Date, panel=panel.superpose,
groups=Cult, data=cabbages, type="s",span=2)
xyplot(HeadWt~VitC|Date, panel=panel.superpose,
groups=Cult, data=cabbages, type="s",span=2)
Here is the altered code. The changes are in the statements
if (type == "p" || type ==
"b"||type=="s"){ ....}
and the new code:
if
((type=="s"||type=="S")&&is.finite(x[id])&&
is.finite(y[id])){
span <- list(...)$span
if(is.null(span))span <- 2/3
iter <- list(...)$iter
if(is.null(iter))iter <- 3
xy <- lowess(x[id], y[id], f = span, iter = iter)
grid.lines(x = xy$x, y = xy$y, gp = gpar(lty = lty[i],
col = lcol[i]), default.units = "native")
}
panel.superpose <-
function (x, y, subscripts, groups, type = "p", col =
superpose.symbol$col,
pch = superpose.symbol$pch, cex = superpose.symbol$cex,
lty = superpose.line$lty, ...)
{
if (length(x) > 0) {
superpose.symbol <- trellis.par.get("superpose.symbol")
superpose.line <- trellis.par.get("superpose.line")
if (is.factor(x))
x <- as.numeric(x)
if (is.factor(y))
y <- as.numeric(y)
if (is.shingle(x) || is.shingle(y))
stop("sorry, panel.superpose does not allow shingles")
vals <- sort(unique(groups))
nvals <- length(vals)
col <- rep(col, length = nvals)
pch <- rep(pch, length = nvals)
lty <- rep(lty, length = nvals)
cex <- rep(cex, length = nvals)
lcol <- rep(superpose.line$col, length = nvals)
for (i in seq(along = vals)) {
id <- (groups[subscripts] == vals[i])
if (any(id)) {
if (type == "p" || type ==
"b"||type=="s")
grid.points(x = x[id], y = y[id], size = unit(cex[i] *
2.5, "mm"), pch = pch[i], gp = gpar(col = col[i],
cex = cex[i]), default.units = "native")
if (type == "l" || type == "b")
grid.lines(x = x[id], y = y[id], gp = gpar(lty = lty[i],
col = lcol[i]), default.units = "native")
if
((type=="s"||type=="S")&&is.finite(x[id])&&
is.finite(y[id])){
span <- list(...)$span
if(is.null(span))span <- 2/3
iter <- list(...)$iter
if(is.null(iter))iter <- 3
xy <- lowess(x[id], y[id], f = span, iter = iter)
grid.lines(x = xy$x, y = xy$y, gp = gpar(lty = lty[i],
col = lcol[i]), default.units = "native")
}
}
}
}
}
John Maindonald email : john.maindonald@anu.edu.au
Statistical Consulting Unit, phone : (6125)3998
c/o CMA, SMS, fax : (6125)5549
John Dedman Mathematical Sciences Building
Australian National University
Canberra ACT 0200
Australia
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To:
r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._