Como ajustar uma curva suave aos meus dados em R?

Estou tentando desenhar uma curva suave R. Tenho os seguintes dados de brinquedo simples:

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

Agora, quando eu ploto com um comando padrão, parece irregular e nervoso, é claro:

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

Como posso tornar a curva suave para que as 3 arestas sejam arredondadas usando valores estimados? Sei que existem muitos métodos para ajustar uma curva suave, mas não tenho certeza de qual seria o mais apropriado para esse tipo de curva e como você a escreveria R.

Gosto loess()muito de suavizar:

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)

O livro MASS de Venables e Ripley tem uma seção inteira sobre suavização que também cobre splines e polinômios - mas loess()é o favorito de todos.

Talvez smooth.spline seja uma opção, você pode definir um parâmetro de suavização (normalmente entre 0 e 1) aqui

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

você também pode usar a previsão em objetos smooth.spline. A função vem com base R, consulte? Smooth.spline para obter detalhes.

A fim de deixá-lo REALMENTE liso ...

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)

Este estilo interpola muitos pontos extras e fornece uma curva muito suave. Também parece ser a abordagem que o ggplot adota. Se o nível padrão de suavidade estiver bom, você pode apenas usar.

scatter.smooth(x, y)

a função qplot () no pacote ggplot2 é muito simples de usar e fornece uma solução elegante que inclui faixas de confiança. Por exemplo,

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

produz

LOESS é uma abordagem muito boa, como disse Dirk.

Outra opção é usar splines Bezier, que podem em alguns casos funcionar melhor do que LOESS se você não tiver muitos pontos de dados.

Aqui você encontrará um exemplo: 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")

As outras respostas são boas abordagens. No entanto, existem algumas outras opções em R que não foram mencionadas, incluindo lowesse approx, que podem fornecer ajustes melhores ou desempenho mais rápido.

As vantagens são demonstradas mais facilmente com um conjunto de dados 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)))

Aqui estão os dados sobrepostos pela curva sigmóide que os gerou:

Esse tipo de dado é comum ao observar um comportamento binário entre uma população. Por exemplo, isso pode ser um gráfico que mostra se um cliente comprou ou não algo (um binário 1/0 no eixo y) versus a quantidade de tempo que ele passou no site (eixo x).

Um grande número de pontos é usado para demonstrar melhor as diferenças de desempenho dessas funções.

Smooth,, splineesmooth.spline todos produzem gibberish em um conjunto de dados como este com qualquer conjunto de parâmetros que eu tentei, talvez devido à sua tendência de mapear para todos os pontos, o que não funciona para dados com ruído.

Os loess, lowesse approxfunções de todos os produzir resultados utilizáveis, embora apenas um pouco para approx. Este é o código para cada um usando parâmetros levemente otimizados:

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 os resultados:

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

Como você pode ver, lowessproduz um ajuste quase perfeito à curva de geração original. Loessestá perto, mas experimenta um estranho desvio em ambas as caudas.

Embora seu conjunto de dados seja muito diferente, descobri que outros conjuntos de dados têm desempenho semelhante, com ambos loesse lowesscapazes de produzir bons resultados. As diferenças se tornam mais significativas quando você olha para os benchmarks:

> 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é extremamente lento, levando 100x mais tempo approx. Lowessproduz melhores resultados do que approx, enquanto ainda é executado com bastante rapidez (15x mais rápido do que loess).

Loess também fica cada vez mais atolado à medida que o número de pontos aumenta, tornando-se inutilizável por volta de 50.000.

EDIT: Pesquisas adicionais mostram que loessoferece melhores ajustes para determinados conjuntos de dados. Se você estiver lidando com um pequeno conjunto de dados ou se o desempenho não for levado em consideração, tente as duas funções e compare os resultados.

No ggplot2, você pode fazer suavizações de várias maneiras, por exemplo:

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) 

Não vi esse método mostrado, então, se outra pessoa está procurando fazer isso, descobri que a documentação do ggplot sugeriu uma técnica para usar o gammétodo que produzia resultados semelhantes ao loesstrabalhar com pequenos conjuntos de dados.

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

Primeiro com o método loess e fórmula automática Segundo com o método gam com fórmula sugerida