Как подогнать гладкую кривую к моим данным в R?


Я пытаюсь нарисовать плавную кривую в R. У меня есть следующие простые данные игрушки:

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

теперь, когда я строю его со стандартной командой, он выглядит ухабистым и резким, конечно:

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

как я могу сделать кривую гладкой, чтобы 3 края были округлены с использованием оценочных значений? Я знаю, что есть много методов для подгонки гладкой кривой, но я не уверен, какой из них будет наиболее подходящим для этого типа кривой и как вы его напишете в R.

7 73

7 ответов:

мне нравится loess() много для сглаживания:

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)

массовая книга Венаблса и Рипли имеет целый раздел о сглаживании, который также охватывает сплайны и полиномы - но loess() это почти все любимые.

может быть гладкой.сплайн вариант, вы можете установить параметр сглаживания (обычно между 0 и 1) здесь

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

вы также можете использовать прогнозируют на гладкой.объекты сплайна. Функция поставляется с базой R, см. ?гладкий.сплайн для деталей.

для того, чтобы получить его действительно 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)

этот стиль интерполирует много дополнительных точек и дает вам кривую, которая очень гладкая. Это также, по-видимому, тот подход, который использует ggplot. Если стандартный уровень гладкости в порядке, вы можете просто использовать.

scatter.smooth(x, y)

the qplot() функция в пакете ggplot2 очень проста в использовании и обеспечивает элегантное решение, которое включает в себя доверительные полосы. Например,

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

производит enter image description here

Лесс-это очень хороший подход, как сказал Дирк.

другой вариант-использовать сплайны Безье, которые в некоторых случаях могут работать лучше, чем Лесс, если у вас не так много точек данных.

здесь вы найдете пример: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")

другие ответы все хорошие подходы. Однако, есть несколько других вариантов в R, которые не были упомянуты, в том числе lowess и approx, который может дать лучше или быстрее.

преимущества более легко продемонстрировать с помощью альтернативного набора данных:

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

вот данные, наложенные на сигмовидную кривую, которая ее породила:

Data

такого рода данные являются общими, когда глядя на бинарное поведение среди населения. Например, это может быть график того, купил ли клиент что-то (двоичный 1/0 по оси y) в зависимости от количества времени, которое они провели на сайте (ось x).

большое количество точек используется для лучшей демонстрации различий в производительности этих функций.

Smooth,spline и smooth.spline все производят тарабарщину в таком наборе данных с любым набором параметров, которые я пробовал, возможно, из-за их склонность к отображению в каждую точку, что не работает для зашумленных данных.

The loess,lowess и approx функции все дают полезные результаты, хотя едва ли для approx. Это код для каждого из них с использованием слегка оптимизированных параметров:

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

результаты:

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

Как видите, lowess производит почти совершенную пригонку к первоначально производя кривой. Loess находится слишком близко, но испытывает странное отклонение у обоих хвостов.

хотя ваш набор данных будет очень отличаться, я обнаружил, что другие наборы данных работают аналогично, с обоими loess и lowess способны производить хорошие результаты. Различия становятся более существенными, когда вы смотрите на бенчмарки:

> 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 очень медленно, принимая 100x до тех пор, как approx. Lowess дает лучшие результаты, чем approx, при этом все еще работает довольно быстро (в 15 раз быстрее, чем лесс.)

Loess также становится все более увязшим, поскольку количество очков увеличивается, становясь непригодным для использования около 50 000.

EDIT: дополнительные исследования показывают, что loess лучше подходит для некоторых наборов данных. Если вы имеете дело с небольшим набором данных или производительность не рассматривается, попробуйте обе функции и сравните результаты.

в ggplot2 вы можете сделать сглаживания несколькими способами, например:

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 here enter image description here