Làm thế nào để điều chỉnh một đường cong mượt mà với dữ liệu của tôi trong R?

Tôi đang cố vẽ một đường cong mượt mà vào R. Tôi có dữ liệu đồ chơi đơn giản sau:

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

Bây giờ khi tôi vẽ nó bằng một lệnh tiêu chuẩn, tất nhiên, nó trông gập ghềnh và sắc sảo:

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

Làm thế nào tôi có thể làm cho đường cong trơn tru để 3 cạnh được làm tròn bằng cách sử dụng các giá trị ước tính? Tôi biết có nhiều phương pháp để tạo một đường cong trơn nhưng tôi không chắc phương pháp nào phù hợp nhất cho loại đường cong này và bạn sẽ viết nó như thế nào R.

Tôi thích loess()rất nhiều để làm mịn:

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)

Cuốn sách MASS của Venables và Ripley có toàn bộ phần về làm mịn cũng bao gồm các splines và đa thức - nhưng loess()chỉ là phần yêu thích của mọi người.

Có thể Smooth.spline là một tùy chọn, Bạn có thể đặt thông số làm mịn (thường từ 0 đến 1) tại đây

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

bạn cũng có thể sử dụng dự đoán trên các đối tượng Smooth.spline. Chức năng này đi kèm với cơ sở R, xem? Smooth.spline để biết chi tiết.

Để có được nó THỰC SỰ ...

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)

Phong cách này đan xen rất nhiều điểm bổ sung và giúp bạn có được một đường cong rất mượt mà. Nó cũng có vẻ là cách tiếp cận mà ggplot thực hiện. Nếu mức độ mịn tiêu chuẩn là ổn bạn có thể sử dụng.

scatter.smooth(x, y)

hàm qplot () trong gói ggplot2 rất dễ sử dụng và cung cấp một giải pháp thanh lịch bao gồm các dải tin cậy. Ví dụ,

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

sản xuất

LOESS là một cách tiếp cận rất tốt, như Dirk đã nói.

Một lựa chọn khác là sử dụng Bezier splines, trong một số trường hợp có thể hoạt động tốt hơn LOESS nếu bạn không có nhiều điểm dữ liệu.

Tại đây, bạn sẽ tìm thấy một ví dụ: 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")

Các câu trả lời khác đều là cách tiếp cận tốt. Tuy nhiên, có một số tùy chọn khác trong R chưa được đề cập, bao gồm lowessvà approx, có thể mang lại hiệu suất phù hợp hơn hoặc nhanh hơn.

Các lợi thế được chứng minh dễ dàng hơn với một tập dữ liệu thay thế:

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

Đây là dữ liệu được phủ bằng đường cong sigmoid đã tạo ra nó:

Loại dữ liệu này phổ biến khi xem xét hành vi nhị phân giữa một tập hợp. Ví dụ: đây có thể là biểu đồ về việc khách hàng có mua thứ gì đó hay không (nhị phân 1/0 trên trục y) so với lượng thời gian họ đã dành trên trang web (trục x).

Một số lượng lớn các điểm được sử dụng để chứng minh rõ hơn sự khác biệt về hiệu suất của các chức năng này.

Smooth, splinevà smooth.splinetất cả đều tạo ra những thứ vô nghĩa trên một tập dữ liệu như thế này với bất kỳ tập hợp thông số nào tôi đã thử, có lẽ do xu hướng ánh xạ đến mọi điểm của chúng, điều này không hoạt động đối với dữ liệu nhiễu.

Tất cả loess, lowessvà các approxchức năng đều tạo ra kết quả có thể sử dụng được, mặc dù chỉ cho approx. Đây là mã cho mỗi thông số sử dụng các thông số được tối ưu hóa nhẹ:

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

Và kết quả:

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

Như bạn có thể thấy, lowesstạo ra sự phù hợp gần như hoàn hảo với đường cong tạo ban đầu. Loesslà gần nhau, nhưng trải qua một độ lệch kỳ lạ ở cả hai đuôi.

Mặc dù tập dữ liệu của bạn sẽ rất khác, nhưng tôi nhận thấy rằng các tập dữ liệu khác hoạt động tương tự, với cả hai loessvà lowesscó khả năng tạo ra kết quả tốt. Sự khác biệt trở nên đáng kể hơn khi bạn nhìn vào điểm chuẩn:

> 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 

Loesscực kỳ chậm, lâu nhất là 100 lần approx. Lowesstạo ra kết quả tốt hơn approx, trong khi vẫn chạy khá nhanh (nhanh hơn 15 lần so với hoàng thổ).

Loess cũng ngày càng sa lầy khi số điểm tăng lên, trở nên không sử dụng được khoảng 50.000.

CHỈNH SỬA: Nghiên cứu bổ sung cho thấy loessphù hợp hơn với một số bộ dữ liệu nhất định. Nếu bạn đang xử lý một tập dữ liệu nhỏ hoặc hiệu suất không phải là điều đáng cân nhắc, hãy thử cả hai hàm và so sánh kết quả.

Trong ggplot2, bạn có thể làm mượt theo một số cách, ví dụ:

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) 

Tôi không thấy phương pháp này được hiển thị, vì vậy nếu ai đó đang tìm cách thực hiện điều này, tôi thấy rằng tài liệu ggplot đã đề xuất một kỹ thuật sử dụng gamphương pháp tạo ra kết quả tương tự như loesskhi làm việc với các tập dữ liệu nhỏ.

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

Đầu tiên với phương pháp hoàng thổ và công thức tự động Thứ hai với phương pháp gam với công thức gợi ý