Як пристосувати плавну криву до моїх даних у 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)

У книзі «МАСА» Венейблса та Ріплі є цілий розділ згладжування, який також охоплює сплайни та поліноми - але 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надзвичайно повільний, приймаючи 100x стільки, скільки 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

По-перше, за методом лесса та авто формулою По-друге за методом гам із запропонованою формулою