Нарисуйте квадратичный сплайн через точки в решетке

Это немного сложно, но работает.

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 не производя ничью

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

тогда я использую очки, полученные 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)
)

это не решение, путем попытки использовать решение Josh с grid.xspline на ggplot2. Я думаю, что интересно получить параллель между 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)

моя идея заключается в использовании масштабов, генерируемых ggplot2, для создания сплайна в той же панели, что и scatterplot. Лично я нахожу это сложным, и я надеюсь, что кто-то придет с лучшим решением.

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)

я, наконец, нашел решение этого, основываясь на ответе на этот вопрос:квадратичный сплайн

используя пакет splines

заменить panel.splines(...) (комментарий выше) с этим кодом:

         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)))
         })

из превосходного предложения Джоша О'Брайена,grid.xspline() может заменить прокомментированный-out panel.splines(...) линия, приводящая к точному графику, как в базовом вопросе, связанном выше (за исключением поля):

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

вот вариант панели сплайнов от 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)
}