Especificación del modelo

Considere el siguiente modelo de regresión simple en el que el gasto monetario anual de los hogares españoles (GASTMON) está explicado en función de los ingresos mensuales netos totales del hogar (IMPEXAC):

\[ GASTMON_i=\beta_1+\beta_2IMPEXAC_i+u_i,\qquad i=1,...,n. \]

Datos - Encuesta de Presupuestos Familiares 2021

Para ajustar el modelo de regresión se utiliza la información de la Encuesta de Presupuestos Familiares correspondiente al año 2021 realizada por el Instituto Nacional de Estadística (INE). Los microdatos se encuentran disponibles en el siguiente enlace:

https://www.ine.es/dyngs/INEbase/es/operacion.htm?c=Estadistica_C&cid=1254736176806&menu=resultados&idp=1254735976608#

Una vez cargados los datos en RStudio, se define un nuevo conjunto de datos con las variables de interes y se eliminan las observaciones con datos faltantes para una mejor visualización y manipulación de los datos.

datos<-data.frame(GASTMON=EPFhogar_2021$GASTMON, IMPEXAC=EPFhogar_2021$IMPEXAC)
datos<-na.omit(datos)
head(datos)
##    GASTMON IMPEXAC
## 1  1750165     782
## 2  5424793    1283
## 3  8354997    1860
## 4  5009218    1350
## 5 20577774    1206
## 6 38507968    7774

Ajuste del modelo de regresión

Se aplica MCO en la muestra de 19390 observaciones obteniendo

REGR_INICIAL<-lm(GASTMON~IMPEXAC, data = datos)
summary(REGR_INICIAL)
## 
## Call:
## lm(formula = GASTMON ~ IMPEXAC, data = datos)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -74420453 -12251553  -5962415   5493147 381186643 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 8355602.3   321630.2   25.98   <2e-16 ***
## IMPEXAC        5829.6      118.6   49.16   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 22980000 on 19388 degrees of freedom
## Multiple R-squared:  0.1109, Adjusted R-squared:  0.1108 
## F-statistic:  2417 on 1 and 19388 DF,  p-value: < 2.2e-16

Y se guardan los residuos en la variable

RESIDUOS<- REGR_INICIAL$residuals
head(RESIDUOS)
##         1         2         3         4         5         6 
## -11164222 -10410247 -10843751 -11216409   5191616 -15167318

Procedimiento de detección de Heterocedasticidad

Se comprueba la presencia de heterocedasticidad usando los contrastes de White y Breusch-Pagan por tener una muestra de tamaño elevado.

El planteamiento del contraste es en ambos casos:

\[ H_0: Existe \space homocedasticidad \\ H_1: No \space existe \space homocedasticidad \]

Test de White

se ajusta por MCO la regresión auxiliar usando los residuos del modelo de regresión inicial como variable dependiente y y sus variables explicativas serán todas las variables regresoras del modelo original, sus cuadrados, y los productos cruzados entre tales variables. En este caso, se tiene la variable \(IMPEXAC\) y su cuadrado.

summary(lm(RESIDUOS^2~IMPEXAC+IMPEXAC^2, data=datos))
## 
## Call:
## lm(formula = RESIDUOS^2 ~ IMPEXAC + IMPEXAC^2, data = datos)
## 
## Residuals:
##        Min         1Q     Median         3Q        Max 
## -3.831e+15 -4.797e+14 -2.593e+14 -8.025e+13  1.447e+17 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -1.316e+14  3.929e+13  -3.349 0.000813 ***
## IMPEXAC      2.833e+11  1.449e+10  19.560  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.808e+15 on 19388 degrees of freedom
## Multiple R-squared:  0.01935,    Adjusted R-squared:  0.0193 
## F-statistic: 382.6 on 1 and 19388 DF,  p-value: < 2.2e-16

El estadístico del contraste se determina como

REGR_AUX<-lm(RESIDUOS^2~IMPEXAC+IMPEXAC^2, data=datos)
SST<-sum((RESIDUOS^2 - mean(RESIDUOS^2))^2)
SCR<-sum(REGR_AUX$residuals^2)
R2<-1-SCR /SST
length(REGR_AUX$residuals)*R2
## [1] 375.2299

Como \(\chi_{exp}=\) 375.2298946 \(> \chi^2_{0.95}\) 0.3781149 se concluye que el modelo tiene un problema de heterocedasticidad.

En RStudio se puede usar la siguiente función para aplicar el contraste de White:

library(lmtest)
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
bptest (REGR_INICIAL, ~ IMPEXAC + I(IMPEXAC ^ 2) , data = datos)
## 
##  studentized Breusch-Pagan test
## 
## data:  REGR_INICIAL
## BP = 438.29, df = 2, p-value < 2.2e-16

Test de Breusch-Pagan

se ajusta por MCO la regresión auxiliar usando los residuos del modelo de regresión inicial como variable dependiente y y sus variables explicativas serán todas las variables regresoras del modelo original. En este caso, se tiene la variable \(IMPEXAC\).

summary(lm(RESIDUOS^2~IMPEXAC, data=datos))
## 
## Call:
## lm(formula = RESIDUOS^2 ~ IMPEXAC, data = datos)
## 
## Residuals:
##        Min         1Q     Median         3Q        Max 
## -3.831e+15 -4.797e+14 -2.593e+14 -8.025e+13  1.447e+17 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -1.316e+14  3.929e+13  -3.349 0.000813 ***
## IMPEXAC      2.833e+11  1.449e+10  19.560  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.808e+15 on 19388 degrees of freedom
## Multiple R-squared:  0.01935,    Adjusted R-squared:  0.0193 
## F-statistic: 382.6 on 1 and 19388 DF,  p-value: < 2.2e-16

El estadístico del contraste se determina como

REGR_AUX<-lm(RESIDUOS^2~IMPEXAC, data=datos)
SST<-sum((RESIDUOS^2 - mean(RESIDUOS^2))^2)
SCR<-sum(REGR_AUX$residuals^2)
R2<-1-SCR /SST
length(REGR_AUX$residuals)*R2
## [1] 375.2299

Como \(\chi_{exp}=\) 375.2298946 \(> \chi^2_{0.95}\) 0.6702807 se concluye que el modelo tiene un problema de heterocedasticidad.

En RStudio se puede usar la siguiente función para aplicar el contraste de White:

library(lmtest)
bptest (REGR_INICIAL, data = datos)
## 
##  studentized Breusch-Pagan test
## 
## data:  REGR_INICIAL
## BP = 375.23, df = 1, p-value < 2.2e-16

Estimación de modelos con heterocedasticidad - Estimador Mínimos Cuadrados Generalizados Factible (MCGF)

Paso A. Se estima por MCO el siguiente modelo

\[ log(e^2_i)=\delta_1+\delta_2+IMPEXAC_i+\epsilon_i \]

REGR_W<-lm(log(RESIDUOS^2)~IMPEXAC, data=datos)
summary(REGR_W)
## 
## Call:
## lm(formula = log(RESIDUOS^2) ~ IMPEXAC, data = datos)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -24.8970  -0.7845   0.4518   1.1211   8.2927 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 3.099e+01  2.952e-02 1049.68   <2e-16 ***
## IMPEXAC     4.613e-04  1.088e-05   42.39   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.109 on 19388 degrees of freedom
## Multiple R-squared:  0.08482,    Adjusted R-squared:  0.08477 
## F-statistic:  1797 on 1 and 19388 DF,  p-value: < 2.2e-16

Paso B. Ahora, se estiman los valores \(\hat{\omega}_i\) de la siguiente forma:

\[ \hat{\omega}_i=exp(\hat{\delta}_1+\widehat{\delta}_2+IMPEXAC_i ) \]

W_EST<-exp(REGR_W$coefficients[1]+REGR_W$coefficients[2]*datos$IMPEXAC)

Paso C. Se dividen las variables incluidas en el MRLG original por \(\sqrt{\hat{\omega}_i}\):

datos$GASTMON_W<-datos$GASTMON/sqrt(W_EST)
datos$X1_W<-1/sqrt(W_EST)
datos$IMPEXAC_W<-datos$IMPEXAC/sqrt(W_EST)

A continuación se estima el modelo transformado por MCO. Con este procedimiento se consigue \(\hat{\beta}_{MCGF}\) y el modelo se ajusta como sigue:

REGR_HETEROSC<-lm(GASTMON_W~0+X1_W+IMPEXAC_W, data = datos)
summary(REGR_HETEROSC)
## 
## Call:
## lm(formula = GASTMON_W ~ 0 + X1_W + IMPEXAC_W, data = datos)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -2.378 -1.411 -0.696  0.614 63.260 
## 
## Coefficients:
##            Estimate Std. Error t value Pr(>|t|)    
## X1_W      7942360.3   284606.1   27.91   <2e-16 ***
## IMPEXAC_W    6053.1      143.9   42.06   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.309 on 19388 degrees of freedom
## Multiple R-squared:  0.4927, Adjusted R-squared:  0.4926 
## F-statistic:  9414 on 2 and 19388 DF,  p-value: < 2.2e-16

Finalmente, se comprueba que se ha solucionado el problema de heterocedastecidad

bptest (REGR_HETEROSC, data = datos)
## 
##  studentized Breusch-Pagan test
## 
## data:  REGR_HETEROSC
## BP = 0.31623, df = 1, p-value = 0.5739