Draw a quadratic spline through points in lattice

Question

Based on this great question: How to draw a smooth curve passing through some points

How would one do this in lattice?

plot(rnorm(120), rnorm(120), col="darkblue", pch=16, xlim=c(-3,3), ylim=c(-4,4))
points(rnorm(120,-1,1), rnorm(120,2,1), col="darkred", pch=16)
points(c(-1,-1.5,-3), c(4,2,0), pch=3, cex=3)
xspline(c(-1,-1.5,-3), c(4,2,0), shape = -1)

Here is similar data, formatted more appropriately for a lattice plot:

dat <- data.frame(x=c(rnorm(120), rnorm(120,-1,1)),
                  y=c(rnorm(120), rnorm(120,2,1)),
                  l=factor(rep(c('B','R'),each=120))
)
spl <- data.frame(x=c(-1,-1.5,-3), 
                  y=c(4,2,0)
)

And here is what the linked question gave, translated to lattice:

xyplot(y ~ x,
       data=dat,
       groups=l,
       col=c("darkblue", "darkred"),
       pch=16,
       panel = function(x, y, ...) {
         panel.xyplot(x=spl$x, y=spl$y, pch=3, cex=3)
         ## panel.spline(x=spl$x, y=spl$y)              ## Gives an error, need at least four 'x' values
         panel.superpose(x, y, ...,
                         panel.groups = function(x, y, ...) {
                           panel.xyplot(x, y, ...)
                         }
         )
       },
       xlim=c(-3,3), ylim=c(-4,4)
)

Answer 1

Here's a line-for line 'translation' of the base graphics solution into lattice. (The directness of the translation is made possible by the + operator supplied by the latticeExtra package. See ?layer for details of its usage.)

The final line invokes grid.xspline(), an exact grid analogue of the base graphic function xspline().

library(lattice)
library(grid)
library(latticeExtra)

xyplot(rnorm(120)~rnorm(120), pch=16, col="darkblue", 
       xlim = c(-3.1, 3.1), ylim = c(-4.1, 4.1)) +
xyplot(rnorm(120,2,1) ~ rnorm(120,-1,1), pch=16, col="darkred") +
xyplot(c(4,2,0) ~ c(-1,-1.5,-3), pch=3, cex=3) +
layer(grid.xspline(c(-1,-1.5,-3), c(4,2,0), shape = -1, default.units="native"))

(One peculiar detail of grid does pop up in the final line above: like several other of its low-level line-drawing functions, grid.xspline() defaults to "npc" units instead of the usually-desired "native" units used as defaults by grid.points() and many other grid.*() functions. Obviously that's easy enough to change --- once you're aware of it!)

Answer 2

This is not a solution, by an attempt to use Josh solution with grid.xspline in ggplot2. I think it is interesting to get a parallel between ggplot2/lattice.

## prepare the data
dat <- data.frame(x=c(rnorm(120), rnorm(120,-1,1)),
                 y=c(rnorm(120), rnorm(120,2,1)),
                 l=factor(rep(c('B','R'),each=120))
)
spl <- data.frame(x=c(-2,-1.5,-3), 
                  y=c(4,2,0)
)
## prepare the scatter plot
library(ggplot(2))
p <- ggplot(data=dat,aes(x=x,y=y,color=l))+
  geom_point()+
  geom_point(data=spl,aes(x=x,y=y),color='darkred',size=5)
library(grid)
ff <- ggplot_build(p)

My idea is to use the scales generated by ggplot2, to create the spline in the same panel than the scatterplot. Personally I find this tricky, and I hope that someone comes with a better solution.

xsp.grob <- xsplineGrob(spl$x, spl$y,
                        vp=viewport(xscale =ff$panel$ranges[[1]]$x.range,
                                    yscale = ff$panel$ranges[[1]]$y.range),
                        shape = -1, default.units="native")
p
grid.add(gPath='panel.3-4-3-4',child=xsp.grob)

Answer 3

I finally found a solution to this, based on the answer to this question: Quadratic spline

Using package splines

Replace panel.splines(...) (commented out above) with this code:

         local({
           model <- lm(y ~ bs(x, degree=2), data=spl)
           x0 <- seq(min(spl$x), max(spl$x), by=.1)
           panel.lines(x0, predict(model, data.frame(x=x0)))
         })

From Josh O'Brien's excellent suggestion, grid.xspline() can replace the commented-out panel.splines(...) line, resulting in the exact plot as in the base question, linked above (except for the margins):

         grid.xspline(spl$x, spl$y, shape = -1, default.units="native")

Answer 4

This is a little bit tricky but works.

plot(rnorm(120), rnorm(120), col="darkblue", pch=16, xlim=c(-3,3), ylim=c(-4,4))
points(rnorm(120,-1,1), rnorm(120,2,1), col="darkred", pch=16)
points(c(-1,-1.5,-3), c(4,2,0), pch=3, cex=3)

I use xspline without producing the draw

dd <- xspline(c(-1,-1.5,-3), c(4,2,0), shape = -1,draw=FALSE)

Then I use the points produced witn panel.lines

library(lattice)
xyplot(y ~ x,
       data=dat,
       groups=l,
       col=c("darkblue", "darkred"),
       pch=16,
       panel = function(x, y, ...) {
         panel.xyplot(x=spl$x, y=spl$y, pch=3, cex=3)
         panel.lines(dd$x,dd$y)
         panel.superpose(x, y, ...,
                         panel.groups = function(x, y, ...) {
                           panel.xyplot(x, y, ...)
                         }
         )
       },
       xlim=c(-3,3), ylim=c(-4,4)
)

Answer 5

Here is a variation of a spline panel from Deepayan Sarkar

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, ... )
{
  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")
  spline <-   smooth.spline(x[ok], y[ok],
                            w=w, df=df, spar = spar, cv = cv)
  pred = predict(spline,x= seq(min(x),max(x),length.out=150))
  panel.lines(x = pred$x, y = pred$y, col = col.line,
              lty = lty, lwd = lwd, ...)
  panel.abline(h=y[which.min(x)],col=col.line,lty=2)
}