结合LOESS和Quantreg计算百分位数/分位数的数据

Question

我正在尝试为分散程度很大的数据计算百分位数或分位数。 使用Loess函数可以很好地显示均值，但是，我无法从该函数得到百分位数/位数。

我试图将Quantreg和黄土结合起来。该图显示的是线性曲线，而不是黄土平滑曲线。

我想得到类似以下结果：

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

Answer 1

下面的代码（取自“答案”）不正确，不应包含在正确的解决方案中。这将为拟合提供 95% 的置信区间，以及该区间落在真实趋势线上的概率。它不对应于从该移动平均跨度内的数据计算出的分位数。推荐的基于法线的近似值需要将 ls_yy$se.fit 乘以 sqrt(ni)，其中 ni 是特定跨度中的观察次数。不幸的是，loess 不返回 ni，因此除非跨度覆盖整个数据集并且 ni 可以设置为 n 并且不存在异方差，否则这不是一个站得住脚的解决方案。

data(cars)
plot(cars)

lmodel <- loess(dist ~ speed, data = cars, span = 0.5, degree = 1)
ls_yy <- predict(lmodel, se = TRUE)

#wrong - this does not denote quantiles for the input data:
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")

我们可以使用具有更多观察的样本数据集使这一点更加明显。样本 1 和 2 除了样本大小（500 和 1500 个观测值）之外是相同的，因此它们的分位数应该非常相似。

set.seed(1)
x1 = runif(500,0,10)
y1 = x1 + rnorm(length(x1))

x2 = runif(1500,0,10)
y2 = x1 + rnorm(length(x2))

dfpd = data.frame(x=1:9)

lmodel1 <- loess(y ~ x, data = data.frame(x=x1,y=y1), span = 0.5, degree = 1)
ls_yy1 <- predict(lmodel1, newdata=dfpd, se = TRUE)

lmodel2 <- loess(y ~ x, data = data.frame(x=x2,y=y2), span = 0.5, degree = 1)
ls_yy2 <- predict(lmodel2, newdata=dfpd, se = TRUE)

#the only difference between lmodel1 and lmodel2 is the number of observations
#the quantiles should be very similar, but their se values are a function of sample
#size and are thus quite different
ls_yy1$se
ls_yy2$se


ls_yy1$se / ls_yy2$se

我们可以看到 se 值的比率约为 60%，这证实它们不能按原样用于分位数计算

Answer 2

您几乎明白了。您忘记将残差添加到yy中。 在下面的代码中，我将使用matlines，而不是for循环。

library(quantreg)

data(cars)

taus <- c(0.1, 0.25, 0.5, 0.75, 0.9)

lmodel <- loess(dist ~ speed, data = cars, span = 0.3, 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 <- cbind(1, xx) %*% f + resid(rqmodel)

plot(cars)
matlines(xx, yy, col = "grey")