Как подогнать плавную кривую к моим данным в 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.

Очень люблю 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)

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

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

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

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

Чтобы получилось ДЕЙСТВИТЕЛЬНО гладко ...

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)

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

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

производит

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

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

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

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

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

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

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

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

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

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

РЕДАКТИРОВАТЬ: дополнительные исследования показывают, что это 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) 

Я не видел показанного этого метода, поэтому, если кто-то еще хочет это сделать, я обнаружил, что документация ggplot предлагает методику использования gamметода, который дает результаты, аналогичные результатам 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

Сначала с методом лесса и автоматической формулой Второй с методом гаммы с предложенной формулой