在 ggplot 中繪制分位數回歸靈敏度

Question

我想問一下如何繪制分位數標准錯誤，例如 R 中quantreg包中的基本函數

library(quantreg)
library(ggplot2)
library(dplyr)

QR.2 <- rq(hp ~  disp + mpg + I(mpg^2) + qsec + am, data = mtcars, tau = 1:9/10)
plot(summary(QR.2, se="boot"), ols=T)

上圖顯示了分位數標准誤差和置信區間。 有沒有辦法在ggplot中重現相同的情節？

嘗試下面的代碼是一個很好的開始，但是geom_ribbon(aes(ymin=conf.low,ymax=conf.high),alpha=0.25, fill="#27408b")確實返回了“置信區間”，但顯然這些與在上面的情節中產生。

有沒有辦法如何獲得 conf. 上圖中的間隔？

rq(data=mtcars,
   tau= 1:9/10,
   formula = hp ~  disp + mpg + I(mpg^2) + qsec + am) %>% 
  broom::tidy() %>% 
  filter(!grepl("factor", term)) %>%   
  filter(!grepl("Intercept", term)) %>%   
  ggplot(aes(x=tau,y=estimate))+
  geom_point(color="#27408b", size = 3)+ 
  geom_line(color="#27408b", size = 1)+ 
  geom_smooth(method=  "lm", colour = "red", se = T)+  
  facet_wrap(~term, scales="free", ncol=2) + 
  geom_ribbon(aes(ymin=conf.low,ymax=conf.high),alpha=0.25, fill="#27408b")

Answer 1

要獲得等效項，我認為您需要使用broom::tidy(se.type = "boot") %>% ，否則使用不同的方法計算標准誤差。

基礎 R 輸出：

ggplot2 等效：

  rq(data=mtcars, 
     tau= 1:9/10,
     formula = hp ~  disp + mpg + I(mpg^2) + qsec + am) %>%
  broom::tidy(se.type = "boot") %>%
  filter(!grepl("factor", term)) %>%
  ggplot(aes(x=tau,y=estimate))+
  geom_point(color="#27408b", size = 3)+ 
  geom_line(color="#27408b", size = 1)+ 
  geom_smooth(method=  "lm", colour = "red", se = T)+  
  facet_wrap(~term, scales="free", ncol=2) + 
  geom_ribbon(aes(ymin=conf.low,ymax=conf.high),alpha=0.25, fill="#27408b")

Answer 2

Petr 估計的九個分位數回歸模型的圖顯示了每個恆定邊際效應的 qr 點估計值（對於選定的九個十分位數中的每一個）和相應的置信區間（逐點，默認 alpha）。 Petr 還選擇顯示 OLS 點估計值（紅色），同樣使用 ci（紅色虛線），這是一種經常用於比較條件中位數和條件均值的常規做法。 后者在 quantreg 生成的圖中正確顯示為水平線。 答案中使用 ggplot2 顯示的紅線顯然有所不同。

Answer 3

接受的答案沒有解決提出的問題，因為它沒有用 ci（紅色虛線）繪制 OLS 點估計（紅色），因為它是由 quantreg 包完成的（如 Perl 突出顯示的）。 這個問題的正確答案如下：

# OLS
lm <- lm(data=mtcars, 
         formula =  hp ~  disp + mpg + I(mpg^2) + qsec + am)

ols <- as.data.frame(coef(lm))
ols.ci <- as.data.frame(confint(lm))
ols2 <- cbind(ols, ols.ci)
ols2 <- tibble::rownames_to_column(ols2, var="term")

# Quantile
rq(data=mtcars, 
   tau= 1:9/10,
   formula = hp ~  disp + mpg + I(mpg^2) + qsec + am) %>%
  broom::tidy(se.type = "boot") %>%
  filter(!grepl("factor", term)) %>%
  ggplot(aes(x=tau,y=estimate))+
  
  # quantilie results
  geom_point(color="#27408b", size = 3)+ 
  geom_line(color="#27408b", size = 1)+ 
  geom_ribbon(aes(ymin=conf.low,ymax=conf.high),alpha=0.25, fill="#27408b")+

  # OLS results
  geom_hline(data = ols2, aes(yintercept= `coef(lm)`), lty=1, color="red", size=1)+
  geom_hline(data = ols2, aes(yintercept= `2.5 %`), lty=2, color="red", size=1)+
  geom_hline(data = ols2, aes(yintercept= `97.5 %`), lty=2, color="red", size=1)+
  facet_wrap(~term, scales="free", ncol=2)