Объединение LOESS и Quantreg для расчета процентилей / квантилей для данных

Question

Я пытаюсь рассчитать процентили или квантили для данных, которые значительно разбросаны.Используя функцию Лёсса, среднее значение приятно представлено, однако я не могу получить процентиль / квантили из этой функции.

Я попытался объединить квантир с лессом.Этот график показывает линейные кривые вместо сглаженных лёсс кривых.

Я хотел бы получить результат, подобный следующему:

data(cars)
plot(cars)
lmodel <- loess(cars$dist~cars$speed,span = 0.3, degree = 1)
lpred<-predict(lmodel, newdata= 5:25,se=TRUE)
lines(5:25, lpred$fit,col='#000066',lwd=4)
lines(5:25, lpred$fit - qt(0.975, lpred$df)*lpred$se, lty=2)
lines(5:25, lpred$fit + qt(0.975, lpred$df)*lpred$se, lty=2)


#### combination of quantreg with loess

plot(cars$speed,cars$dist)
xx <- seq(min(cars$speed),max(cars$speed),1)
f <- coef(rq(loess(cars$dist~cars$speed,span = 0.3, degree = 1), tau=c(0.1,0.25,0.5,0.75,0.9)) )
yy <- cbind(1,xx)%*%f
for(i in 1:length(taus)){
  lines(xx,yy[,i],col = "gray")
}

Я также попробовал предложенный код, однако я не смог изменить настройкисглаживания.Линии показывают волнистый путь.

library(quantreg)
data(cars)
taus <- c(0.1, 0.25, 0.5, 0.75, 0.9)
lmodel <- loess(dist ~ speed, data = cars, span = 0.9, degree = 1)
rqmodel <- rq(lmodel, tau = taus, data = cars)
f <- coef(rqmodel)
xx <- seq(min(cars$speed), max(cars$speed), length.out = nrow(cars))
yy <- predict(rqmodel)
plot(cars)
matlines(xx, yy, col = "grey",lwd=3)

Функция Лесс не предоставляет данные для квантилей, как это было бы в rg.

Однако функции Лёсса позволяют получить кривую без зигзага.Пожалуйста, посмотрите фрагмент кода.Какой будет настройка для тау = 0,5 с использованием функции rg для получения тех же результатов по сравнению с функцией Лесс.

data(cars)
lmodel <- loess(dist ~ speed, data = cars, span = 0.9 )
plot(cars)
lines( x=4:25 , y=predict(lmodel, newdata= data.frame(speed=4:25)) ,col="Blue")

Answer 1

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

Я постараюсь совместить оба и построить соответствующие результаты.В приведенном ниже коде я буду использовать matlines, а не цикл for.

Эти строки кода являются общими.

library(quantreg)

data(cars)

xx <- seq(min(cars$speed), max(cars$speed), length.out = nrow(cars))

Сначала модель Лесса.

lmodel <- loess(dist ~ speed, data = cars, span = 0.5, degree = 1)
ls_yy <- predict(lmodel, se = TRUE)
ls_yy <- cbind(ls_yy$fit, 
               ls_yy$fit - 2*ls_yy$se.fit, 
               ls_yy$fit + 2*ls_yy$se.fit)

plot(cars)
matlines(xx, ls_yy, col = "darkgrey")

Теперь квантильная регрессия.

taus <- c(0.1, 0.25, 0.5, 0.75, 0.9)
rqmodel <- rq(dist ~ speed, tau = taus, data = cars)

rq_yy <- predict(rqmodel)

plot(cars)
matlines(xx, rq_yy, col = "darkgrey")