ESTIMADORES HAC

UNIVERSIDAD DE EL SALVADOR
FACULTAD DE CIENCIAS ECONÓMICAS
ESCUELA DE ECONOMÍA
CICLO I - 2023
APLICACIÓN DE LA LIBRERÍA STARGAZER PARA PRESENTAR MODELOS CORREGIDOS CON ESTIMADORES HAC
ASIGNATURA: ECONOMETRÍA
CATEDRÁTICO: MSF. CARLOS ADEMIR PERÉZ
GRUPO TEÓRICO: 03
PRESENTADO POR: AGUILAR ZACARIAS, CRISTALI DAYAMARI
Carnet: AZ20006

1. Importación de datos

load("C:/Users/crist/Downloads/Cristali Dayamari Aguilar Zacarias - smoke.RData")
options(scipen = 999999999)
library(lmtest)
modelo_smoke<-lm(cigs~ cigpric + lcigpric + income + lincome + age + agesq + educ + white + restaurn, data = data)
coeftest(modelo_smoke)
## 
## t test of coefficients:
## 
##                   Estimate     Std. Error t value     Pr(>|t|)    
## (Intercept)  340.804374604  260.015587269  1.3107     0.190334    
## cigpric        2.002267667    1.492831189  1.3413     0.180220    
## lcigpric    -115.273464445   85.424315195 -1.3494     0.177585    
## income        -0.000046194    0.000133491 -0.3460     0.729402    
## lincome        1.404061178    1.708165841  0.8220     0.411340    
## age            0.778359013    0.160555612  4.8479 0.0000015001 ***
## agesq         -0.009150353    0.001749292 -5.2309 0.0000002158 ***
## educ          -0.494780616    0.168180198 -2.9420     0.003356 ** 
## white         -0.531051635    1.460721806 -0.3636     0.716287    
## restaurn      -2.644241351    1.129998690 -2.3400     0.019528 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

2. Resumen del modelo con stargazer

library(stargazer)
options(scipen = 999999999)
modelo_smoke<-lm(cigs~ cigpric + lcigpric + income + lincome + age + agesq + educ + white + restaurn, data = data)
summary(modelo_smoke)
## 
## Call:
## lm(formula = cigs ~ cigpric + lcigpric + income + lincome + age + 
##     agesq + educ + white + restaurn, data = data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -16.169  -9.357  -5.915   7.851  70.744 
## 
## Coefficients:
##                  Estimate    Std. Error t value    Pr(>|t|)    
## (Intercept)  340.80437460  260.01558727   1.311     0.19033    
## cigpric        2.00226767    1.49283119   1.341     0.18022    
## lcigpric    -115.27346445   85.42431520  -1.349     0.17758    
## income        -0.00004619    0.00013349  -0.346     0.72940    
## lincome        1.40406118    1.70816584   0.822     0.41134    
## age            0.77835901    0.16055561   4.848 0.000001500 ***
## agesq         -0.00915035    0.00174929  -5.231 0.000000216 ***
## educ          -0.49478062    0.16818020  -2.942     0.00336 ** 
## white         -0.53105164    1.46072181  -0.364     0.71629    
## restaurn      -2.64424135    1.12999869  -2.340     0.01953 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 13.41 on 797 degrees of freedom
## Multiple R-squared:  0.05515,    Adjusted R-squared:  0.04448 
## F-statistic: 5.169 on 9 and 797 DF,  p-value: 0.0000007735
library(stargazer)
stargazer(modelo_smoke, title = "Resumen del modelo de regresión", type = "html")
Resumen del modelo de regresión
Dependent variable:
cigs
cigpric 2.002
(1.493)
lcigpric -115.273
(85.424)
income -0.00005
(0.0001)
lincome 1.404
(1.708)
age 0.778***
(0.161)
agesq -0.009***
(0.002)
educ -0.495***
(0.168)
white -0.531
(1.461)
restaurn -2.644**
(1.130)
Constant 340.804
(260.016)
Observations 807
R2 0.055
Adjusted R2 0.044
Residual Std. Error 13.413 (df = 797)
F Statistic 5.169*** (df = 9; 797)
Note: p<0.1; p<0.05; p<0.01

3. Verificaciónn de pruebas de Heterocedasticidad y Autocorrelación

3.1 Prueba de heterocedasticidad

3.1.1 Prueba de White (prueba de Breusch Pagan)

library(lmtest)
p_white<-bptest(modelo_smoke,~I(cigpric^2)+I(lcigpric^2)+I(income^2)+I(lincome^2)+I(age^2)+I(agesq^2)+I(educ^2)+I(white^2)+I(restaurn^2),data = data)
print(p_white)
## 
##  studentized Breusch-Pagan test
## 
## data:  modelo_smoke
## BP = 26.323, df = 9, p-value = 0.001809
# Interpretación: Hay evidencia de heterocedasticidad debido a que p-value < 0.05 por lo tanto se rechaza la H0. 

3.2 Prueba del Multiplicador de Lagrange (Breusch Godfrey) - Pruebas de Autocorrelación

3.2.1 Autocorrelación de 1º orden (prueba de Durbin Watson)

library(car)
durbinWatsonTest(model = modelo_smoke)
##  lag Autocorrelation D-W Statistic p-value
##    1    -0.009243664      2.017442   0.916
##  Alternative hypothesis: rho != 0
# Interpretación: No hay evidencia de Autocorrelación de 1º orden ya que pvalue > 0.05

3.2.2 Autocorrelación de 2º Orden:

library(lmtest)
prueba_LM<-bgtest(modelo_smoke,order = 2)
print(prueba_LM)
## 
##  Breusch-Godfrey test for serial correlation of order up to 2
## 
## data:  modelo_smoke
## LM test = 0.26889, df = 2, p-value = 0.8742
# Interpretación: No hay evidencia de Autocorrelación de 2º orden ya que pvalue > 0.05

4. Estimador HAC

options(scipen = 999999999)
library(lmtest)
library(sandwich)
# Corregido
# Hc0 corrige solo Heterocedasticidad
vcov_HAC<- vcovHC(modelo_smoke, type="HC0")
coeftest(modelo_smoke,vcov. = vcov_HAC)
## 
## t test of coefficients:
## 
##                   Estimate     Std. Error t value        Pr(>|t|)    
## (Intercept)  340.804374604  278.565072832  1.2234        0.221530    
## cigpric        2.002267667    1.602727983  1.2493        0.211927    
## lcigpric    -115.273464445   91.344424868 -1.2620        0.207331    
## income        -0.000046194    0.000115593 -0.3996        0.689540    
## lincome        1.404061178    1.228970726  1.1425        0.253602    
## age            0.778359013    0.136944678  5.6837 0.0000000184838 ***
## agesq         -0.009150353    0.001451548 -6.3039 0.0000000004804 ***
## educ          -0.494780616    0.162968371 -3.0361        0.002475 ** 
## white         -0.531051635    1.361907703 -0.3899        0.696691    
## restaurn      -2.644241351    1.038254938 -2.5468        0.011058 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

5. Modelo “original” y el modelo “corregido” en una sola tabla

library(stargazer)
library(sandwich)
vcov_HAC<-vcovHC(modelo_smoke, type = "HC0")
robust<- sqrt(diag(vcov_HAC))

stargazer(modelo_smoke,modelo_smoke, se=list(NULL, robust),column.labels = c("Original","Corregido"), aling=TRUE, type = "html", title = "Modelo de consumo de cigarrillos")
Modelo de consumo de cigarrillos
Dependent variable:
cigs
Original Corregido
(1) (2)
cigpric 2.002 2.002
(1.493) (1.603)
lcigpric -115.273 -115.273
(85.424) (91.344)
income -0.00005 -0.00005
(0.0001) (0.0001)
lincome 1.404 1.404
(1.708) (1.229)
age 0.778*** 0.778***
(0.161) (0.137)
agesq -0.009*** -0.009***
(0.002) (0.001)
educ -0.495*** -0.495***
(0.168) (0.163)
white -0.531 -0.531
(1.461) (1.362)
restaurn -2.644** -2.644**
(1.130) (1.038)
Constant 340.804 340.804
(260.016) (278.565)
Observations 807 807
R2 0.055 0.055
Adjusted R2 0.044 0.044
Residual Std. Error (df = 797) 13.413 13.413
F Statistic (df = 9; 797) 5.169*** 5.169***
Note: p<0.1; p<0.05; p<0.01
Modelo de consumo de cigarrillos
TRUE