Disegnare una spline quadratica attraverso punti in lattice

Question

In base a questa grande domanda: How to draw a smooth curve passing through some points

come si potrebbe fare questo 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) 

Ecco dati simili, formattati in modo più appropriato per un lattice trama:

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

Ed ecco ciò che la questione legata dato, tradotto in 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

Ecco una linea per la linea 'traduzione' del base di soluzione grafici in reticolo. (L'immediatezza della traduzione è resa possibile dall'operatore + fornito dal pacchetto reticolareExtra. Vedere ?layer per i dettagli del suo utilizzo.)

La riga finale invoca grid.xspline(), un esatto griglia analogica del di base funzione grafica 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")) 

(Un dettaglio peculiare griglia fa apparire nella riga finale sopra: come molti altri delle sue funzioni linea disegno a basso livello, grid.xspline() default per "npc" unità invece dei solito-desiderati "native" unità utilizzato come default per grid.points() e molte altre funzioni grid.*(). Ovviamente questo è abbastanza facile da cambiare --- una volta che sei a conoscenza di esso!)

Answer 2

Ecco una variante di un pannello spline da 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) 
} 

Answer 3

Questo è un po 'difficile, ma funziona.

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) 

Io uso xspline senza produrre il disegnare

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

Poi io uso i punti 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 4

ho finalmente trovato una soluzione a questo prodotto, in base sulla risposta a questa domanda: Quadratic spline

Utilizzando pacchetto splines

Sostituire panel.splines( ... ) (commentato in precedenza) con questo codice:

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

Da ottimo suggerimento di Josh O'Brien, grid.xspline() può sostituire la riga commentata panel.splines( ... ), risultante nella trama esatta come nella domanda di base, linke d sopra (eccetto per i margini):

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

Answer 5

Questa non è una soluzione, da un atte mpt per utilizzare la soluzione Josh con grid.xspline in ggplot2. Penso che sia interessante ottenere un parallelo tra 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) 

mia idea è quella di utilizzare la bilancia generati da ggplot2, per creare la spline nello stesso pannello rispetto alla dispersione. Personalmente trovo questo difficile, e spero che qualcuno arrivi con una soluzione migliore.

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)