Detección de heterocedasticidad con contraste White
2023-09-25
library(wooldridge)## Warning: package 'wooldridge' was built under R version 4.2.3data(hprice1)
head(force(hprice1), n=5) # mostrar las primeras 5 observaciones## price assess bdrms lotsize sqrft colonial lprice lassess llotsize lsqrft
## 1 300 349.1 4 6126 2438 1 5.703783 5.855359 8.720297 7.798934
## 2 370 351.5 3 9903 2076 1 5.913503 5.862210 9.200593 7.638198
## 3 191 217.7 3 5200 1374 0 5.252274 5.383118 8.556414 7.225482
## 4 195 231.8 3 4600 1448 1 5.273000 5.445875 8.433811 7.277938
## 5 373 319.1 4 6095 2514 1 5.921578 5.765504 8.715224 7.829630Estime el siguiente modelo:
price = ˆα + ˆα1(lotsize) + ˆα2(sqrft) + ˆα3(bdrms) + e
library(stargazer)##
## Please cite as:## Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.## R package version 5.2.3. https://CRAN.R-project.org/package=stargazermodelo_price1 <- lm(price ~lotsize + sqrft+ bdrms, data = hprice1)
summary(modelo_price1)##
## Call:
## lm(formula = price ~ lotsize + sqrft + bdrms, data = hprice1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -120.026 -38.530 -6.555 32.323 209.376
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.177e+01 2.948e+01 -0.739 0.46221
## lotsize 2.068e-03 6.421e-04 3.220 0.00182 **
## sqrft 1.228e-01 1.324e-02 9.275 1.66e-14 ***
## bdrms 1.385e+01 9.010e+00 1.537 0.12795
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 59.83 on 84 degrees of freedom
## Multiple R-squared: 0.6724, Adjusted R-squared: 0.6607
## F-statistic: 57.46 on 3 and 84 DF, p-value: < 2.2e-16- Use la libreria lmtest para verificar si su varianza residual es homocedástica a través de la prueba de White (incluya los términos cruzados).
options = 99999
library(lmtest)## Warning: package 'lmtest' was built under R version 4.2.3## Loading required package: zoo## Warning: package 'zoo' was built under R version 4.2.3##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericwhite <- bptest(modelo_price1, ~I(lotsize^2)+I(bdrms^2)+lotsize* sqrft+lotsize*bdrms+sqrft*bdrms, data= hprice1)
print(white)##
## studentized Breusch-Pagan test
##
## data: modelo_price1
## BP = 33.706, df = 8, p-value = 4.592e-05El p valor es 0.0000 > 0.05. Tenemos evidencia empírica suficiente para rechazar H0 al 5%. Por tanto, la varianza es heterocedástica.
#Prueba de White (manual)
residuos <- modelo_price1$residuals e2 <- residuos**2head(residuos)## 1 2 3 4 5 6
## -45.639765 74.848732 -8.236558 -12.081520 18.093192 62.939597head(e2)## 1 2 3 4 5 6
## 2082.98814 5602.33268 67.84089 145.96312 327.36359 3961.39282PW <- as.data.frame(cbind(residuos, hprice1))str(PW)## 'data.frame': 88 obs. of 11 variables:
## $ residuos: num -45.64 74.85 -8.24 -12.08 18.09 ...
## $ price : num 300 370 191 195 373 ...
## $ assess : num 349 352 218 232 319 ...
## $ bdrms : int 4 3 3 3 4 5 3 3 3 3 ...
## $ lotsize : num 6126 9903 5200 4600 6095 ...
## $ sqrft : int 2438 2076 1374 1448 2514 2754 2067 1731 1767 1890 ...
## $ colonial: int 1 1 0 1 1 1 1 1 0 0 ...
## $ lprice : num 5.7 5.91 5.25 5.27 5.92 ...
## $ lassess : num 5.86 5.86 5.38 5.45 5.77 ...
## $ llotsize: num 8.72 9.2 8.56 8.43 8.72 ...
## $ lsqrft : num 7.8 7.64 7.23 7.28 7.83 ...# Regresión auxiliar
#=====================
regresion_aux <- lm(I(residuos^2)~lotsize+sqrft+bdrms+I(lotsize^2)+I(sqrft^2)+I(bdrms^2)+lotsize*sqrft+lotsize*bdrms+sqrft*bdrms, data = PW)summary(regresion_aux)##
## Call:
## lm(formula = I(residuos^2) ~ lotsize + sqrft + bdrms + I(lotsize^2) +
## I(sqrft^2) + I(bdrms^2) + lotsize * sqrft + lotsize * bdrms +
## sqrft * bdrms, data = PW)
##
## Residuals:
## Min 1Q Median 3Q Max
## -10837 -2310 -1169 880 40657
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.563e+04 1.137e+04 1.374 0.17325
## lotsize -1.860e+00 6.371e-01 -2.919 0.00459 **
## sqrft -2.674e+00 8.662e+00 -0.309 0.75838
## bdrms -1.983e+03 5.438e+03 -0.365 0.71640
## I(lotsize^2) -4.978e-07 4.631e-06 -0.107 0.91467
## I(sqrft^2) 3.523e-04 1.840e-03 0.191 0.84864
## I(bdrms^2) 2.898e+02 7.588e+02 0.382 0.70362
## lotsize:sqrft 4.568e-04 2.769e-04 1.650 0.10303
## lotsize:bdrms 3.146e-01 2.521e-01 1.248 0.21572
## sqrft:bdrms -1.021e+00 1.667e+00 -0.612 0.54210
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5884 on 78 degrees of freedom
## Multiple R-squared: 0.3833, Adjusted R-squared: 0.3122
## F-statistic: 5.387 on 9 and 78 DF, p-value: 1.013e-05sumario <- summary(regresion_aux)
n <- nrow(PW)n## [1] 88R2_aux <- sumario$r.squaredR2_aux## [1] 0.3833143W <- n*R2_auxW## [1] 33.73166gl <- 9gl## [1] 9pvalor <- 1-pchisq(q = W, df = gl)pvalor## [1] 9.95294e-05VC <- qchisq(p = 0.95, df = gl)VC## [1] 16.91898salida_PW <- c(W, VC, pvalor)
names(salida_PW) <- c("LMw", "Valor Crítico", "P-Value")library(stargazer)stargazer(salida_PW, title = "Resultados para la prueba WHite", type = "html", digits=6)##
## <table style="text-align:center"><caption><strong>Resultados para la prueba WHite</strong></caption>
## <tr><td colspan="3" style="border-bottom: 1px solid black"></td></tr><tr><td style="text-align:left">LMw</td><td>Valor Crítico</td><td>P-Value</td></tr>
## <tr><td colspan="3" style="border-bottom: 1px solid black"></td></tr><tr><td style="text-align:left">33.731660</td><td>16.918980</td><td>0.000100</td></tr>
## <tr><td colspan="3" style="border-bottom: 1px solid black"></td></tr></table>salida_PW## LMw Valor Crítico P-Value
## 3.373166e+01 1.691898e+01 9.952940e-05Como resultado de la heterocedasticidad en los residuos del modelo, tenemos que 0.05 > 0.0001000; por lo tanto existe apoyo estadístico para rechazar la hipótesis nula. Tenemos un problema de heterocedasticidad.
library(fastGraph)## Warning: package 'fastGraph' was built under R version 4.2.3LM_W<-W
gl<-9
vc<-qchisq(p=0.95, df=gl)
shadeDist(xshade = LM_W,
ddist = "dchisq",
parm1 = LM_W,
lower.tail = FALSE,
sub=paste("VC:", VC, "White:", LM_W))
Se rechaza la H0. Hay evidencia de que la varianza de los residuos es
heterocedástica, LM_W 33.73 > VC 16.91