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

J’essaie de dessiner une courbe lisse en R J’ai les données de jouet 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, il a l’air cahoteux et nerveux, bien sûr:

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

Comment puis-je rendre la courbe lisse afin que les 3 arêtes soient arrondies en utilisant les valeurs estimées? Je sais qu’il existe de nombreuses méthodes pour adapter une courbe lisse, mais je ne suis pas sûr de celle qui conviendrait le mieux à ce type de courbe et de la manière dont vous l’écririez dans R

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 et Ripley comporte 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 tous.

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 des objects prédits sur les objects smooth.spline. La fonction est fournie avec la base R, voir? Smooth.spline pour plus de détails.

Afin de l’obtenir vraiment vraiment …

 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 beaucoup de points supplémentaires et vous procure une courbe très lisse. Cela semble également être l'approche adoptée par ggplot. Si le niveau de fluidité standard est correct, vous pouvez simplement 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 entrer la description de l'image ici

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

Une autre option consiste à utiliser les splines de Bezier, 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)^(ni))*t^i*x[i+1] outy <- outy + choose(n, i)*((1-t)^(ni))*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, y compris lowess et approx , ce qui peut donner de meilleurs résultats ou des performances plus rapides.

Les avantages sont plus faciles à démontrer avec un autre dataset:

 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é:

Les données

Ce type de données est courant lorsqu'on examine un comportement binary au sein d'une population. Par exemple, cela pourrait indiquer si un client a acheté quelque chose (un 1/0 binary sur l'axe des y) par rapport à la durée passée sur le site (axe des abscisses).

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

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

Les fonctions loess , lowess et approx produisent toutes des résultats utilisables, mais à peine pendant approx . C'est le code pour chacun utilisant des parameters 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")) 

S'adapte

Comme vous pouvez le voir, lowess produit un ajustement presque parfait sur la courbe générasortingce d'origine. Loess est proche, mais connaît une déviation étrange au niveau des deux queues.

Bien que votre jeu de données soit très différent, j'ai constaté que d'autres jeux de données fonctionnent de la même manière, avec à la fois un loess et un lowess capables de produire de bons résultats. Les différences deviennent plus importantes quand on regarde 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 

Loess est extrêmement lent, prenant 100 fois la longueur d' approx . Lowess donne de meilleurs résultats approx , tout en fonctionnant assez rapidement (15 fois plus vite que loess).

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

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

Dans ggplot2, vous pouvez effectuer plusieurs opérations, 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) 

entrer la description de l'image ici entrer la description de l'image ici