Ejercicio Detección de Heterocedasticidad
KATHERINE GABRIELA MIRANDA MANCIA
2026-04-25
#Utilizando los datos del dataframe hprice1: disponible en el paquete wooldridge use el siguiente código para generar el dataframe:
library(wooldridge)## Warning: package 'wooldridge' was built under R version 4.5.3data(hprice1)
head(force(hprice1),n=5) #mostrar las primeras 5 observacione## 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 modelo
library(stargazer)## Warning: package 'stargazer' was built under R version 4.5.2##
## 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_estimado <- lm(price ~ lotsize + sqrft + bdrms, data = hprice1)
stargazer(modelo_estimado, type = "text", title = "modelo estimado")##
## modelo estimado
## ===============================================
## Dependent variable:
## ---------------------------
## price
## -----------------------------------------------
## lotsize 0.002***
## (0.001)
##
## sqrft 0.123***
## (0.013)
##
## bdrms 13.853
## (9.010)
##
## Constant -21.770
## (29.475)
##
## -----------------------------------------------
## Observations 88
## R2 0.672
## Adjusted R2 0.661
## Residual Std. Error 59.833 (df = 84)
## F Statistic 57.460*** (df = 3; 84)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01a) 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).
VERIFICAR SUPUESTO DE HETEROCEDASTICIDAD
Prueba de white
calculo manual
library(stargazer)
library(lmtest)## Warning: package 'lmtest' was built under R version 4.5.2## Cargando paquete requerido: zoo## Warning: package 'zoo' was built under R version 4.5.2##
## Adjuntando el paquete: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric# 1. Ajuste de tu modelo original
modelo_ejemplo <- lm(price ~ lotsize + sqrft + bdrms, data = hprice1)
summary(modelo_ejemplo)##
## 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# 2. Extracción de residuos
u_i <- modelo_ejemplo$residuals
# 3. Creación del dataset auxiliar
data_prueba_white <- as.data.frame(cbind(u_i, hprice1))
# 4. Regresión auxiliar (Estructura del Test de White)
# Incluimos variables originales, cuadrados e interacciones
reg_aux <- lm(I(u_i^2) ~ lotsize + sqrft + bdrms +
I(lotsize^2) + I(sqrft^2) + I(bdrms^2) +
lotsize:sqrft + lotsize:bdrms + sqrft:bdrms,
data = data_prueba_white)
resumen <- summary(reg_aux)
# 5. Cálculos estadísticos corregidos
n <- nrow(data_prueba_white) # Usamos nrow() para obtener un número escalar
R_2 <- resumen$r.squared
LM_w <- n * R_2
# Grados de libertad (gl): 3 variables + 3 cuadrados + 3 interacciones = 9
gl <- 9
# Obtención de P-value y Valor Crítico
p_value <- 1 - pchisq(q = LM_w, df = gl)
VC <- qchisq(p = 0.95, df = gl)
# 6. Formatear salida para Stargazer
# Creamos un data.frame para que la tabla salga perfecta
tabla_resultados <- data.frame(
Estadistico_LM = LM_w,
Valor_Critico = VC,
P_Value = p_value
)
# Mostrar resultados manuales
stargazer(tabla_resultados,
type = "text",
summary = FALSE,
title = "Resultados de la prueba de White (Calculo Manual)",
digits = 6)##
## Resultados de la prueba de White (Calculo Manual)
## =======================================
## Estadistico_LM Valor_Critico P_Value
## ---------------------------------------
## 1 33.731660 16.918980 0.000100
## ---------------------------------------# 7. Comparación con la librería lmtest (Camino rápido)
prueba_white_fast <- bptest(modelo_ejemplo,
varformula = ~ lotsize + sqrft + bdrms +
I(lotsize^2) + I(sqrft^2) + I(bdrms^2) +
lotsize:sqrft + lotsize:bdrms + sqrft:bdrms,
data = hprice1)
print(prueba_white_fast)##
## studentized Breusch-Pagan test
##
## data: modelo_ejemplo
## BP = 33.732, df = 9, p-value = 9.953e-05calculo con libreria
# Cargar la librería necesaria
library(lmtest)
# Realizar la prueba de White usando bptest
# Nota: La fórmula incluye los cuadrados y las interacciones de tus variables
prueba_white <- bptest(modelo_ejemplo,
varformula = ~ lotsize + sqrft + bdrms +
I(lotsize^2) + I(sqrft^2) + I(bdrms^2) +
lotsize:sqrft + lotsize:bdrms + sqrft:bdrms,
data = hprice1)
# Mostrar los resultados
print(prueba_white)##
## studentized Breusch-Pagan test
##
## data: modelo_ejemplo
## BP = 33.732, df = 9, p-value = 9.953e-05b) graficar
# Residuos y ajustados
residuos <- residuals(modelo_estimado)
ajustados <- fitted(modelo_estimado)
# Pantalla 2x2
par(mfrow = c(2,2))
# 1. Residuos vs Ajustados (CLAVE)
plot(ajustados, residuos,
main = "Residuos vs Ajustados",
xlab = "Valores Ajustados",
ylab = "Residuos",
pch = 19, col = "blue")
abline(h = 0, lty = 2, col = "red")
# 2. Residuos vs lotsize
plot(hprice1$lotsize, residuos,
main = "Residuos vs lotsize",
xlab = "lotsize",
ylab = "Residuos",
pch = 19, col = "darkgreen")
# 3. Residuos vs sqrft
plot(hprice1$sqrft, residuos,
main = "Residuos vs sqrft",
xlab = "sqrft",
ylab = "Residuos",
pch = 19, col = "purple")
# 4. Residuos vs bdrms
plot(hprice1$bdrms, residuos,
main = "Residuos vs bdrms",
xlab = "bdrms",
ylab = "Residuos",
pch = 19, col = "brown")
# Residuos y valores ajustados
residuos <- residuals(modelo_estimado)
ajustados <- fitted(modelo_estimado)
# Gráfico
plot(ajustados, residuos,
main = "Verificacion de heterocedasticidad",
xlab = "Valores Ajustados",
ylab = "Residuos",
pch = 19, col = "blue")
# Línea horizontal en 0
abline(h = 0, col = "red", lty = 2)
Con base en la prueba de White (BP = 33.732, gl = 9, p-value =
9.95e-05), el p-valor es menor que el nivel de significancia de 0.05.
Por lo tanto, se rechaza la hipótesis nula de homocedasticidad y se
concluye que existe heterocedasticidad en el modelo. Esto implica que la
varianza de los errores no es constante, lo cual puede afectar la
validez de los errores estándar y las inferencias estadísticas. En
consecuencia, se recomienda aplicar correcciones, como el uso de errores
estándar robustos.