Regressão Quantilica

Autor

Paulo Manoel da Silva Junior

Regressão Quantilica

Objetivo

O objetivo da atividade é utilizar a regressão quantilica no banco de dados que foi utilizado para a regressão beta, e verificação de se foi realizado um bom ajuste

Análise Exploratória dos Dados

Vamos estar carregando o banco de dados, que foi encontrado no Kaggle e estar ajustando a regressão quantilica.

Sendo assim, podemos definir que o banco de dados foi encontrado em: Índice de Felicidade

Informações acerca do tema: A busca pela felicidade tem sido um tema central nas sociedades humanas ao longo da história. A Pontuação do Índice de Felicidade é uma medida de bem-estar que tem recebido considerável atenção nos últimos anos como um indicador da prosperidade geral e da qualidade de vida de um país. A pontuação do Índice de Felicidade é calculada com base em diversas variáveis, incluindo PIB per capita, apoio social, esperança de vida saudável, liberdade para fazer escolhas de vida, perceções de corrupção e generosidade.

  • Acerca do banco de dados

Este estudo analisa a associação entre a pontuação do Índice de Felicidade em 2018 e 2019, e um conjunto de variáveis independentes como Classificação geral, PIB per capita, Apoio social, Expectativa de vida saudável, Liberdade fazer escolhas de vida, Generosidade e Percepções de corrupção. O objetivo deste estudo é investigar o impacto dessas variáveis independentes no nível de felicidade dos indivíduos durante esses dois anos. Além disso, foi realizada uma análise por país para examinar as variações nas variáveis entre o país mais feliz no topo da classificação e a Índia. Múltiplas visualizações foram empregadas para identificar e ilustrar essas diferenças de maneira clara e concisa.

Descrição das variáveis:

  • Classificação geral: lista de classificações de diferentes países de 1 a 156

  • País ou região: Lista dos nomes dos diferentes países. Pontuação: Lista de pontuações de felicidade de diferentes países.

  • PIB per capita: A pontuação do PIB per capita de diferentes países.

  • Apoio social: O apoio social de diferentes países.

  • Expectativa de vida saudável: A expectativa de vida saudável de diferentes países.

  • Liberdade para fazer escolhas de vida: A pontuação da percepção de liberdade de diferentes países.

  • Generosidade: Pontuação de generosidade (a qualidade de ser gentil e generoso) de diferentes países.

  • Percepções de corrupção: A pontuação da percepção de corrupção em diferentes países.

  • Carregando as bibliotecas necessárias

  • Carregando o banco de dados

Código 
setwd("C:\\Users\\Pessoal\\Desktop\\ESTATÍSTICA\\UFPB\\9 º PERÍODO\\ECONOMETRIA I")
banco <- read.csv("2019.csv", header = T)
  • Visualizando o banco de dados

Estatística Descritiva dos dados

O banco de dados tem 156 observações.

Estatística Descritiva do Banco de dados
Score de Felicidade PIB Suporte Social Expectativa de Vida Saudável Liberdade para fazer escolhas de vida Generosidade Percepção de Corrupção
Mean 5.4071 0.9051 1.2088 0.7252 0.3926 0.1848 0.1106
Maximum 7.7690 1.6840 1.6240 1.1410 0.6310 0.5660 0.4530
Minimum 2.8530 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000
Median 5.3795 0.9600 1.2715 0.7890 0.4170 0.1775 0.0855
Mean + 3 standard deviation 8.7465 2.1003 2.1064 1.4516 0.8224 0.4706 0.3942
Mean + 2 standard deviation 7.6333 1.7019 1.8072 1.2095 0.6791 0.3754 0.2997
Mean + 1 standard deviation 6.5202 1.3035 1.5080 0.9674 0.5359 0.2801 0.2051
Mean - 1 standard deviation 4.2940 0.5068 0.9096 0.4831 0.2493 0.0896 0.0161
Mean - 2 standard deviation 3.1809 0.1084 0.6104 0.2410 0.1060 -0.0057 -0.0785
Mean - 3 standard deviation 2.0677 -0.2900 0.3112 -0.0011 -0.0373 -0.1009 -0.1730
Quantile (99.87%) 7.7349 1.6689 1.6165 1.1372 0.6266 0.5523 0.4445
Quantile (97.73%) 7.4909 1.5014 1.5647 1.0568 0.5970 0.3734 0.3863
Quantile (84.14%) 6.4448 1.3253 1.4853 0.9960 0.5354 0.2678 0.1691
Quantile (15.87%) 4.3560 0.3898 0.8856 0.4430 0.2386 0.0830 0.0340
Quantile (2.28%) 3.2860 0.0842 0.4844 0.2134 0.0474 0.0397 0.0060
Quantile (0.14%) 2.9029 0.0056 0.0820 0.0228 0.0022 0.0054 0.0009
n 156.0000 156.0000 156.0000 156.0000 156.0000 156.0000 156.0000
Range 4.9160 1.6840 1.6240 1.1410 0.6310 0.5660 0.4530
Variance 1.2390 0.1587 0.0895 0.0586 0.0205 0.0091 0.0089
Standard deviation 1.1131 0.3984 0.2992 0.2421 0.1433 0.0953 0.0945
Standard error of the mean 0.0891 0.0319 0.0240 0.0194 0.0115 0.0076 0.0076
Coefficient of variation (%) 20.5863 44.0138 24.7508 33.3852 36.5003 51.5317 85.4753
Skewness 0.0113 -0.3815 -1.1238 -0.6079 -0.6790 0.7387 1.6345
Kurtosis 2.3727 2.2163 4.1517 2.6685 2.8951 4.0977 5.3018
P-value (Shapiro-Wilk) 0.1633 0.0006 0.0000 0.0000 0.0001 0.0004 0.0000

Visualização Gráfica

Podemos observar que não estamos diante de dados simétricos.

Score de Felicidade vs PIB

Visualizando o gráfico de dispersão das variáveis independentes com a variável dependente.

Podemos observar uma tendência crescente diante, ou seja, parece existir uma correlação positiva, alta que a medida que o PIB cresce, o score de felicidade também cresce. Uma correlação de 0.794.

Score de Felicidade vs Suporte Social

Mais uma vez observamos uma relação linear entre essas duas variáveis, a medida que o suporte social cresce, o score de felicidade também aumenta.

Score de Felicidade vs Expectativa de Vida Saudável

Através da visualização gráfica, podemos analisar um padrão positivo, ou seja, a influência da expectativa de vida saudável é positiva no score de felicidade.

Score de Felicidade vs Liberdade de fazer escolhas de vida

Mais uma vez observamos um padrão positivo, todavia com uma dispersão maior nos dados, talvez em um problema de regressão linear, um problema com heterocedasticidade, todavia o modelo de regressão beta não necessita de tal pressuposto.

Score de Felicidade vs Generosidade

De acordo com a visualização gráfica não conseguimos observar um padrão identificável dessas duas variáveis.

Score de Felicidade vs Percepção de Corrupção

Através da análise gráfica não parece haver nenhum padrão entre essas duas variáveis.

Correlação

Observação

Como a matriz de correlação acima, informou que a correlação mais alta é do score de felicidade com o PIB, o ajuste no qual utilizaremos regressão quantilica simples, será apenas com ela

Ajuste de Modelo de Regressão Quantilica Simples

  • Para esse primeiro ajuste, vamos estar utilizando a variável dependente Score de Felicidade com a variável independnte PIB.

  • Verificando o gráfico com as retas de regressão

Código 
taus <- c(.10,.20,.25,.75,.90,.95)
f <- rq(Score~PIB, data = banco, tau = taus)
plot(x = banco$PIB, y = banco$Score, cex = .25, type = "n", xlab = "PIB", ylab = "Score de Felicidade")+
  points(banco$PIB, banco$Score, cex = .5, col = "blue")+
  abline(rq(Score~PIB, tau = .5, data = banco), col = "blue")+
  abline(lm(Score~PIB, data = banco), lty = 2, col = "red")+
  abline(rq(Score~PIB, tau = .15, data = banco), col = "gray")+
  abline(rq(Score~PIB, tau = .20, data = banco), col = "gray")+
  abline(rq(Score~PIB, tau = .75, data = banco), col = "gray")+
  abline(rq(Score~PIB, tau = .90, data = banco), col = "gray")+
  abline(rq(Score~PIB, tau = .95, data = banco), col = "gray")

integer(0)

Comentário: Podemos observar que possivelmente, temos um caso de que os erros são nid, o que a inclinação das retas podem indicar, vamos fazer o ajuste considerando esse tipo de erro.

Ajuste de vários modelos de regressão

Ajustando alguns modelos de regressão para os quantis: 0.10, 0.25, 0.5, 0.75, 0.90 e 0.95

  • Ajuste dos modelos
Código 
fit_10 <- rq(Score~PIB, tau = .10, data = banco)
fit_25 <- rq(Score~PIB, tau = .25, data = banco)
fit_5 <- rq(Score~PIB, tau = .5, data = banco)
fit_75 <- rq(Score~PIB, tau = .75, data = banco)
fit_90 <- rq(Score~PIB, tau = .90, data = banco)
fit_95 <- rq(Score~PIB, tau = .95, data = banco)
  • Observando o summary dos ajustes de acordo com os erros nid
Código 
summary(fit_10, se = "nid")

Call: rq(formula = Score ~ PIB, tau = 0.1, data = banco)

tau: [1] 0.1

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  2.36226  0.24836    9.51134  0.00000
PIB          2.40213  0.23524   10.21136  0.00000
Código 
summary(fit_25, se = "nid")

Call: rq(formula = Score ~ PIB, tau = 0.25, data = banco)

tau: [1] 0.25

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  2.86593  0.23395   12.25036  0.00000
PIB          2.26337  0.21803   10.38113  0.00000
Código 
summary(fit_5, se = "nid")

Call: rq(formula = Score ~ PIB, tau = 0.5, data = banco)

tau: [1] 0.5

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  3.50801  0.18090   19.39182  0.00000
PIB          2.09814  0.18817   11.15002  0.00000
Código 
summary(fit_75, se = "nid")

Call: rq(formula = Score ~ PIB, tau = 0.75, data = banco)

tau: [1] 0.75

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  3.80598  0.14788   25.73777  0.00000
PIB          2.31538  0.17783   13.02028  0.00000
Código 
summary(fit_90, se = "nid")

Call: rq(formula = Score ~ PIB, tau = 0.9, data = banco)

tau: [1] 0.9

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  4.20535  0.24984   16.83227  0.00000
PIB          2.26218  0.21282   10.62942  0.00000
Código 
summary(fit_95, se = "nid")

Call: rq(formula = Score ~ PIB, tau = 0.95, data = banco)

tau: [1] 0.95

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  4.57151  0.21678   21.08846  0.00000
PIB          2.11775  0.23586    8.97896  0.00000
Maior concentração

Podemos observar através da estimativa do erro padrão que temos uma menor variabilidade entre o 2º e 3º quartis.

  • Observando os diferentes estimadores para a matriz de covariâncias, ou seja, verificando se temos outros tipos de erro para o mesmo quantil, a hipótese a ser considerada é que os erros é nid, verificando se são iid ou com método bootstrap
Código 
summary(fit_10, se = "iid")

Call: rq(formula = Score ~ PIB, tau = 0.1, data = banco)

tau: [1] 0.1

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  2.36226  0.15174   15.56776  0.00000
PIB          2.40213  0.15352   15.64733  0.00000
Código 
summary(fit_10, se = "boot")

Call: rq(formula = Score ~ PIB, tau = 0.1, data = banco)

tau: [1] 0.1

Coefficients:
            Value   Std. Error t value Pr(>|t|)
(Intercept) 2.36226 0.28221    8.37071 0.00000 
PIB         2.40213 0.27358    8.78041 0.00000
Código 
summary(fit_25, se = "iid")

Call: rq(formula = Score ~ PIB, tau = 0.25, data = banco)

tau: [1] 0.25

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  2.86593  0.22246   12.88304  0.00000
PIB          2.26337  0.22506   10.05667  0.00000
Código 
summary(fit_25, se = "boot")

Call: rq(formula = Score ~ PIB, tau = 0.25, data = banco)

tau: [1] 0.25

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  2.86593  0.25713   11.14597  0.00000
PIB          2.26337  0.23437    9.65746  0.00000
Código 
summary(fit_5, se = "iid")

Call: rq(formula = Score ~ PIB, tau = 0.5, data = banco)

tau: [1] 0.5

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  3.50801  0.18526   18.93547  0.00000
PIB          2.09814  0.18743   11.19420  0.00000
Código 
summary(fit_5, se = "boot")

Call: rq(formula = Score ~ PIB, tau = 0.5, data = banco)

tau: [1] 0.5

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  3.50801  0.16422   21.36106  0.00000
PIB          2.09814  0.17434   12.03452  0.00000
Código 
summary(fit_75, se = "iid")

Call: rq(formula = Score ~ PIB, tau = 0.75, data = banco)

tau: [1] 0.75

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  3.80598  0.22657   16.79793  0.00000
PIB          2.31538  0.22923   10.10084  0.00000
Código 
summary(fit_75, se = "boot")

Call: rq(formula = Score ~ PIB, tau = 0.75, data = banco)

tau: [1] 0.75

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  3.80598  0.14623   26.02769  0.00000
PIB          2.31538  0.18084   12.80319  0.00000
Código 
summary(fit_90, se = "iid")
Warning in rq.fit.br(x, y, tau = tau, ...): Solution may be nonunique

Call: rq(formula = Score ~ PIB, tau = 0.9, data = banco)

tau: [1] 0.9

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  4.20535  0.23099   18.20542  0.00000
PIB          2.26218  0.23370    9.67988  0.00000
Código 
summary(fit_90, se = "boot")

Call: rq(formula = Score ~ PIB, tau = 0.9, data = banco)

tau: [1] 0.9

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  4.20535  0.24882   16.90088  0.00000
PIB          2.26218  0.19902   11.36637  0.00000
Código 
summary(fit_95, se = "iid")
Warning in rq.fit.br(x, y, tau = tau, ...): Solution may be nonunique

Call: rq(formula = Score ~ PIB, tau = 0.95, data = banco)

tau: [1] 0.95

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  4.57151  0.22804   20.04679  0.00000
PIB          2.11775  0.23071    9.17919  0.00000
Código 
summary(fit_95, se = "boot")

Call: rq(formula = Score ~ PIB, tau = 0.95, data = banco)

tau: [1] 0.95

Coefficients:
            Value    Std. Error t value  Pr(>|t|)
(Intercept)  4.57151  0.19008   24.05013  0.00000
PIB          2.11775  0.18306   11.56838  0.00000
Informação sobre os erros

Podemos observar que para os diferentes quartis, temos tipos de erros que mais se adequam, e vimos que geral os nid e baseados em bootstrap tem melhores resultados.

  • Testando a igualdade dos coeficientes dos quantis

Hipóteses a serem testadas:

\[H_0: \beta_i(\theta_i) = \beta_i(\theta_j) \cdots = \beta_i(\theta_m)\]

\[H_1: \beta_i(\theta_i) \neq \beta_i(\theta_j) \]

Código 
anova(fit_10,fit_25, fit_5, fit_75, fit_90, fit_95)
Quantile Regression Analysis of Deviance Table

Model: Score ~ PIB
Joint Test of Equality of Slopes: tau in {  0.1 0.25 0.5 0.75 0.9 0.95  }

  Df Resid Df F value Pr(>F)
1  5      931  0.6713 0.6453
Resultado

Resposta: Ao nível de significância de 5%, não rejeitamos a hipótese nula, ou seja, não existe evidências para rejeitar a hipótese de que os erros sejam iid

  • Testando se o modelo está bem encaixado
Código 
fit5h_0 <- rq(Score~1, tau = .5, data = banco)
Warning in rq.fit.br(x, y, tau = tau, ...): Solution may be nonunique
Código 
anova(fit_5, fit5h_0)
Quantile Regression Analysis of Deviance Table

Model 1: Score ~ PIB
Model 2: Score ~ 1
  Df Resid Df F value    Pr(>F)    
1  1      154  124.32 < 2.2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Resposta

Rejeitamos a hipótese nula ao nível de significância de 5%, ou seja, o modelo não é o correto ainda para explicar os dados.

  • Observando os valores ajustados
Código 
summary(fitted(fit_10))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  2.362   3.810   4.668   4.537   5.323   6.407
Código 
summary(fitted(fit_25))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  2.866   4.230   5.039   4.915   5.656   6.677
Código 
summary(fitted(fit_5))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  3.508   4.773   5.522   5.407   6.094   7.041
Código 
summary(fitted(fit_75))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  3.806   5.202   6.029   5.902   6.660   7.705
Código 
summary(fitted(fit_90))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  4.205   5.569   6.377   6.253   6.993   8.015
Código 
summary(fitted(fit_95))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  4.572   5.848   6.605   6.488   7.182   8.138
  • Verificando os resíduos
Código 
residuos <- residuals(fit_5)
plot(residuos)

Código 
qqnorm(residuos)
qqline(residuos, col = 2)

Podemos observar uma saída na cauda dos resíduos.

Código 
nortest::lillie.test(residuos)

    Lilliefors (Kolmogorov-Smirnov) normality test

data:  residuos
D = 0.030535, p-value = 0.9761

Resposta: Ao nível de 5% de significância não rejeitamos a hipótese nula de que os resíduos estão distribuidos normalmente.

  • Visualização gráfica dos coeficientes
Código 
fm <- rq(Score~PIB, data = banco, tau = 1:9/10)
plot(summary(fm))
Warning in rq.fit.br(x, y, tau = tau, ci = TRUE, ...): Solution may be
nonunique

  • Medida de qualidade do ajuste
Código 
fit_10h0 <- rq(Score~1, data = banco, tau = 0.1)
fit_25h0 <- rq(Score~1, data = banco, tau = 0.25)
Warning in rq.fit.br(x, y, tau = tau, ...): Solution may be nonunique
Código 
fit_75h0 <- rq(Score~1, data = banco, tau = 0.75)
Warning in rq.fit.br(x, y, tau = tau, ...): Solution may be nonunique
Código 
fit_90h0 <- rq(Score~1, data = banco, tau = 0.90)
fit_95h0 <- rq(Score~1, data = banco, tau = 0.95)
Código 
1 - fit_10$rho/fit_10h0$rho
[1] 0.3851502
Código 
1 - fit_25$rho/fit_25h0$rho
[1] 0.3757568
Código 
1 - fit_5$rho/fit5h_0$rho
[1] 0.4019975
Código 
1 - fit_75$rho/fit_75h0$rho
[1] 0.3982633
Código 
1 - fit_90$rho/fit_90h0$rho
[1] 0.4246885
Código 
1 - fit_95$rho/fit_95h0$rho
[1] 0.4112507
Resultado

De fato, com a medida de qualidade acima, foi comprovado que o ajuste apenas com uma variável não se mostrou significativo. O valor do pseudo \(R^2\) foi bem baixo para os diferentes níveis de quartil.

  • Teste da qualidade do ajuste
Código 
GOFTest(fit_5, alpha = 0.05, B = 1000, seed = 986)
Goodness-of-fit test for quantile regression based on the cusum process 
A large test statistic (small p-value) is evidence of lack of fit 
Quantile 0.5: Test statistic = 0.1534; p-value = 0.01
Resposta

Rejeitamos a hipótese nula ao nível de significância de 5%, existe evidências estatísticas de que o modelo não está bem ajustado

Ajuste do Modelo de Regressão Quantilica Múltipla

Ajuste do modelo

Para o ajuste do modelo de regressão quantilica múltipla, será utilizado as mesmas variáveis que foram significativas parao ajuste de \(\mu\), na regressão beta, ou seja, todas as variáveis independentes, exceto a Generosidade. Utilizaremos os mesmos quantis já utilizados na reg. simples

  • Ajuste dos modelos
Código 
fit_10M <- rq(Score~PIB+Suporte_Social+Expectativa_de_vida_saudavel+liberdade+percepção_corrupção, tau = .10, data = banco)
fit_25M <- rq(Score~PIB+Suporte_Social+Expectativa_de_vida_saudavel+liberdade+percepção_corrupção, tau = .25, data = banco)
fit_5M <- rq(Score~PIB+Suporte_Social+Expectativa_de_vida_saudavel+liberdade+percepção_corrupção, tau = .5, data = banco)
fit_75M <- rq(Score~PIB+Suporte_Social+Expectativa_de_vida_saudavel+liberdade+percepção_corrupção, tau = .75, data = banco)
fit_90M <- rq(Score~PIB+Suporte_Social+Expectativa_de_vida_saudavel+liberdade+percepção_corrupção, tau = .90, data = banco)
fit_95M <- rq(Score~PIB+Suporte_Social+Expectativa_de_vida_saudavel+liberdade+percepção_corrupção, tau = .95, data = banco)
  • Verificando o summary dos modelos ajustados
Código 
summary(fit_10M, se = "iid")

Call: rq(formula = Score ~ PIB + Suporte_Social + Expectativa_de_vida_saudavel + 
    liberdade + percepção_corrupção, tau = 0.1, data = banco)

tau: [1] 0.1

Coefficients:
                             Value    Std. Error t value  Pr(>|t|)
(Intercept)                   1.00596  0.47286    2.12738  0.03502
PIB                           1.14091  0.51777    2.20352  0.02908
Suporte_Social                1.22436  0.56741    2.15780  0.03254
Expectativa_de_vida_saudavel  1.01904  0.80142    1.27154  0.20551
liberdade                     1.32808  0.87840    1.51194  0.13265
percepção_corrupção          -0.50742  1.25042   -0.40580  0.68547
Código 
summary(fit_25M, se = "iid")

Call: rq(formula = Score ~ PIB + Suporte_Social + Expectativa_de_vida_saudavel + 
    liberdade + percepção_corrupção, tau = 0.25, data = banco)

tau: [1] 0.25

Coefficients:
                             Value   Std. Error t value Pr(>|t|)
(Intercept)                  1.30764 0.34454    3.79533 0.00021 
PIB                          0.59508 0.37725    1.57740 0.11681 
Suporte_Social               1.35128 0.41343    3.26847 0.00134 
Expectativa_de_vida_saudavel 1.56979 0.58393    2.68830 0.00799 
liberdade                    0.77202 0.64002    1.20625 0.22962 
percepção_corrupção          1.26899 0.91108    1.39283 0.16573
Código 
summary(fit_5M, se = "iid")

Call: rq(formula = Score ~ PIB + Suporte_Social + Expectativa_de_vida_saudavel + 
    liberdade + percepção_corrupção, tau = 0.5, data = banco)

tau: [1] 0.5

Coefficients:
                             Value   Std. Error t value Pr(>|t|)
(Intercept)                  1.76363 0.24590    7.17226 0.00000 
PIB                          0.58461 0.26925    2.17129 0.03148 
Suporte_Social               1.08122 0.29506    3.66437 0.00034 
Expectativa_de_vida_saudavel 1.44649 0.41675    3.47087 0.00068 
liberdade                    1.50718 0.45678    3.29959 0.00121 
percepção_corrupção          1.92726 0.65024    2.96393 0.00353
Código 
summary(fit_75M, se = "iid")

Call: rq(formula = Score ~ PIB + Suporte_Social + Expectativa_de_vida_saudavel + 
    liberdade + percepção_corrupção, tau = 0.75, data = banco)

tau: [1] 0.75

Coefficients:
                             Value    Std. Error t value  Pr(>|t|)
(Intercept)                   2.28643  0.16773   13.63161  0.00000
PIB                           0.78059  0.18366    4.25023  0.00004
Suporte_Social                1.02035  0.20127    5.06962  0.00000
Expectativa_de_vida_saudavel  0.80341  0.28427    2.82618  0.00535
liberdade                     2.05628  0.31158    6.59957  0.00000
percepção_corrupção           1.32713  0.44354    2.99215  0.00324
Código 
summary(fit_90M, se = "iid")

Call: rq(formula = Score ~ PIB + Suporte_Social + Expectativa_de_vida_saudavel + 
    liberdade + percepção_corrupção, tau = 0.9, data = banco)

tau: [1] 0.9

Coefficients:
                             Value    Std. Error t value  Pr(>|t|)
(Intercept)                   2.70064  0.23674   11.40776  0.00000
PIB                           0.69128  0.25922    2.66679  0.00850
Suporte_Social                0.49039  0.28407    1.72628  0.08636
Expectativa_de_vida_saudavel  1.19520  0.40123    2.97884  0.00338
liberdade                     3.05758  0.43977    6.95274  0.00000
percepção_corrupção           0.41815  0.62602    0.66796  0.50519
Código 
summary(fit_95M, se = "iid")
Warning in rq.fit.br(x, y, tau = tau, ...): Solution may be nonunique

Call: rq(formula = Score ~ PIB + Suporte_Social + Expectativa_de_vida_saudavel + 
    liberdade + percepção_corrupção, tau = 0.95, data = banco)

tau: [1] 0.95

Coefficients:
                             Value    Std. Error t value  Pr(>|t|)
(Intercept)                   2.77429  0.23576   11.76717  0.00000
PIB                           0.53808  0.25815    2.08435  0.03882
Suporte_Social                0.46934  0.28291    1.65899  0.09921
Expectativa_de_vida_saudavel  1.35820  0.39958    3.39905  0.00087
liberdade                     3.09853  0.43796    7.07492  0.00000
percepção_corrupção           0.87262  0.62345    1.39967  0.16368
Reajuste dos modelos

Como foi observado acima, para os diferentes quantis, temos variáveis que são significativas, e outras que não. Levando isso em consideração, vamos retirar quais não são para os respectivos ajustes.

  • Percentil 10
Código 
fit_10M <- rq(Score~PIB+Suporte_Social, data = banco, tau = .10)
Código 
summary(fit_10M, se = "nid")

Call: rq(formula = Score ~ PIB + Suporte_Social, tau = 0.1, data = banco)

tau: [1] 0.1

Coefficients:
               Value   Std. Error t value Pr(>|t|)
(Intercept)    1.58793 0.30555    5.19695 0.00000 
PIB            1.82584 0.32239    5.66343 0.00000 
Suporte_Social 1.13023 0.39029    2.89590 0.00433
Resultado

Observamos acima que ao nível de significância de 5% todas as variáveis são significativas, considerando que o erro é nid

  • Percentil 25 ou 1º Quartil
Código 
fit_25M <- rq(Score~Suporte_Social+Expectativa_de_vida_saudavel, data = banco, tau = .25)
Código 
summary(fit_25M, se = "iid")

Call: rq(formula = Score ~ Suporte_Social + Expectativa_de_vida_saudavel, 
    tau = 0.25, data = banco)

tau: [1] 0.25

Coefficients:
                             Value    Std. Error t value  Pr(>|t|)
(Intercept)                   1.44738  0.12094   11.96732  0.00000
Suporte_Social                1.72484  0.13970   12.34670  0.00000
Expectativa_de_vida_saudavel  2.01355  0.17263   11.66412  0.00000
Resultado

Observamos acima que ao nível de significância de 5% todas as variáveis são significativas, considerando que o erro é iid

  • Percentil 50 ou mediana
Código 
summary(fit_5M, se = "iid")

Call: rq(formula = Score ~ PIB + Suporte_Social + Expectativa_de_vida_saudavel + 
    liberdade + percepção_corrupção, tau = 0.5, data = banco)

tau: [1] 0.5

Coefficients:
                             Value   Std. Error t value Pr(>|t|)
(Intercept)                  1.76363 0.24590    7.17226 0.00000 
PIB                          0.58461 0.26925    2.17129 0.03148 
Suporte_Social               1.08122 0.29506    3.66437 0.00034 
Expectativa_de_vida_saudavel 1.44649 0.41675    3.47087 0.00068 
liberdade                    1.50718 0.45678    3.29959 0.00121 
percepção_corrupção          1.92726 0.65024    2.96393 0.00353
Resultado

Observamos acima que ao nível de significância de 5% todas as variáveis são significativas, e podemos ver que para os que estão ali na faixa da mediana, a importância para a explicação é de quase todas as variáveis independentes (exceto, a generosidade que já foi retirado do modelo) considerando que o erro é nid.

  • Percentil 75 ou 3º Quartil
Código 
fit_75M <- rq(Score~PIB+Suporte_Social+Expectativa_de_vida_saudavel+liberdade+percepção_corrupção, data = banco, tau = .75)
Código 
summary(fit_75M, se = "nid")
Warning in summary.rq(fit_75M, se = "nid"): 1 non-positive fis

Call: rq(formula = Score ~ PIB + Suporte_Social + Expectativa_de_vida_saudavel + 
    liberdade + percepção_corrupção, tau = 0.75, data = banco)

tau: [1] 0.75

Coefficients:
                             Value    Std. Error t value  Pr(>|t|)
(Intercept)                   2.28643  0.12780   17.89083  0.00000
PIB                           0.78059  0.21008    3.71570  0.00029
Suporte_Social                1.02035  0.16367    6.23423  0.00000
Expectativa_de_vida_saudavel  0.80341  0.31678    2.53620  0.01223
liberdade                     2.05628  0.18927   10.86403  0.00000
percepção_corrupção           1.32713  0.41961    3.16280  0.00189
Resultado

Observamos acima que ao nível de significância de 5% todas as variáveis são significativas, e como foi observado o erro é nid, pois tem estimativas do Std. Error menor.

  • Percentil 90
Código 
fit_90M <- rq(Score~PIB+Expectativa_de_vida_saudavel+liberdade, data = banco, tau = .90)
Código 
summary(fit_90M, se = "nid")
Warning in summary.rq(fit_90M, se = "nid"): 1 non-positive fis

Call: rq(formula = Score ~ PIB + Expectativa_de_vida_saudavel + liberdade, 
    tau = 0.9, data = banco)

tau: [1] 0.9

Coefficients:
                             Value    Std. Error t value  Pr(>|t|)
(Intercept)                   2.96945  0.10925   27.17925  0.00000
PIB                           0.86022  0.15008    5.73159  0.00000
Expectativa_de_vida_saudavel  1.47696  0.23678    6.23768  0.00000
liberdade                     3.13376  0.27171   11.53347  0.00000
Resultado

Observamos acima que ao nível de significância de 5% todas as variáveis são significativas, considerando que o erro é nid

  • Percentil 95
Código 
fit_95M <- rq(Score~PIB+Expectativa_de_vida_saudavel+liberdade, data = banco, tau = .95)
Código 
summary(fit_95M, se = "iid")
Warning in rq.fit.br(x, y, tau = tau, ...): Solution may be nonunique

Call: rq(formula = Score ~ PIB + Expectativa_de_vida_saudavel + liberdade, 
    tau = 0.95, data = banco)

tau: [1] 0.95

Coefficients:
                             Value    Std. Error t value  Pr(>|t|)
(Intercept)                   3.00748  0.04446   67.65005  0.00000
PIB                           0.91484  0.05612   16.30114  0.00000
Expectativa_de_vida_saudavel  1.56133  0.09281   16.82207  0.00000
liberdade                     2.99362  0.09314   32.14149  0.00000
Resultado

Observamos acima que ao nível de significância de 5% todas as variáveis são significativas, considerando que o erro é iid

Impossibilidade de realizar o teste de igualdade dos coeficientes, pois para os quantis diferentes temos variáveis significativas diferentes

  • Testando se o modelo está bem encaixado

Tomando a mediana como referência

Código 
fit5h_0 <- rq(Score~1, tau = .5, data = banco)
Warning in rq.fit.br(x, y, tau = tau, ...): Solution may be nonunique
Código 
anova(fit_5M, fit5h_0)
Quantile Regression Analysis of Deviance Table

Model 1: Score ~ PIB + Suporte_Social + Expectativa_de_vida_saudavel + liberdade + percepção_corrupção
Model 2: Score ~ 1
  Df Resid Df F value    Pr(>F)    
1  5      150  112.89 < 2.2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Resposta

Rejeitamos a hipótese nula ao nível de significância de 5%, ou seja, o modelo não é o correto ainda para explicar os dados.

  • Observando os valores ajustados
Código 
summary(fitted(fit_10M))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  1.635   3.830   4.775   4.607   5.420   6.197
Código 
summary(fitted(fit_25M))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  1.659   4.310   5.275   4.993   5.675   6.314
Código 
summary(fitted(fit_5M))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  2.337   4.777   5.583   5.454   6.119   7.626
Código 
summary(fitted(fit_75M))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  2.900   5.149   5.834   5.763   6.413   7.667
Código 
summary(fitted(fit_90M))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  3.700   5.422   6.129   6.049   6.786   7.749
Código 
summary(fitted(fit_95M))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  3.778   5.486   6.226   6.143   6.909   7.892
  • Verificando os resíduos
Código 
residuos <- residuals(fit_5M)
plot(residuos)

Análise gráfica

Podemos observar que os resíduos estão distribuídos em torno do zero, todavia, parece haver indícios de heterocedasticidade.

Código 
qqnorm(residuos)
qqline(residuos, col = 2)

Falta de normalidade dos resíduos

De acordo com a visualização gráfica acima, podemos observar que possívelmente os resíduos não estão distribuidos normalmente.

Código 
nortest::lillie.test(residuos)

    Lilliefors (Kolmogorov-Smirnov) normality test

data:  residuos
D = 0.064583, p-value = 0.1151

Resposta: Ao nível de 5% de significância não rejeitamos a hipótese nula de que os resíduos estão distribuidos normalmente.

  • Visualização gráfica dos coeficientes
Código 
fm <- rq(Score~PIB+ Suporte_Social+Expectativa_de_vida_saudavel+liberdade+percepção_corrupção, data = banco, tau = 1:9/10)
plot(summary(fm))

  • Medida de qualidade do ajuste
Código 
fit_10h0 <- rq(Score~1, data = banco, tau = 0.1)
fit_25h0 <- rq(Score~1, data = banco, tau = 0.25)
Warning in rq.fit.br(x, y, tau = tau, ...): Solution may be nonunique
Código 
fit_75h0 <- rq(Score~1, data = banco, tau = 0.75)
Warning in rq.fit.br(x, y, tau = tau, ...): Solution may be nonunique
Código 
fit_90h0 <- rq(Score~1, data = banco, tau = 0.90)
fit_95h0 <- rq(Score~1, data = banco, tau = 0.95)
Código 
1 - fit_10M$rho/fit_10h0$rho
[1] 0.4514445
Código 
1 - fit_25M$rho/fit_25h0$rho
[1] 0.4840089
Código 
1 - fit_5M$rho/fit5h_0$rho
[1] 0.5618295
Código 
1 - fit_75M$rho/fit_75h0$rho
[1] 0.5832276
Código 
1 - fit_90M$rho/fit_90h0$rho
[1] 0.5947459
Código 
1 - fit_95M$rho/fit_95h0$rho
[1] 0.5912744
Resultado

De fato, com a medida de qualidade acima, foi comprovado que o ajuste não se mostrou significativo, mesmo tendo uma possível melhora. O valor do pseudo \(R^2\) foi bem baixo para os diferentes níveis de quartil.

  • Teste da qualidade do ajuste
Código 
GOFTest(fit_5M, alpha = 0.05, B = 1000, seed = 986)
Goodness-of-fit test for quantile regression based on the cusum process 
A large test statistic (small p-value) is evidence of lack of fit 
Quantile 0.5: Test statistic = 0.0344; p-value = 0.013
Resposta

Rejeitamos a hipótese nula ao nível de significância de 5%, existe evidências estatísticas de que o modelo não está bem ajustado