Bagaimana cara menyesuaikan kurva halus ke data saya di R?

Saya mencoba menggambar kurva yang mulus R. Saya memiliki data mainan sederhana berikut:

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

Sekarang ketika saya memplotnya dengan perintah standar terlihat bergelombang dan tegang, tentu saja:

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

Bagaimana cara membuat kurva halus sehingga 3 tepinya dibulatkan menggunakan nilai perkiraan? Saya tahu ada banyak metode untuk menyesuaikan kurva yang mulus, tetapi saya tidak yakin mana yang paling sesuai untuk jenis kurva ini dan bagaimana Anda akan menulisnya R.

Saya sangat suka loess()menghaluskan:

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 dan buku MASS Ripley memiliki keseluruhan bagian tentang menghaluskan yang juga mencakup splines dan polinomial - tetapi loess()hampir semua orang favorit.

Mungkin smooth.spline adalah sebuah opsi, Anda dapat mengatur parameter penghalusan (biasanya antara 0 dan 1) di sini

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

Anda juga dapat menggunakan prediksi pada objek smooth.spline. Fungsi ini dilengkapi dengan basis R, lihat? Smooth.spline untuk detailnya.

Untuk mendapatkannya BENAR-BENAR smoooth ...

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)

Gaya ini menginterpolasi banyak poin ekstra dan memberi Anda kurva yang sangat halus. Ini juga tampaknya menjadi pendekatan yang diambil ggplot. Jika tingkat kehalusan standar baik-baik saja Anda bisa menggunakan.

scatter.smooth(x, y)

fungsi qplot () dalam paket ggplot2 sangat mudah digunakan dan memberikan solusi elegan yang mencakup pita kepercayaan. Misalnya,

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

menghasilkan

LOESS adalah pendekatan yang sangat bagus, seperti yang dikatakan Dirk.

Pilihan lainnya adalah menggunakan Bezier splines, yang dalam beberapa kasus dapat bekerja lebih baik daripada LOESS jika Anda tidak memiliki banyak titik data.

Di sini Anda akan menemukan contoh: 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")

Jawaban lainnya adalah pendekatan yang baik. Namun, ada beberapa opsi lain di R yang belum disebutkan, termasuk lowessdanapprox , yang mungkin memberikan kesesuaian yang lebih baik atau kinerja yang lebih cepat.

Keuntungannya lebih mudah ditunjukkan dengan kumpulan data alternatif:

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

Berikut adalah data yang dihamparkan dengan kurva sigmoid yang menghasilkannya:

Jenis data ini biasa terjadi saat melihat perilaku biner di antara suatu populasi. Misalnya, ini mungkin plot tentang apakah pelanggan membeli sesuatu (biner 1/0 pada sumbu y) versus jumlah waktu yang mereka habiskan di situs (sumbu x).

Sejumlah besar poin digunakan untuk mendemonstrasikan perbedaan kinerja fungsi-fungsi ini dengan lebih baik.

Smooth,, splinedansmooth.spline semuanya menghasilkan omong kosong pada kumpulan data seperti ini dengan kumpulan parameter apa pun yang telah saya coba, mungkin karena kecenderungannya untuk memetakan ke setiap titik, yang tidak berfungsi untuk data yang berisik.

Fungsi loess,, lowessdan approxsemuanya menghasilkan hasil yang dapat digunakan, meskipun hanya untuk approx. Ini adalah kode untuk masing-masing menggunakan parameter yang dioptimalkan ringan:

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

Dan hasilnya:

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

Seperti yang Anda lihat, lowessmenghasilkan kesesuaian yang hampir sempurna dengan kurva pembangkit asli. Loessdekat, tetapi mengalami penyimpangan yang aneh di kedua ekor.

Meskipun kumpulan data Anda akan sangat berbeda, saya menemukan bahwa kumpulan data lain memiliki kinerja yang sama, dengan keduanya loessdan lowessmampu memberikan hasil yang baik. Perbedaan menjadi lebih signifikan saat Anda melihat tolok ukur:

> 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 

Loesssangat lambat, memakan waktu 100x lebih lama approx. Lowessmenghasilkan hasil yang lebih baik daripada approx, sambil tetap berlari dengan cukup cepat (15x lebih cepat dari loess).

Loess juga menjadi semakin macet karena jumlah poin meningkat, menjadi tidak dapat digunakan sekitar 50.000.

EDIT: Penelitian tambahan menunjukkan bahwa loesslebih cocok untuk set data tertentu. Jika Anda berurusan dengan set data kecil atau kinerja tidak menjadi pertimbangan, coba kedua fungsi dan bandingkan hasilnya.

Di ggplot2 Anda dapat melakukan pemulusan dalam beberapa cara, misalnya:

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) 

Saya tidak melihat metode ini ditampilkan, jadi jika orang lain ingin melakukan ini, saya menemukan bahwa dokumentasi ggplot menyarankan teknik untuk menggunakan gammetode yang menghasilkan hasil yang serupa loessketika bekerja dengan kumpulan data kecil.

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

Pertama dengan metode loess dan rumus otomatis Kedua dengan metode gam dengan rumus yang disarankan