web-dev-qa-db-fra.com

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

J'essaie de dessiner une courbe lisse dans 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, ça a l'air bien cahoteux et énervé:

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

Comment rendre la courbe lisse afin que les 3 arêtes soient arrondies à l'aide de valeurs estimées? Je sais qu'il existe de nombreuses méthodes pour ajuster une courbe lisse, mais je ne sais pas quelle méthode conviendrait le mieux à ce type de courbe ni comment l'écrire dans R.

rplotcurve-fitting
77
Frank

J'aime beaucoup loess() pour 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 and Ripley contient une section entière sur le lissage qui couvre également les splines et les polynômes - mais loess() est le favori de tout le monde.

95
Dirk Eddelbuettel

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 prédire sur les objets smooth.spline. La fonction est livrée avec la base R, voir? Smooth.spline pour plus de détails.

57
Karsten W.

Afin de l'obtenir VRAIMENT minime ...

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 procure une courbe très lisse. Il semble également que ce soit l'approche que ggplot adopte. Si le niveau standard de finesse est bon, vous pouvez simplement l'utiliser.

scatter.smooth(x, y)
26
John

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

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

produit enter image description here

24
Underminer

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

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 lowess et 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 avec la courbe sigmoïde qui les a générées:

Data

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

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

Smooth, spline et smooth.spline tous produisent du charabia sur un ensemble de données comme celui-ci avec tous les paramètres que j'ai essayés, peut-être en raison de leur tendance à mapper sur chaque point, ce qui ne fonctionne pas pour les données bruitées.

Les fonctions loess, lowess et approx produisent toutes des résultats utilisables, bien qu’à peine pour approx. C'est 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"))

Fits

Comme vous pouvez le constater, lowess produit un ajustement presque parfait à la courbe de génération d'origine. Loess est proche, mais connaît une déviation étrange des deux côtés.

Bien que votre jeu de données soit très différent, j'ai constaté que d'autres jeux de données fonctionnent de manière similaire, avec loess et lowess capables de produire de bons résultats. Les différences deviennent plus importantes lorsque vous examinez les points de repère:

> 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 est extrêmement lent, prenant 100 fois plus longtemps que approx. Lowess produit de meilleurs résultats que approx tout en fonctionnant assez rapidement (15 fois plus vite que loess).

Loess s’enlève de plus en plus à mesure que le nombre de points augmente, devenant inutilisable autour de 50 000.

EDIT: Des recherches supplémentaires montrent que loess convient mieux à certains jeux de données. Si vous avez affaire à un petit jeu de données ou si les performances ne sont pas prises en compte, essayez les deux fonctions et comparez les résultats.

9
Craig

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)

enter image description hereenter image description here

4
jsb

Je n'ai pas vu cette méthode illustrée, donc si quelqu'un d'autre cherche à faire cela, j'ai trouvé que la documentation de ggplot suggérait une technique d'utilisation de la méthode gam produisant des résultats similaires à loess lorsque vous travaillez avec 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

d'abord avec la méthode loess et la formule automatiqueensuite avec la méthode gam avec la formule suggérée

1
Adam Bunn