UNIVERSIDAD DE EL SALVADOR

FACULTAD DE CIENCIAS ECONÓMICAS

ESCUELA DE ECONOMÍA

CICLO I - 2023

“EJERCICIO DE HETEROCEDASTICIDAD”

Asignatura

Econometría

Grupo teórico

Gt 01

Docente

MSF.Carlos Ademir Peréz Alas

Realizado por:

Mendoza Lemus, Johan Eli ML18043

Ciudad universitaria, 21 de mayo de 2023

---

Utilizando los datos del dataframe hprice1: disponible en el paquete wooldridge use el siguiente código para generar el dataframe:

#Carga de datos

library(wooldridge)
data(hprice1) 
head(force(hprice1), n=5) 

##   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.829630

1. Estime el siguiente modelo:

Price=α̂+α̂₁(lotsize)+α̂₂(sqrft)+α̂₃(bdrms)+ε

#Estimación del modelo 
library(stargazer)
modelo_precio <- lm(formula = price ~ lotsize + sqrft + bdrms, data = hprice1)
stargazer(modelo_precio, title = "Modelo del precio", type = "html", digits = 4)

Modelo del precio

	Dependent variable:
	price
lotsize	0.0021***
	(0.0006)
sqrft	0.1228***
	(0.0132)
bdrms	13.8525
	(9.0101)
Constant	-21.7703
	(29.4750)
Observations	88
R2	0.6724
Adjusted R2	0.6607
Residual Std. Error	59.8335 (df = 84)
F Statistic	57.4602*** (df = 3; 84)
Note:	p<0.1; p<0.05; p<0.01

A) VERIFICACIÓN DE LA HOMOCEDÁSTICIDAD DE LA VARIANZA RESIDUAL A TRAVÉS DE LA PRUEBA WHITE INCLUYENDO LOS TÉRMINOS CRUZADOS

PRUEBA WHITE

library(stargazer)
residuos_precio <-modelo_precio$residuals

data_white <- as.data.frame(cbind(residuos_precio, hprice1))

regre_axu <- lm(I(residuos_precio^2)~ lotsize + sqrft + bdrms + I(lotsize^2) +I(sqrft^2)+I(bdrms^2)+lotsize*sqrft+lotsize*bdrms+lotsize*lotsize+sqrft*bdrms+sqrft*sqrft+bdrms*bdrms, data = data_white)

resumen <- summary (regre_axu)

R_2 <- resumen$r.squared

n <- nrow(data_white)

LM_w <- n*R_2

gl = 3+3+3

p_value <- 1-pchisq(q= LM_w, df =gl)

VC <- qchisq (p = 0.95, df = gl)

salida_white <-c(LM_w,VC,p_value)

names(salida_white) <- c("LMw", "Valor Crítico", "p value")

stargazer(salida_white, title = "Resultados de la prueba White", type = "html", digits = 6)

Resultados de la prueba White

LMw	Valor Crítico	p value
33.731660	16.918980	0.000100

Criterio de decisión:

• Rechazar H₀ sí LM_W ≥ VC

• Rechazar H₀ sí P_value ≤ α

Como 33.73 > 0.000100 se rechaza la H₀, por tanto, no hay evidencia de que la varianza de los residuos es homocedástica.

PRUEBA WHITE USANDO “lmtest”

library(lmtest)

prueba_White<-bptest(modelo_precio,~lotsize+sqrft+bdrms+I(lotsize^2)+I(sqrft^2)+I(bdrms^2)+lotsize*sqrft+lotsize*bdrms+lotsize*lotsize+sqrft*bdrms+sqrft*sqrft+bdrms*bdrms,data = hprice1)

print(prueba_White)

## 
##  studentized Breusch-Pagan test
## 
## data:  modelo_precio
## BP = 33.732, df = 9, p-value = 9.953e-05

Criterio de decisión:

• Rechazar H₀ sí LM_W ≥ VC

• Rechazar H₀ sí P_value ≤ α

Como 0.00009953 < 0.05 se rechaza la H₀, por tanto, no hay evidencia de que la varianza de los residuos es homocedástica.

B) GRÁFICO DE LA PRUEBA WHITE.

options(scipen = 999999)
library(fastGraph)
pw <- prueba_White
gl <- 3 + 3 + 3
VC <- qchisq(p = 0.95, df = gl)
alpha_sig <- 0.05
shadeDist(pw$statistic,
          ddist = "dchisq",
          parm1 = gl,
          lower.tail = FALSE,
          main = "Resultados de la prueba White",
          sub = paste("LMw:", pw$statistic, "VC:", VC))