Как подогнать плавную кривую к моим данным в R? - PullRequest
76 голосов
/ 14 августа 2010

Я пытаюсь нарисовать плавную кривую в 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

Ответы [ 8 ]

95 голосов
/ 14 августа 2010

Мне нравится 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)

В книге Mable от Venables и Ripley есть целый раздел, посвященный сглаживанию, который также охватывает сплайны и полиномы, но loess() почти всем нравится.

57 голосов
/ 14 августа 2010

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

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

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

26 голосов
/ 14 августа 2010

Чтобы получить его ДЕЙСТВИТЕЛЬНО 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)
24 голосов
/ 16 апреля 2015

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

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

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

12 голосов
/ 14 августа 2010

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

Другой вариант - использование сплайнов Безье, который в некоторых случаях может работать лучше, чем LOESS, если у вас мало точек данных.1004 * Здесь вы найдете пример: 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")
9 голосов
/ 17 февраля 2017

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

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

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

РЕДАКТИРОВАТЬ: дополнительные исследования показывают, что loess дает лучшее соответствие для определенных наборов данных.Если вы работаете с небольшим набором данных, или производительность не учитывается, попробуйте обе функции и сравните результаты.

3 голосов
/ 10 января 2018

В 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

1 голос
/ 03 апреля 2019

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

Во-первых, с использованием метода Лёсса и автоматической формулы Во-вторых, с использованием метода гаммы с предложенной формулой

...