# 用R语言的QUANTREG包进行分位数回归#时间序列数据之动态线性分位数回归

# 用R语言的QUANTREG包进行分位数回归

library(quantreg)  # 载入quantreg包
data(engel)        # 加载quantreg包自带的数据集

##单变量回归
#分位数回归(tau = 0.5)
fit1 = rq(foodexp ~ income, tau = 0.5, data = engel)         
r1 = resid(fit1)   # 得到残差序列，并赋值为变量r1
c1 = coef(fit1)    # 得到模型的系数，并赋值给变量c1
summary(fit1)      # 显示分位数回归的模型和系数
summary(fit1, se = "boot") # 通过设置参数se，可以得到系数的假设检验

#分位数回归(tau = 0.5、0.75)
fit1 = rq(foodexp ~ income, tau = 0.5, data = engel) 
fit2 = rq(foodexp ~ income, tau = 0.75, data = engel)
#模型比较
anova(fit1,fit2)    #方差分析
#画图比较分析
plot(engel$foodexp , engel$income,pch=20, col = "#2E8B57",
     main = "家庭收入与食品支出的分位数回归",xlab="食品支出",ylab="家庭收入")
lines(fitted(fit1), engel$income,lwd=2, col = "#EEEE00")
lines(fitted(fit2), engel$income,lwd=2, col = "#EE6363")
legend("topright", c("tau=.5","tau=.75"), lty=c(1,1),
       col=c("#EEEE00","#EE6363"))
#不同分位点的回归比较
fit = rq(foodexp ~ income,  tau = c(0.05,0.25,0.5,0.75,0.95), data = engel)
plot( summary(fit))
##多变量回归
data(barro)
fit1 <- rq(y.net ~ lgdp2 + fse2 + gedy2 + Iy2 + gcony2, data = barro,tau=.25)
fit2 <- rq(y.net ~ lgdp2 + fse2 + gedy2 + Iy2 + gcony2, data = barro,tau=.50)
fit3 <- rq(y.net ~ lgdp2 + fse2 + gedy2 + Iy2 + gcony2, data = barro,tau=.75)

#替代方式 fit <- rq(y.net ~ lgdp2 + fse2 + gedy2 + Iy2 + gcony2, method = "fn", tau = 1:4/5, data = barro)
anova(fit1,fit2,fit3)             # 不同分位点模型比较-方差分析
anova(fit1,fit2,fit3,joint=FALSE)
#不同分位点拟合曲线的比较
plot(barro$y.net,pch=20, col = "#2E8B57",
     main = "不同分位点拟合曲线的比较")
lines(fitted(fit1),lwd=2, col = "#FF00FF")
lines(fitted(fit2),lwd=2, col = "#EEEE00")
lines(fitted(fit3),lwd=2, col = "#EE6363")
legend("topright", c("tau=.25","tau=.50","tau=.75"), lty=c(1,1),
       col=c( "#FF00FF","#EEEE00","#EE6363"))

##stata实例
##数据为陈强stata高计中的对应章节数据
library(haven)
grilic <- read_dta("G:/R_data/Project/Econometrics/stata learn/grilic.dta")
grfm=lw~s+iq+expr+tenure+rns+smsa
grolsfit=lm(grfm,data=grilic);summary(grolsfit) #basic OLS reg
grrq0.5=rq(grfm,tau=0.5,data=grilic,model=TRUE)   #中位数回归
summary(grrq0.5);summary(grrq0.5, se = "boot") 
grrq0.1=rq(grfm,tau=0.1,data=grilic,model=TRUE)  #0.25分位数回归
summary(grrq0.1);summary(grrq0.1, se = "boot")
grrq0.9=rq(grfm,tau=0.9,data=grilic,model=TRUE)  #0.75分位数回归
summary(grrq0.9);summary(grrq0.9, se = "boot")
anova(grrq0.1,grrq0.5)  #检验不同分位数回归估计值是否相同，零假设系数相同
anova(grrq0.1,grrq0.5,grrq0.9)  #比较不同分位数系数是否相同
# 时间序列数据之动态线性分位数回归

taus <- c(.05,.1,.25,.75,.9,.95)
grrq=rq(grfm,tau=taus,data=grilic,model=TRUE)  #同时回归多个分位数回归
summary(grrq,se="boot", seed = 500000)
plot(summary(grrq,se="boot", seed = 520))

library(zoo)
data("AirPassengers", package = "datasets")
ap <- log(AirPassengers)
fm <- dynrq(ap ~ trend(ap) + season(ap), tau = 1:4/5)
`
Dynamic quantile regression "matrix" data:
Start = 1949(1), End = 1960(12)
Call:
dynrq(formula = ap ~ trend(ap) + season(ap), tau = 1:4/5)
Coefficients:
                  tau= 0.2    tau= 0.4     tau= 0.6     tau= 0.8
(Intercept)    4.680165533  4.72442529  4.756389747  4.763636251
trend(ap)      0.122068032  0.11807467  0.120418846  0.122603451
season(ap)Feb -0.074408403 -0.02589716 -0.006661952 -0.013385535
season(ap)Mar  0.082349382  0.11526821  0.114939193  0.106390507
season(ap)Apr  0.062351869  0.07079315  0.063283042  0.066870808
season(ap)May  0.064763333  0.08453454  0.069344618  0.087566554
season(ap)Jun  0.195099116  0.19998275  0.194786890  0.192013960
season(ap)Jul  0.297796876  0.31034824  0.281698714  0.326054871
season(ap)Aug  0.287624540  0.30491687  0.290142727  0.275755490
season(ap)Sep  0.140938329  0.14399906  0.134373833  0.151793646
season(ap)Oct  0.002821207  0.01175582  0.013443965  0.002691383
season(ap)Nov -0.154101220 -0.12176290 -0.124004759 -0.136538575
season(ap)Dec -0.031548941 -0.01893221 -0.023048200 -0.019458814
Degrees of freedom: 144 total; 131 residual
`
sfm <- summary(fm)
plot(sfm)
不同分位点拟合曲线的比较
fm1 <- dynrq(ap ~ trend(ap) + season(ap), tau = .25)
fm2 <- dynrq(ap ~ trend(ap) + season(ap), tau = .50)
fm3 <- dynrq(ap ~ trend(ap) + season(ap), tau = .75)
plot(ap,cex = .5,lwd=2, col = "#EE2C2C",main = "时间序列分位数回归")
lines(fitted(fm1),lwd=2, col = "#1874CD")
lines(fitted(fm2),lwd=2, col = "#00CD00")
lines(fitted(fm3),lwd=2, col = "#CD00CD")
legend("topright", c("原始拟合","tau=.25","tau=.50","tau=.75"), lty=c(1,1),
       col=c( "#EE2C2C","#1874CD","#00CD00","#CD00CD"),cex = 0.65)