[Rd] Add smooth curves with panel.superpose

[John Maindonald]

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
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._