Comment adapter une courbe lisse à mes données dans R?

J'essaye de dessiner une courbe douce R. J'ai les données de jouets simples suivantes:

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

Maintenant, quand je le trace avec une commande standard, cela semble cahoteux et nerveux, bien sûr:

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

Comment puis-je rendre la courbe lisse pour que les 3 arêtes soient arrondies en utilisant des valeurs estimées? Je sais qu'il existe de nombreuses méthodes pour ajuster une courbe lisse, mais je ne sais pas laquelle serait la plus appropriée pour ce type de courbe et comment vous l'écririez R.

J'aime loess()beaucoup le lissage:

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)

Le livre MASS de Venables et Ripley contient une section entière sur le lissage qui couvre également les splines et les polynômes - mais loess()est à peu près le favori de tout le monde.

Peut-être que smooth.spline est une option, vous pouvez définir un paramètre de lissage (généralement entre 0 et 1) ici

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

vous pouvez également utiliser la fonction prédire sur les objets smooth.spline. La fonction est fournie avec la base R, voir? Smooth.spline pour plus de détails.

Afin de le rendre VRAIMENT lisse ...

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)

Ce style interpole de nombreux points supplémentaires et vous donne une courbe très lisse. Cela semble également être l'approche adoptée par ggplot. Si le niveau standard de douceur est bon, vous pouvez simplement l'utiliser.

scatter.smooth(x, y)

la fonction qplot () du paquet ggplot2 est très simple à utiliser et fournit une solution élégante qui inclut des bandes de confiance. Par exemple,

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

produit

LOESS est une très bonne approche, comme l'a dit Dirk.

Une autre option consiste à utiliser des splines de Bézier, qui peuvent dans certains cas fonctionner mieux que LOESS si vous n'avez pas beaucoup de points de données.

Vous trouverez ici un exemple: 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")

Les autres réponses sont toutes de bonnes approches. Cependant, il existe quelques autres options dans R qui n'ont pas été mentionnées, notamment lowesset approx, qui peuvent donner de meilleurs ajustements ou des performances plus rapides.

Les avantages sont plus facilement démontrés avec un autre jeu de données:

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

Voici les données superposées à la courbe sigmoïde qui l'a générée:

Ce type de données est courant lorsqu'on examine un comportement binaire au sein d'une population. Par exemple, il peut s'agir d'un graphique indiquant si un client a acheté quelque chose (un binaire 1/0 sur l'axe y) par rapport au temps passé sur le site (axe x).

Un grand nombre de points sont utilisés pour mieux démontrer les différences de performances de ces fonctions.

Smooth, splineet smooth.splinetous produisent du charabia sur un ensemble de données comme celui-ci avec n'importe quel ensemble de paramètres que j'ai essayé, peut-être en raison de leur tendance à mapper vers chaque point, ce qui ne fonctionne pas pour les données bruyantes.

Les loess, lowesset les approxfonctions produisent tous les résultats utilisables, bien que à peine pour approx. Voici le code pour chacun utilisant des paramètres légèrement optimisés:

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

Et les résultats:

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

Comme vous pouvez le voir, lowessproduit un ajustement presque parfait à la courbe génératrice d'origine. Loessest proche, mais subit une étrange déviation des deux côtés.

Bien que votre ensemble de données soit très différent, j'ai trouvé que d'autres ensembles de données fonctionnent de la même manière, avec les deux loesset lowesscapables de produire de bons résultats. Les différences deviennent plus significatives lorsque vous regardez les 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 

Loessest extrêmement lent, prenant 100 fois plus longtemps que approx. Lowessproduit de meilleurs résultats que approx, tout en fonctionnant assez rapidement (15x plus rapide que loess).

Loess s'embourbe également de plus en plus à mesure que le nombre de points augmente, devenant inutilisable autour de 50 000.

EDIT: Des recherches supplémentaires montrent que cela loessdonne de meilleurs ajustements pour certains ensembles de données. Si vous avez affaire à un petit ensemble de données ou que les performances ne sont pas à prendre en considération, essayez les deux fonctions et comparez les résultats.

Dans ggplot2, vous pouvez effectuer des lissages de plusieurs manières, par exemple:

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) 

Je n'ai pas vu cette méthode montrée, donc si quelqu'un d'autre cherche à le faire, j'ai trouvé que la documentation de ggplot suggérait une technique pour utiliser la gamméthode qui produisait des résultats similaires à ceux loessde l'utilisation de petits ensembles de données.

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

Premièrement avec la méthode loess et la formule automatique Deuxièmement avec la méthode gam avec la formule suggérée