library(wooldridge)
library(gt)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
data(hprice1)
hprice1 %>%
head(5)%>%
gt() %>%
tab_header("Evidencia empírica para estimar el modelo.")
| Evidencia empírica para estimar el modelo. | |||||||||
| price | assess | bdrms | lotsize | sqrft | colonial | lprice | lassess | llotsize | lsqrft |
|---|---|---|---|---|---|---|---|---|---|
| 300 | 349.1 | 4 | 6126 | 2438 | 1 | 5.703783 | 5.855359 | 8.720297 | 7.798934 |
| 370 | 351.5 | 3 | 9903 | 2076 | 1 | 5.913503 | 5.862210 | 9.200593 | 7.638198 |
| 191 | 217.7 | 3 | 5200 | 1374 | 0 | 5.252274 | 5.383118 | 8.556414 | 7.225482 |
| 195 | 231.8 | 3 | 4600 | 1448 | 1 | 5.273000 | 5.445875 | 8.433811 | 7.277938 |
| 373 | 319.1 | 4 | 6095 | 2514 | 1 | 5.921578 | 5.765504 | 8.715224 | 7.829630 |
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=stargazer
options(scipen = 9999)
ModeloHeterocedasticidad <- lm(formula = price~lotsize+sqrft+ bdrms, data = hprice1)
stargazer(ModeloHeterocedasticidad, title = "Modelo Estimado", type = "text", digits = 7)
##
## Modelo Estimado
## ===============================================
## Dependent variable:
## ---------------------------
## price
## -----------------------------------------------
## lotsize 0.0020677***
## (0.0006421)
##
## sqrft 0.1227782***
## (0.0132374)
##
## bdrms 13.8525200
## (9.0101450)
##
## Constant -21.7703100
## (29.4750400)
##
## -----------------------------------------------
## Observations 88
## R2 0.6723622
## Adjusted R2 0.6606609
## Residual Std. Error 59.8334800 (df = 84)
## F Statistic 57.4602300*** (df = 3; 84)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01
library(stargazer)
#CALCULO MANUAL.
Ui <- ModeloHeterocedasticidad$residuals
Mat_X <- model.matrix(ModeloHeterocedasticidad)
MatrizX <- Mat_X[,-1]
VectorY <- hprice1$price
Data.PruebaWhite <- as.data.frame(cbind(Ui,VectorY, MatrizX ))
RegresionAuxiliar <- lm(formula = I(Ui^2)~lotsize+sqrft+bdrms+I(lotsize^2) + I(sqrft^2) + I(bdrms^2) + lotsize*sqrft+lotsize*bdrms+ sqrft*bdrms, data = Data.PruebaWhite)
sumario <- summary(RegresionAuxiliar)
n <- nrow(Data.PruebaWhite)
R2 <- sumario$r.squared
LMw <- n*R2
Gl <- 3+3+3
P.Value <- 1-pchisq(q = LMw, df = Gl)
Vc <- qchisq(p = 0.95, df = Gl)
Salida_Whitw <- c(LMw, Vc, P.Value)
names(Salida_Whitw) <- c("LMw", "Valor Critico", "P Value")
stargazer(Salida_Whitw, title = "Resultado de la prueba de White", type = "text", digits = 7)
##
## Resultado de la prueba de White
## ==================================
## LMw Valor Critico P Value
## ----------------------------------
## 33.7316600 16.9189800 0.0000995
## ----------------------------------
library(lmtest)
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
options(scipen = 999999)
PruebaWhite <- bptest(ModeloHeterocedasticidad, ~I(lotsize^2) + I(sqrft^2) + I(bdrms^2) + lotsize*sqrft+lotsize*bdrms+ sqrft*bdrms, data = hprice1)
print(PruebaWhite)
##
## studentized Breusch-Pagan test
##
## data: ModeloHeterocedasticidad
## BP = 33.732, df = 9, p-value = 0.00009953
P-value es manor o igual a 0.05 se rechaza la hipotesis nula por lo tanto hay evidencia de que por lo menos hay un coeficiente distinto de cero.
library(fastGraph)
PW <- PruebaWhite$statistic
gl <- PruebaWhite$parameter
VC <- qchisq(p = 0.05, df = gl,lower.tail = FALSE)
shadeDist(PW, ddist = "dchisq",
parm1 = gl,
lower.tail = FALSE, xmin = 0,
sub= paste("VC:", round(VC, digits = 3)," "," ",
"LMw:", round(PW,digits = 3)),
main = "Prueba de White")