Sea el conjunto de datos, indicados en el enlace de abajo, tomados en 24 meses correspondientes a los gastos de comercialización (C) de una empresa, el nivel de ventas (V), su coste de personal (P) y los costes de materias primas (M); se trata de estimar el nivel de ventas a partir de las restantes variables.
Verifique los supuestos de Heterocedastidad y Autocorrelación para el modelo propuesto.
En caso de encontrar evidencia de violación de los supuestos, planteados en el literal anterior, corrija a través de un estimador HAC apropiado, el modelo propuesto.
library(readxl)
ventas_empresa <- read_excel("C:/Users/Eduardo/Downloads/ventas_empresa.xlsx")
library(stargazer)
modelo_regresion_Ej1<-lm(formula = V~C+P+M, data = ventas_empresa)
stargazer(modelo_regresion_Ej1,title = "Regresion Heterocedasticidad EJERCICIO 1",
type= "text")##
## Regresion Heterocedasticidad EJERCICIO 1
## ===============================================
## Dependent variable:
## ---------------------------
## V
## -----------------------------------------------
## C 0.923***
## (0.223)
##
## P 0.950***
## (0.156)
##
## M 1.298***
## (0.431)
##
## Constant 107.444***
## (18.057)
##
## -----------------------------------------------
## Observations 24
## R2 0.980
## Adjusted R2 0.977
## Residual Std. Error 9.506 (df = 20)
## F Statistic 323.641*** (df = 3; 20)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01library(stargazer)
u_i<-modelo_regresion_Ej1$residuals
data_aux_1<-as.data.frame(cbind(u_i,ventas_empresa))
reg_aux_1<-lm(I(u_i**2) ~ C + P + M + I(C^2) + I(P^2) + I(M^2) + C * P + C * M + M * P,
data = data_aux_1)
resumen<-summary(reg_aux_1)
R_2<-resumen$r.squared
n<-nrow(data_aux_1)
LM_w<-n*R_2
gl<-3+3+3
VC<-qchisq(p=0.95,df=gl)
p_value<-1-pchisq(q=LM_w,df=gl)
salida_prueba_Ej1<-c(LM_w,VC,p_value)
names(salida_prueba_Ej1)<-c("LMw","Valor Critico","P Value")
stargazer(salida_prueba_Ej1,title = "Prueba White",type = "text",digits = 6)##
## Prueba White
## ===============================
## LMw Valor Critico P Value
## -------------------------------
## 7.122650 16.918980 0.624351
## -------------------------------library(lmtest)
prueba_white<-bptest(modelo_regresion_Ej1,~C+P+M+I(C**2)+I(P**2)+I(M**2)+C*P+C*M+P*M,
data = ventas_empresa)
print(prueba_white)##
## studentized Breusch-Pagan test
##
## data: modelo_regresion_Ej1
## BP = 7.1227, df = 9, p-value = 0.6244Al tener un p-value mayor que nestro nivel de significancia (0.6244>0.05), por lo tanto se concluimos que No se rechaza H0 y existe evidencia de homocedasticidad.
library(lmtest)
dwtest(modelo_regresion_Ej1,alternative = "two.sided",iterations = 1000)##
## Durbin-Watson test
##
## data: modelo_regresion_Ej1
## DW = 1.2996, p-value = 0.05074
## alternative hypothesis: true autocorrelation is not 0Al tener un p-value mayor que el nivel de significancia (0.05074>0.05) concluimos que no hay evidencia de autocorrelacion, por lo tanto No se rechaza la H0.
library(car)
durbinWatsonTest(modelo_regresion_Ej1,simulate = TRUE,reps = 1000)## lag Autocorrelation D-W Statistic p-value
## 1 0.3013888 1.299572 0.05
## Alternative hypothesis: rho != 0Al tener un p-value >0.05, No se rechaza H0 por lo tanto loncluimos que No existe presencia de que los residuos sigan una autocorrelacion de primer orden.
library(dplyr)
library(tidyr)
library(stargazer)
library(kableExtra)
cbind(u_i,ventas_empresa)%>% as.data.frame()%>%
mutate(Lag_1=dplyr::lag(u_i,1),
Lag_2=dplyr::lag(u_i,2)) %>%
replace_na(list(Lag_1=0,Lag_2=0))-> data_prueba_BG1
kable(head(data_prueba_BG1,n=6))| u_i | V | C | P | M | Lag_1 | Lag_2 |
|---|---|---|---|---|---|---|
| 10.673678 | 607 | 197 | 173 | 110 | 0.000000 | 0.000000 |
| 7.372511 | 590 | 208 | 152 | 107 | 10.673678 | 0.000000 |
| -2.435532 | 543 | 181 | 150 | 99 | 7.372511 | 10.673678 |
| -3.322264 | 558 | 194 | 150 | 102 | -2.435532 | 7.372511 |
| -9.913932 | 571 | 192 | 163 | 109 | -3.322264 | -2.435532 |
| 8.704039 | 615 | 196 | 179 | 114 | -9.913932 | -3.322264 |
regresion_auxi_BG1<-lm(u_i~C+P+M+Lag_1+Lag_2,data = data_prueba_BG1)
resumen_BG1<-summary(regresion_auxi_BG1)
n<-nrow(data_prueba_BG1)
gl<-2
R_2_BG1<-resumen_BG1$r.squared
LM_BG<-n*R_2_BG1
VC<-qchisq(p=0.05,lower.tail = FALSE,df=gl)
p_value_BG1<-pchisq(q=LM_BG,lower.tail = FALSE,df=gl)
salida_BG<-c(LM_BG,VC,p_value_BG1)
names(salida_BG)<-c("LM BG","Valor Critico","P Value BG")
stargazer(salida_BG,title = "Prueba de BG",type = "text",digits = 6)##
## Prueba de BG
## =================================
## LM BG Valor Critico P Value BG
## ---------------------------------
## 3.840869 5.991465 0.146543
## ---------------------------------No se rechaza la H0 ya que PValue esmayor que el nivel de significancia (0.624351>0.05), No se rechaza la H0, por lo tanto los residuos no siguen autocorrelacion de orden 2.
library(lmtest)
bgtest(modelo_regresion_Ej1,order = 2)##
## Breusch-Godfrey test for serial correlation of order up to 2
##
## data: modelo_regresion_Ej1
## LM test = 3.8409, df = 2, p-value = 0.1465No se rechaza la H0 ya que PValue es 0.1465>0.05, por lo tanto los residuos No siguen autocorrelacion de orden 2.
library(lmtest)
bgtest(modelo_regresion_Ej1,order = 1)##
## Breusch-Godfrey test for serial correlation of order up to 1
##
## data: modelo_regresion_Ej1
## LM test = 2.5963, df = 1, p-value = 0.1071Al tener un P Value mayor que el nivel de significancia (0.1071>0.05) en la prueba de Breusch Godfrey hay evidencia que no existe autocorrelacion.
Se tienen los datos para trabajadores hombres,en el archivo adjunto, con ellos estime un modelo donde educ es años de escolaridad, como variable dependiente, y como regresores sibs (número de hermanos), meduc (años de escolaridad de la madre) y feduc (años de escolaridad del padre)
Verifique los supuestos de Heterocedastidad y Autocorrelación para el modelo propuesto.
En caso de encontrar evidencia de violación de los supuestos, planteados en el literal anterior, corrija a través de un estimador HAC apropiado, el modelo propuesto.
options(scipen = 999999)
library(stargazer)
load("C:/Users/Eduardo/Downloads/wage2.RData")
regresion_lineal_hombres<-lm(formula = educ~sibs+meduc+feduc,data = wage2)
stargazer(regresion_lineal_hombres, title = "Modelo Escolaridad Hombres",
type = "text",digits = 6)##
## Modelo Escolaridad Hombres
## ===============================================
## Dependent variable:
## ---------------------------
## educ
## -----------------------------------------------
## sibs -0.093636***
## (0.034471)
##
## meduc 0.130787***
## (0.032689)
##
## feduc 0.210004***
## (0.027475)
##
## Constant 10.364260***
## (0.358500)
##
## -----------------------------------------------
## Observations 722
## R2 0.214094
## Adjusted R2 0.210810
## Residual Std. Error 1.987052 (df = 718)
## F Statistic 65.198250*** (df = 3; 718)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01load("C:/Users/Eduardo/Downloads/wage2.RData")
library(lmtest)
prueba_white<-bptest(regresion_lineal_hombres,~I(sibs^2)+I(meduc^2)+I(feduc^2)+
sibs*meduc+sibs*feduc+meduc*feduc,data = wage2)
print(prueba_white)##
## studentized Breusch-Pagan test
##
## data: regresion_lineal_hombres
## BP = 15.537, df = 9, p-value = 0.0772Dado el resultado de la prueba White, se concluye que al poseer un P value mayor que la significancia (0.0772>0.05), No se rechaza la H0 y no hay evidencia de que exista heterocedasticidad.
library(lmtest)
dwtest(regresion_lineal_hombres,alternative = "two.sided",iterations = 1000)##
## Durbin-Watson test
##
## data: regresion_lineal_hombres
## DW = 1.8989, p-value = 0.1705
## alternative hypothesis: true autocorrelation is not 0Al tener un p-value mayor que el nivel de significancia (0.1705>0.05) concluimos que no hay evidencia de autocorrelacion, por lo tanto No se rechaza la H0.
library(car)
durbinWatsonTest(regresion_lineal_hombres,simulate = TRUE,reps = 1000)## lag Autocorrelation D-W Statistic p-value
## 1 0.05018452 1.898938 0.142
## Alternative hypothesis: rho != 0Al tener un p-value >0.05, No se rechaza H0 por lo tanto loncluimos que No existe presencia de que los residuos sigan una autocorrelacion de primer orden. # Autocorrelacion de orden superior (Utilizando lmtest)
library(lmtest)
bgtest(regresion_lineal_hombres,order = 2)##
## Breusch-Godfrey test for serial correlation of order up to 2
##
## data: regresion_lineal_hombres
## LM test = 4.5747, df = 2, p-value = 0.1015Al tener un P Value mayor que el nivel de significancia (0.1015>0.05) en la prueba de Breusch Godfrey hay evidencia que no existe autocorrelacion.
El sueldo inicial medio (salary) para los recién graduados de la Facultad de Economía se determina mediante una función lineal: log(salary)=f(SAT,GPA ,log(libvol),log(cost),rank)
Donde LSAT es la media del puntaje LSAT del grupo de graduados, GPA es la media del GPA (promedio general) del grupo, libvol es el número de volúmenes en la biblioteca de la Facultad de Economía, cost es el costo anual por asistir a dicha facultad y rank es una clasificación de las escuelas de Economía (siendo rank 1 la mejor)
Verifique los supuestos de Heterocedastidad y Autocorrelación para el modelo propuesto.
En caso de encontrar evidencia de violación de los supuestos, planteados en el literal anterior, corrija a través de un estimador HAC apropiado, el modelo propuesto.
options(scipen = 999999)
library(stargazer)
load("C:/Users/Eduardo/Downloads/LAWSCH85.RData")
modelo_regresion_3<-lm(formula = log(salary)~LSAT+GPA +log(libvol)+log(cost)+rank,
data = LAWSCH85)
stargazer(modelo_regresion_3, title = "Modelo Facultad de Economia", type = "text",
digits = 6)##
## Modelo Facultad de Economia
## ===============================================
## Dependent variable:
## ---------------------------
## log(salary)
## -----------------------------------------------
## LSAT 0.004696
## (0.004010)
##
## GPA 0.247524***
## (0.090037)
##
## log(libvol) 0.094993***
## (0.033254)
##
## log(cost) 0.037554
## (0.032106)
##
## rank -0.003325***
## (0.000348)
##
## Constant 8.343226***
## (0.532519)
##
## -----------------------------------------------
## Observations 136
## R2 0.841685
## Adjusted R2 0.835596
## Residual Std. Error 0.112412 (df = 130)
## F Statistic 138.229700*** (df = 5; 130)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01library(lmtest)
prueba_white_3<-bptest(modelo_regresion_3,~LSAT+GPA+
log(libvol)+log(cost)+rank+I(LSAT**2)+I(GPA**2)+
I(log(libvol)**2)+I(log(cost)**2)+I(rank**2)+
LSAT*GPA+LSAT*log(libvol)+LSAT*log(cost)+
LSAT*rank+GPA*log(libvol)+GPA*log(cost)+GPA*rank+
log(libvol)*log(cost)+log(libvol)*rank+log(cost)*rank,
data=LAWSCH85)
print(prueba_white_3)##
## studentized Breusch-Pagan test
##
## data: modelo_regresion_3
## BP = 34.295, df = 20, p-value = 0.0242Dado los resulados de la prueba White, obteniendo un P value menor que la significancia (0.0242<0.05), se concluye que Si se rechaza la H0 y hay evidencia de heterocedasticidad.
library(lmtest)
dwtest(modelo_regresion_3,alternative = "two.sided",iterations = 1000)##
## Durbin-Watson test
##
## data: modelo_regresion_3
## DW = 1.7058, p-value = 0.07519
## alternative hypothesis: true autocorrelation is not 0Al tener un p-value mayor que el nivel de significancia (0.07519>0.05) concluimos que no hay evidencia de autocorrelacion de 1mer orden, por lo tanto No se rechaza la H0.
library(car)
durbinWatsonTest(modelo_regresion_3,simulate = TRUE,reps = 1000)## lag Autocorrelation D-W Statistic p-value
## 1 0.1444578 1.705846 0.084
## Alternative hypothesis: rho != 0Al tener un p-value mayor que el nivel de significancia (P value>0.05) concluimos que no hay evidencia de autocorrelacionde 1mer orden, por lo tanto No se rechaza la H0.
library(lmtest)
bgtest(modelo_regresion_3,order = 2)##
## Breusch-Godfrey test for serial correlation of order up to 2
##
## data: modelo_regresion_3
## LM test = 3.2116, df = 2, p-value = 0.2007Dado que el P value es mayor que el nivel de significancia, No se rechaza la H0 y los residuos no siguen una autocorrelacion de 2do orden.
options(scipen = 99999)
library(lmtest)
#Sin corregir:
coeftest(modelo_regresion_3)##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.34322619 0.53251925 15.6675 < 0.00000000000000022 ***
## LSAT 0.00469647 0.00401049 1.1710 0.243723
## GPA 0.24752381 0.09003706 2.7491 0.006826 **
## log(libvol) 0.09499320 0.03325435 2.8566 0.004988 **
## log(cost) 0.03755392 0.03210608 1.1697 0.244269
## rank -0.00332459 0.00034846 -9.5408 < 0.00000000000000022 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1options(scipen = 99999)
library(lmtest)
library(sandwich)
#Corregido
estimacion_omega<-vcovHC(modelo_regresion_3,type = "HC0")
coeftest(modelo_regresion_3,vcov. = estimacion_omega)##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.34322619 0.50982813 16.3648 < 0.00000000000000022 ***
## LSAT 0.00469647 0.00447644 1.0492 0.2960547
## GPA 0.24752381 0.08861507 2.7932 0.0060073 **
## log(libvol) 0.09499320 0.02703852 3.5133 0.0006095 ***
## log(cost) 0.03755392 0.03258920 1.1523 0.2512950
## rank -0.00332459 0.00030126 -11.0356 < 0.00000000000000022 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1options(scipen = 999999)
library(robustbase)
library(stargazer)
modelo_regresion_3_robust<-lmrob(log(salary)~LSAT+GPA +log(libvol)+log(cost)+rank,
data = LAWSCH85)
stargazer(modelo_regresion_3,modelo_regresion_3_robust,type = "text",
title = "comparativa")##
## comparativa
## =================================================================
## Dependent variable:
## ----------------------------------
## log(salary)
## OLS MM-type
## linear
## (1) (2)
## -----------------------------------------------------------------
## LSAT 0.005 0.003
## (0.004) (0.005)
##
## GPA 0.248*** 0.283***
## (0.090) (0.105)
##
## log(libvol) 0.095*** 0.089***
## (0.033) (0.029)
##
## log(cost) 0.038 0.045
## (0.032) (0.042)
##
## rank -0.003*** -0.003***
## (0.0003) (0.0003)
##
## Constant 8.343*** 8.464***
## (0.533) (0.529)
##
## -----------------------------------------------------------------
## Observations 136 136
## R2 0.842 0.845
## Adjusted R2 0.836 0.839
## Residual Std. Error (df = 130) 0.112 0.090
## F Statistic 138.230*** (df = 5; 130)
## =================================================================
## Note: *p<0.1; **p<0.05; ***p<0.01Mediante la elaboracion de la correccion por medio del estimador HAC, se posee un mejor resultado para la elaboracion de pronosticos.