Come adattare una curva morbida ai miei dati in R?

Sto cercando di disegnare una curva morbida R. Ho i seguenti semplici dati del giocattolo:

> x
 [1]  1  2  3  4  5  6  7  8  9 10
> y
 [1]  2  4  6  8  7 12 14 16 18 20

Ora, quando lo stampo con un comando standard, sembra irregolare e tagliente, ovviamente:

> plot(x,y, type='l', lwd=2, col='red')

Come posso rendere la curva liscia in modo che i 3 bordi siano arrotondati utilizzando valori stimati? So che ci sono molti metodi per adattare una curva morbida, ma non sono sicuro di quale sarebbe più appropriato per questo tipo di curva e come lo scriveresti R.

Mi piace loess()molto per levigare:

x <- 1:10
y <- c(2,4,6,8,7,12,14,16,18,20)
lo <- loess(y~x)
plot(x,y)
lines(predict(lo), col='red', lwd=2)

Il libro MASS di Venables e Ripley ha un'intera sezione sullo smoothing che copre anche spline e polinomi, ma loess()è quasi il preferito di tutti.

Forse smooth.spline è un'opzione, puoi impostare un parametro di smoothing (tipicamente tra 0 e 1) qui

smoothingSpline = smooth.spline(x, y, spar=0.35)
plot(x,y)
lines(smoothingSpline)

puoi anche usare la previsione sugli oggetti smooth.spline. La funzione viene fornita con la base R, vedere? Smooth.spline per i dettagli.

Per renderlo DAVVERO liscio ...

x <- 1:10
y <- c(2,4,6,8,7,8,14,16,18,20)
lo <- loess(y~x)
plot(x,y)
xl <- seq(min(x),max(x), (max(x) - min(x))/1000)
lines(xl, predict(lo,xl), col='red', lwd=2)

Questo stile interpola molti punti extra e ti dà una curva molto liscia. Sembra anche essere l'approccio adottato da ggplot. Se il livello standard di levigatezza va bene puoi semplicemente usarlo.

scatter.smooth(x, y)

la funzione qplot () nel pacchetto ggplot2 è molto semplice da usare e fornisce una soluzione elegante che include bande di confidenza. Per esempio,

qplot(x,y, geom='smooth', span =0.5)

produce

LOESS è un ottimo approccio, come ha detto Dirk.

Un'altra opzione è usare le spline di Bezier, che in alcuni casi potrebbero funzionare meglio di LOESS se non si hanno molti punti dati.

Qui troverai un esempio: http://rosettacode.org/wiki/Cubic_bezier_curves#R

# x, y: the x and y coordinates of the hull points
# n: the number of points in the curve.
bezierCurve <- function(x, y, n=10)
    {
    outx <- NULL
    outy <- NULL

    i <- 1
    for (t in seq(0, 1, length.out=n))
        {
        b <- bez(x, y, t)
        outx[i] <- b$x
        outy[i] <- b$y

        i <- i+1
        }

    return (list(x=outx, y=outy))
    }

bez <- function(x, y, t)
    {
    outx <- 0
    outy <- 0
    n <- length(x)-1
    for (i in 0:n)
        {
        outx <- outx + choose(n, i)*((1-t)^(n-i))*t^i*x[i+1]
        outy <- outy + choose(n, i)*((1-t)^(n-i))*t^i*y[i+1]
        }

    return (list(x=outx, y=outy))
    }

# Example usage
x <- c(4,6,4,5,6,7)
y <- 1:6
plot(x, y, "o", pch=20)
points(bezierCurve(x,y,20), type="l", col="red")

Le altre risposte sono tutti buoni approcci. Tuttavia, ci sono alcune altre opzioni in R che non sono state menzionate, tra cui lowesse approx, che potrebbero fornire adattamenti migliori o prestazioni più veloci.

I vantaggi si dimostrano più facilmente con un set di dati alternativo:

sigmoid <- function(x)
{
  y<-1/(1+exp(-.15*(x-100)))
  return(y)
}

dat<-data.frame(x=rnorm(5000)*30+100)
dat$y<-as.numeric(as.logical(round(sigmoid(dat$x)+rnorm(5000)*.3,0)))

Ecco i dati sovrapposti alla curva sigmoidea che lo ha generato:

Questo tipo di dati è comune quando si osserva un comportamento binario tra una popolazione. Ad esempio, questo potrebbe essere un grafico che indica se un cliente ha acquistato o meno qualcosa (un 1/0 binario sull'asse y) rispetto alla quantità di tempo che ha trascorso sul sito (asse x).

Un gran numero di punti viene utilizzato per dimostrare meglio le differenze di prestazioni di queste funzioni.

Smooth, splineE smooth.splinetutto senza senso produrre su un set di dati come questo con qualsiasi insieme di parametri ho cercato, forse a causa della loro tendenza a mappare ogni punto, che non funziona per i dati rumorosi.

I loess, lowesse approxfunzioni di tutti producono risultati utili, anche se appena per approx. Questo è il codice per ciascuno che utilizza parametri leggermente ottimizzati:

loessFit <- loess(y~x, dat, span = 0.6)
loessFit <- data.frame(x=loessFit$x,y=loessFit$fitted)
loessFit <- loessFit[order(loessFit$x),]

approxFit <- approx(dat,n = 15)

lowessFit <-data.frame(lowess(dat,f = .6,iter=1))

E i risultati:

plot(dat,col='gray')
curve(sigmoid,0,200,add=TRUE,col='blue',)
lines(lowessFit,col='red')
lines(loessFit,col='green')
lines(approxFit,col='purple')
legend(150,.6,
       legend=c("Sigmoid","Loess","Lowess",'Approx'),
       lty=c(1,1),
       lwd=c(2.5,2.5),col=c("blue","green","red","purple"))

Come puoi vedere, lowessproduce un adattamento quasi perfetto alla curva di generazione originale. Loessè vicino, ma sperimenta una strana deviazione su entrambe le code.

Sebbene il tuo set di dati sarà molto diverso, ho scoperto che altri set di dati si comportano in modo simile, con entrambi loesse in lowessgrado di produrre buoni risultati. Le differenze diventano più significative quando guardi i benchmark:

> microbenchmark::microbenchmark(loess(y~x, dat, span = 0.6),approx(dat,n = 20),lowess(dat,f = .6,iter=1),times=20)
Unit: milliseconds
                           expr        min         lq       mean     median        uq        max neval cld
  loess(y ~ x, dat, span = 0.6) 153.034810 154.450750 156.794257 156.004357 159.23183 163.117746    20   c
            approx(dat, n = 20)   1.297685   1.346773   1.689133   1.441823   1.86018   4.281735    20 a  
 lowess(dat, f = 0.6, iter = 1)   9.637583  10.085613  11.270911  11.350722  12.33046  12.495343    20  b 

Loessè estremamente lento, impiegando 100 volte il tempo approx. Lowessproduce risultati migliori rispetto a approx, pur essendo ancora in esecuzione abbastanza rapidamente (15 volte più veloce di loess).

Loess inoltre diventa sempre più impantanato all'aumentare del numero di punti, diventando inutilizzabili intorno ai 50.000.

MODIFICA: ulteriori ricerche mostrano che si loessadattano meglio a determinati set di dati. Se hai a che fare con un piccolo set di dati o le prestazioni non sono una considerazione, prova entrambe le funzioni e confronta i risultati.

In ggplot2 puoi eseguire gli smooth in diversi modi, ad esempio:

library(ggplot2)
ggplot(mtcars, aes(wt, mpg)) + geom_point() +
  geom_smooth(method = "gam", formula = y ~ poly(x, 2)) 
ggplot(mtcars, aes(wt, mpg)) + geom_point() +
  geom_smooth(method = "loess", span = 0.3, se = FALSE) 

Non ho visto questo metodo mostrato, quindi se qualcun altro sta cercando di farlo, ho scoperto che la documentazione di ggplot suggeriva una tecnica per utilizzare il gammetodo che produceva risultati simili a loessquando si lavora con piccoli set di dati.

library(ggplot2)
x <- 1:10
y <- c(2,4,6,8,7,8,14,16,18,20)

df <- data.frame(x,y)
r <- ggplot(df, aes(x = x, y = y)) + geom_smooth(method = "gam", formula = y ~ s(x, bs = "cs"))+geom_point()
r

Primo con il metodo loess e la formula automatica Secondo con il metodo gam con la formula suggerita