[R] custom panel help in lattice

[Deepayan Sarkar]

On Sun, Dec 7, 2008 at 9:37 AM, Jon Loehrke <jloehrke at umassd.edu> wrote:
> Hi,
>
> I am having an issue with a custom panel for lattice.  The problem
> comes when I try passing a groups argument.
>
> Here is the custom panel, a wrapper for smooth spline.  I copied
> panel.loess and replaced the loess arguments with smooth.spline().
> [Note: I would like to use the cross-validation fitting properties of
> smooth.spline.]
>
> library(lattice)
>
> panel.smooth.spline<-function(x,y,w=NULL, df, spar = NULL, cv = FALSE,
>        lwd=plot.line$lwd, lty=plot.line$lty,col, col.line=plot.line$col,
>        type, horizontal=FALSE,... ){
>
>            x <- as.numeric(x)
>            y <- as.numeric(y)
>            ok <- is.finite(x) & is.finite(y)
>            if (sum(ok) < 1)
>                return()
>            if (!missing(col)) {
>                if (missing(col.line))
>                    col.line <- col
>            }
>            plot.line <- trellis.par.get("plot.line")
>            if (horizontal) {
>                spline <- smooth.spline(y[ok], x[ok], ...)
>                panel.lines(x = spline$y, y = spline$x, col = col.line,
>                    lty = lty, lwd = lwd, ...)
>            }
>            else {
>                spline <- smooth.spline(x[ok], y[ok],...)
>                panel.lines(x = spline$x, y = spline$y, col = col.line,
>                    lty = lty, lwd = lwd, ...)
>            }
>        }
>
>
> # Here is my test data frame
> set.seed(25)
> test<-data.frame(x=c(1:200), y=rnorm(200), groups=gl(4,200/4))
>
> # This call to xyplot works, but the smoother colors are not unique.
>
> xyplot(y~x|groups, data=test,
>        panel=function(...){
>                panel.xyplot(...)
>                panel.smooth.spline(...)
>                })
>
> # This call to xyplot doesn't work and results in an error "error
> using packet"
>
> xyplot(y~x|groups, data=test, groups=groups,
>        panel=function(...){
>                panel.xyplot(...)
>                panel.smooth.spline(...)
>                })
>
> I think this should be quite simple but I must be too simple minded.
> Thanks for any help.

You end up calling smooth.spline() with arguments it doesn't
recognize. One work-around is defining 'panel.smooth.spline' as
follows:

panel.smooth.spline <-
    function(x, y,
             w=NULL, df, spar = NULL, cv = FALSE,
             lwd=plot.line$lwd, lty=plot.line$lty,col, col.line=plot.line$col,
             type, horizontal=FALSE,... )
{
           x <- as.numeric(x)
           y <- as.numeric(y)
           ok <- is.finite(x) & is.finite(y)
           if (sum(ok) < 1)
               return()
           if (!missing(col)) {
               if (missing(col.line))
                   col.line <- col
           }
           plot.line <- trellis.par.get("plot.line")
           if (horizontal) {
               spline <-
                   smooth.spline(y[ok], x[ok],
                                 w=w, df=df, spar = spar, cv = cv)
               panel.lines(x = spline$y, y = spline$x, col = col.line,
                   lty = lty, lwd = lwd, ...)
           }
           else {
               spline <-
                   smooth.spline(x[ok], y[ok],
                                 w=w, df=df, spar = spar, cv = cv)
               panel.lines(x = spline$x, y = spline$y, col = col.line,
                   lty = lty, lwd = lwd, ...)
           }
       }

-Deepayan