R'deki verilerime düzgün bir eğri nasıl sığdırılır?

Düzgün bir eğri çizmeye çalışıyorum R. Aşağıdaki basit oyuncak verilerine sahibim:

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

Şimdi onu standart bir komutla çizdiğimde, elbette engebeli ve sinirli görünüyor:

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

Tahmini değerler kullanılarak 3 kenarın yuvarlatılması için eğriyi nasıl düzgün yapabilirim? Düzgün bir eğri uydurmak için birçok yöntem olduğunu biliyorum, ancak bu eğri türü için hangisinin en uygun olacağından ve bunu nasıl yazacağından emin değilim R.

loess()Pürüzsüzleştirmeyi çok seviyorum :

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)

Venables ve Ripley'in MASS kitabında, eğri çizgileri ve polinomları da kapsayan, pürüzsüzleştirme üzerine tam bir bölüm var - ama loess()hemen hemen herkesin favorisi.

Belki pürüzsüz.spline bir seçenektir, burada bir yumuşatma parametresi (genellikle 0 ile 1 arasında) ayarlayabilirsiniz

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

ayrıca smooth.spline nesnelerinde de tahmin kullanabilirsiniz. Fonksiyon temel R ile birlikte gelir, ayrıntılar için? Smooth.spline'a bakın.

GERÇEKTEN pürüzsüz hale getirmek için ...

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)

Bu stil, birçok ekstra noktayı hesaplar ve size çok düzgün bir eğri verir. Aynı zamanda ggplot'un benimsediği yaklaşım gibi görünüyor. Standart düzgünlük seviyesi iyi ise, sadece kullanabilirsiniz.

scatter.smooth(x, y)

qplot () ggplot2 paketinde işlev kullanımı çok basit ve güven bantları içeren bir mükemmel bir çözüm getirmektedir. Örneğin,

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

üretir

Dirk'in dediği gibi LOESS çok iyi bir yaklaşım.

Başka bir seçenek de Bezier spline'larını kullanmaktır; bu, çok fazla veri noktanız yoksa bazı durumlarda LOESS'ten daha iyi çalışabilir.

Burada bir örnek bulacaksınız: 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")

Diğer cevapların hepsi iyi yaklaşımlardır. Bununla birlikte, daha iyi uyum veya daha hızlı performans sağlayabilen lowessve dahil olmak üzere R'de bahsedilmeyen birkaç başka seçenek vardır approx.

Avantajlar, alternatif bir veri kümesiyle daha kolay gösterilir:

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

İşte onu oluşturan sigmoid eğrisi ile örtüşen veriler:

Bu tür veriler, bir popülasyon arasındaki ikili davranışa bakıldığında yaygındır. Örneğin, bu, bir müşterinin bir şey satın alıp almadığına (y ekseninde ikili 1/0) karşı sitede geçirdiği süreye (x ekseni) ilişkin bir grafik olabilir.

Bu işlevlerin performans farklılıklarını daha iyi göstermek için çok sayıda nokta kullanılır.

Smooth, splineve bunların smooth.splinetümü, denediğim herhangi bir parametre setiyle bunun gibi bir veri kümesinde anlamsız şeyler üretiyor, belki de gürültülü veriler için çalışmayan her noktaya eşleme eğilimleri nedeniyle.

loess, lowessVe approxişlevleri tüm üretmek kullanılabilir sonuçları, zar zor için her ne kadar approx. Bu, hafifçe optimize edilmiş parametreleri kullanan her biri için koddur:

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

Ve sonuçlar:

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

Gördüğünüz gibi lowess, orijinal oluşturma eğrisine neredeyse mükemmel bir uyum sağlar. Loessyakın, ancak her iki kuyrukta da garip bir sapma yaşıyor.

Sizin veri kümesi çok farklı olacak olsa da, diğer veri kümeleri hem benzer performans gösterdiğini bulduk loessve lowessiyi sonuçlar üretme yeteneğine sahip. Karşılaştırmalara baktığınızda farklılıklar daha önemli hale gelir:

> 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 

Loessson derece yavaştır, 100 kat daha uzun sürer approx. Hala oldukça hızlı çalışırken (lösten 15 kat daha hızlı) olduğundan Lowessdaha iyi sonuçlar verir approx.

Loess ayrıca, puan sayısı arttıkça 50.000 civarında kullanılamaz hale geldikçe giderek daha fazla tıkanıyor.

DÜZENLEME: Ek araştırmalar, loessbelirli veri kümeleri için daha iyi uyum sağladığını gösteriyor . Küçük bir veri kümesiyle uğraşıyorsanız veya performans dikkate alınmıyorsa, her iki işlevi de deneyin ve sonuçları karşılaştırın.

Ggplot2'de düzleştirmeleri birkaç şekilde yapabilirsiniz, örneğin:

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) 

Bu yöntemin gösterildiğini görmedim, bu yüzden başka biri bunu yapmak istiyorsa, ggplot belgelerinin küçük veri kümeleriyle çalışırken gambenzer sonuçlar üreten yöntemi kullanmak için bir teknik önerdiğini buldum loess.

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

İlk önce lös yöntemi ve otomatik formül ile İkinci olarak önerilen formülle oyun yöntemi ile