Prueba de Heterocedasticidad de White
## 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.829630Modelo Estimado
library(stargazer)
modelo <- lm(formula= price ~ lotsize + sqrft + bdrms, data = hprice1)
stargazer(modelo, title = "Modelo Estimacion", type = "text", digits = 6)##
## Modelo Estimacion
## ===============================================
## Dependent variable:
## ---------------------------
## price
## -----------------------------------------------
## lotsize 0.002068***
## (0.000642)
##
## sqrft 0.122778***
## (0.013237)
##
## bdrms 13.852520
## (9.010145)
##
## Constant -21.770310
## (29.475040)
##
## -----------------------------------------------
## Observations 88
## R2 0.672362
## Adjusted R2 0.660661
## Residual Std. Error 59.833480 (df = 84)
## F Statistic 57.460230*** (df = 3; 84)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01Funciones para generar las regresiones auxiliares para la prueba de White
#1-Generar fórmula para procedimiento "manual" con términos de interacción
form_compl_manual_interaccion <- function(endogena,variables) {
terminos_lineales <- paste(variables, collapse = " + ")
terminos_cuadraticos <- paste(paste0("I(", variables, "^2)"), collapse = " + ")
interaccion <- combn(variables, 2, FUN = function(x) paste(x, collapse = "*"), simplify = TRUE)
terminos_interaccion <- paste(interaccion, collapse = " + ")
cadena_formula <- paste(terminos_lineales, terminos_cuadraticos, terminos_interaccion, sep = " + ")
objeto_formula <- as.formula(paste(endogena,"~", cadena_formula))
return(objeto_formula)
}
#2-Generar fórmula para procedimiento "manual" Sin términos de interacción
form_compl_manual <- function(endogena, variables) {
terminos_lineales <- paste(variables, collapse = " + ")
terminos_cuadraticos <- paste(paste0("I(", variables, "^2)"), collapse = " + ")
cadena_formula <- paste(terminos_lineales, terminos_cuadraticos, sep = " + ")
objeto_formula <- as.formula(paste(endogena, "~", cadena_formula))
return(objeto_formula)
}
#3-Fórmula complementaria (para ser usada con bptest del package lmtest)
#3-1 Con términos de interacción.
form_compl_interaccion <- function(variables) {
terminos_cuadraticos <- paste(paste0("I(", variables, "^2)"), collapse = " + ")
interaccion <- combn(variables, 2, FUN = function(x) paste(x, collapse = "*"), simplify = TRUE)
terminos_interaccion <- paste(interaccion, collapse = " + ")
cadena_formula <- paste(terminos_cuadraticos, terminos_interaccion, sep = " + ")
objeto_formula <- as.formula(paste("~", cadena_formula))
return(objeto_formula)
}
#3-2 Sin terminos de interacción
form_compl <- function(variables) {
terminos_cuadraticos <- paste(paste0("I(", variables, "^2)"), collapse = " + ")
objeto_formula <- as.formula(paste("~", terminos_cuadraticos))
return(objeto_formula)
}Ejemplos de uso
Usando “lmtest”
variables_explicativas<-c("lotsize","sqrft","bdrms")
form_aux<-form_compl_interaccion(variables_explicativas)
form_aux2<-form_compl(variables_explicativas)
library(lmtest)
#Con términos cruzados
prueba_white<-bptest(modelo,form_aux,data = hprice1) |> print()##
## studentized Breusch-Pagan test
##
## data: modelo
## BP = 33.732, df = 9, p-value = 9.953e-05##
## studentized Breusch-Pagan test
##
## data: modelo
## BP = 11.99, df = 3, p-value = 0.007416Cálculo manual
formula_complementaria<-form_compl_manual_interaccion("I(u_i^2)",variables_explicativas)
library(lmtest)
u_i<-modelo$residuals
data_prueba_white<-as.data.frame(cbind(u_i,hprice1))
# Formula escrita manual
regresion_auxiliar<-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)
sumario<-summary(regresion_auxiliar)
#Usando la función auxiliar
regresion_auxiliar_2<-lm(formula_complementaria,data = data_prueba_white)
stargazer(regresion_auxiliar,regresion_auxiliar_2,type = "text")##
## ==========================================================
## Dependent variable:
## ----------------------------
## I(u_i2)
## (1) (2)
## ----------------------------------------------------------
## lotsize -1.860*** -1.860***
## (0.637) (0.637)
##
## sqrft -2.674 -2.674
## (8.662) (8.662)
##
## bdrms -1,982.841 -1,982.841
## (5,438.483) (5,438.483)
##
## I(lotsize2) -0.00000 -0.00000
## (0.00000) (0.00000)
##
## I(sqrft2) 0.0004 0.0004
## (0.002) (0.002)
##
## I(bdrms2) 289.754 289.754
## (758.830) (758.830)
##
## lotsize:sqrft 0.0005 0.0005
## (0.0003) (0.0003)
##
## lotsize:bdrms 0.315 0.315
## (0.252) (0.252)
##
## sqrft:bdrms -1.021 -1.021
## (1.667) (1.667)
##
## Constant 15,626.240 15,626.240
## (11,369.410) (11,369.410)
##
## ----------------------------------------------------------
## Observations 88 88
## R2 0.383 0.383
## Adjusted R2 0.312 0.312
## Residual Std. Error (df = 78) 5,883.814 5,883.814
## F Statistic (df = 9; 78) 5.387*** 5.387***
## ==========================================================
## Note: *p<0.1; **p<0.05; ***p<0.01n<-nrow(data_prueba_white)
R_2<-sumario$r.squared
LM_w<-n*R_2
gl=length(terms(regresion_auxiliar_2))
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 de White",type = "text",digits = 6)##
## Resultados de la prueba de White
## =================================
## LMw Valor Crítico p value
## ---------------------------------
## 33.731660 7.814728 0.0000002
## ---------------------------------