LP16027_L3

EJERCICIO I

1. 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.

a)

Importación de datos

library(readxl)
ventas_empresa <- read_excel("C:/Users/kevin/Desktop/lab 3 econometria/ventas_empresa.xlsx")
head(ventas_empresa, n=6)

## # A tibble: 6 x 4
##       V     C     P     M
##   <dbl> <dbl> <dbl> <dbl>
## 1   607   197   173   110
## 2   590   208   152   107
## 3   543   181   150    99
## 4   558   194   150   102
## 5   571   192   163   109
## 6   615   196   179   114

Corriendo el modelo de regresion

library(stargazer)
modelo_ventas<-lm(formula = V~C+P+M, data = ventas_empresa)
stargazer(modelo_ventas,title = 'Modelo Estimado de ventas', type = 'html')

Modelo Estimado de ventas

	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.01

Prueba de White usando libreria “lmtest”

library(lmtest)
prueba_white<-bptest(modelo_ventas,~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_ventas
## BP = 7.1227, df = 9, p-value = 0.6244

R// Como 0.6244>0.05 No se rechaza la H0, por lo tanto hay evidencia de que la varianza de los residuos es homocedástica

Autocorrelación de 1° orden

Prueba de Durbin – Watson

Usando libreria “lmtest”

library(lmtest)
dwtest(modelo_ventas,alternative = "two.sided",iterations = 1000)

## 
##  Durbin-Watson test
## 
## data:  modelo_ventas
## DW = 1.2996, p-value = 0.05074
## alternative hypothesis: true autocorrelation is not 0

R// se rechaza la H0, ya que el pvalue es menor al nivel de significancia, por lo que existe evidencia de autocorrelacion de primer orden.

Autocorrelación de orden superior

1. Preparación de datos

library(dplyr)
library(tidyr)
library(kableExtra)
resid<-modelo_ventas$residuals
cbind(resid,ventas_empresa) %>% 
  as.data.frame() %>% 
  mutate(Lag_1=dplyr::lag(resid,1),
         Lag_2=dplyr::lag(resid,2)) %>% 
  replace_na(list(Lag_1=0,Lag_2=0))->data_prueba_BG
kable(head(data_prueba_BG,n=6))

resid	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

2. Calculando la regresión auxiliar y el estadístico LMBP (Breusch Godfrey)

library(stargazer)
regresion_auxiliar_BG<-lm(resid~C+P+M+Lag_1+Lag_2,data = data_prueba_BG)
sumario_BG<-summary(regresion_auxiliar_BG)
R_2_BG<-sumario_BG$r.squared
n<-nrow(data_prueba_BG)
LM_BG<-n*R_2_BG
gl<-2
p_value<-1-pchisq(q = LM_BG,df = gl)
VC_bg<-qchisq(p = 0.95,df = gl)
salida_bg<-c(LM_BG,VC_bg,p_value)
names(salida_bg)<-c("LMbg","Valor Crítico","p value")
stargazer(salida_bg,title = "Resultados de la prueba de Breusch Godfrey",type = "html",digits = 6)

Resultados de la prueba de Breusch Godfrey

LMbg	Valor Crítico	p value
3.840869	5.991465	0.146543

R// no se rechaza la hipotesis nula ya que el p value es mayor al nivel de significancia, por lo tanto no hay autocorrelación de segundo orden.

b)

Estimación Robusta para corrgir autocorrelacion de primer orden

Sin corregir autocorrelacion

options(scipen = 99999)
library(lmtest)
coeftest(modelo_ventas)

## 
## t test of coefficients:
## 
##              Estimate Std. Error t value    Pr(>|t|)    
## (Intercept) 107.44351   18.05749  5.9501 0.000008084 ***
## C             0.92257    0.22273  4.1420   0.0005047 ***
## P             0.95018    0.15585  6.0969 0.000005859 ***
## M             1.29779    0.43073  3.0130   0.0068718 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Corrigiendo aurocorrelacion (usando un estimador HAC)

options(scipen = 99999)
library(lmtest)
library(sandwich)
estimacion_omega_ventas<-vcovHC(modelo_ventas,type = "HC1") 
coeftest(modelo_ventas,vcov. = estimacion_omega_ventas)

## 
## t test of coefficients:
## 
##              Estimate Std. Error t value     Pr(>|t|)    
## (Intercept) 107.44351   14.40813  7.4571 0.0000003392 ***
## C             0.92257    0.17996  5.1265 0.0000514245 ***
## P             0.95018    0.15711  6.0478 0.0000065232 ***
## M             1.29779    0.42106  3.0822     0.005878 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

EJERCICIO II

2. 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)

a)

Estimando el modelo

library(readr)
load("C:/Users/kevin/Desktop/lab 3 econometria/wage2.RData")
head(wage2)

##   wage hours  IQ KWW educ exper tenure age married black south urban sibs
## 1  769    40  93  35   12    11      2  31       1     0     0     1    1
## 2  808    50 119  41   18    11     16  37       1     0     0     1    1
## 3  825    40 108  46   14    11      9  33       1     0     0     1    1
## 4  650    40  96  32   12    13      7  32       1     0     0     1    4
## 5  562    40  74  27   11    14      5  34       1     0     0     1   10
## 6 1400    40 116  43   16    14      2  35       1     1     0     1    1
##   brthord meduc feduc    lwage
## 1       2     8     8 6.645091
## 2      NA    14    14 6.694562
## 3       2    14    14 6.715384
## 4       3    12    12 6.476973
## 5       6     6    11 6.331502
## 6       2     8    NA 7.244227

Corriendo el modelo de regresion

library(stargazer)
modelo_trabajadores<-lm(formula =educ~sibs+meduc+feduc, data = wage2)
stargazer(modelo_trabajadores,title = 'Modelo Estimado de trabajadores', type = 'html', digits = 6)

Modelo Estimado de trabajadores

	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.01

Prueba de White usando libreria “lmtest”

library(lmtest)
prueba_white_trabajadores<-bptest(modelo_trabajadores,~I(sibs^2)+I(meduc^2)+I(feduc^2)+sibs*meduc+meduc*feduc+feduc*sibs,data = wage2)
print(prueba_white_trabajadores)

## 
##  studentized Breusch-Pagan test
## 
## data:  modelo_trabajadores
## BP = 15.537, df = 9, p-value = 0.0772

R//Como 0.0772>0.05, No se rechaza la H0, por lo tanto hay evidencia de que la varianza de los residuos es homocedástica

Autocorrelación de 1° orden

Prueba de Durbin – Watson

Usando libreria “lmtest”

library(lmtest)
dwtest(modelo_trabajadores,alternative = "two.sided",iterations = 1000)

## 
##  Durbin-Watson test
## 
## data:  modelo_trabajadores
## DW = 1.8989, p-value = 0.1705
## alternative hypothesis: true autocorrelation is not 0

R//No se rechaza la H0, ya que el pvalue 0.1705>0.05, por lo tanto no hay evidencia de autocorrelacion de primer orden.

Autocorrelación de orden superior

Usando libreria “lmtest”

bgtest(modelo_trabajadores,order = 2)

## 
##  Breusch-Godfrey test for serial correlation of order up to 2
## 
## data:  modelo_trabajadores
## LM test = 4.5747, df = 2, p-value = 0.1015

R//no se rechaza la hipotesis nula ya que el p value es mayor al nivel de significancia, por lo tanto no hay autocorrelación de segundo orden

b)

R// En ambos casos el modelo no presentan Heterosedastisidad ni Autocorrelacion en los residuos, por lo tanto la prueba de ajuste en la estimacion Robusta del modelo, no es necesaria

EJERCICIO III

3. 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)

a)

Importación de datos

library(readr)
load("C:/Users/kevin/Desktop/lab 3 econometria/LAWSCH85.RData")
head(LAWSCH85, n=6)

##   rank salary  cost LSAT  GPA libvol faculty age clsize north south east west
## 1  128  31400  8340  155 3.15    216      45  12    210     1     0    0    0
## 2  104  33098  6980  160 3.50    256      44 113    190     0     1    0    0
## 3   34  32870 16370  155 3.25    424      78 134    270     0     0    1    0
## 4   49  35000 17566  157 3.20    329     136  89    277     0     0    1    0
## 5   95  33606  8350  162 3.38    332      56  70    150     0     0    0    1
## 6   98  31700  8350  161 3.40    311      40  29    156     0     0    0    1
##    lsalary  studfac top10 r11_25 r26_40 r41_60  llibvol    lcost
## 1 10.35456 4.666667     0      0      0      0 5.375278 9.028818
## 2 10.40723 4.318182     0      0      0      0 5.545177 8.850804
## 3 10.40032 3.461539     0      0      1      0 6.049734 9.703206
## 4 10.46310 2.036765     0      0      0      1 5.796058 9.773721
## 5 10.42246 2.678571     0      0      0      0 5.805135 9.030017
## 6 10.36407 3.900000     0      0      0      0 5.739793 9.030017

Corriendo el modelo de regresion

library(stargazer)
modelo_sueldo<-lm(formula = lsalary~LSAT+GPA+llibvol+lcost+rank,data = LAWSCH85)
stargazer(modelo_sueldo,title = 'Modelo Estimado de sueldos', type = 'html')

Modelo Estimado de sueldos

	Dependent variable:
	lsalary
LSAT	0.005
	(0.004)
GPA	0.248***
	(0.090)
llibvol	0.095***
	(0.033)
lcost	0.038
	(0.032)
rank	-0.003***
	(0.0003)
Constant	8.343***
	(0.533)
Observations	136
R2	0.842
Adjusted R2	0.836
Residual Std. Error	0.112 (df = 130)
F Statistic	138.230*** (df = 5; 130)
Note:	p<0.1; p<0.05; p<0.01

Prueba de White usando libreria “lmtest”

library(lmtest)
prueba_white_sueldo<-bptest(modelo_sueldo,~I(LSAT^2)+I(GPA^2)+I(llibvol^2)+I(lcost^2)+I(rank^2)+LSAT*GPA+LSAT*llibvol+LSAT*lcost+LSAT*rank+GPA*llibvol+GPA*lcost+GPA*rank+llibvol*lcost+llibvol*rank+lcost*rank,data = LAWSCH85)
print(prueba_white_sueldo)

## 
##  studentized Breusch-Pagan test
## 
## data:  modelo_sueldo
## BP = 34.295, df = 20, p-value = 0.0242

Como p value es menor al nivel de significancia, 0.0242<0.05 se rechaza la hipotesis nula, por lo tanto hay evidencia de que la varianza de los residuos es heterocedastica

Autocorrelación de 1° orden

Prueba de Durbin – Watson

Usando libreria “car” pero no puedo utilizar esta libreria para la version que tengo asi que hare uso de una libreria llamada orcutt que tambien sirve para la prueba Durbin Watson

#{r, warning=FALSE,message=FALSE,eval=TRUE,echo=TRUE} #library(car) #durbinWatsonTest(modelo_sueldo,simulate = TRUE,reps = 1000) #

library(orcutt)

## Warning: package 'orcutt' was built under R version 3.5.3

dwtest(modelo_sueldo)

## 
##  Durbin-Watson test
## 
## data:  modelo_sueldo
## DW = 1.7058, p-value = 0.0376
## alternative hypothesis: true autocorrelation is greater than 0

R// Se rechaza la H0, ya que el pvalue es menor al nivel de significancia, 0.0376<0.05, por lo que hay evidencia de autocorrelacion de primer orden.

Autocorrelación de orden superior

Usando libreria “lmtest”

library(lmtest)
bgtest(modelo_sueldo,order = 2)

## 
##  Breusch-Godfrey test for serial correlation of order up to 2
## 
## data:  modelo_sueldo
## LM test = 3.2116, df = 2, p-value = 0.2007

R// no se rechaza la hipotesis nula ya que el p value es mayor al nivel de significancia, por lo tanto no hay autocorrelación de segundo orden.

b) 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.

Estimacion Robusta para corregir autocorrelacion

Estimación Robusta para corregir heterocedasticidad

Sin corregir

options(scipen = 99999)
library(lmtest)
coeftest(modelo_sueldo)

## 
## t test of coefficients:
## 
##                Estimate  Std. Error t value              Pr(>|t|)    
## (Intercept)  8.34322596  0.53251920 15.6675 < 0.00000000000000022 ***
## LSAT         0.00469647  0.00401049  1.1710              0.243722    
## GPA          0.24752388  0.09003704  2.7491              0.006826 ** 
## llibvol      0.09499321  0.03325435  2.8566              0.004988 ** 
## lcost        0.03755380  0.03210608  1.1697              0.244270    
## rank        -0.00332459  0.00034846 -9.5408 < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Corregido (usando un estimador HAC)

options(scipen = 99999)
library(lmtest)
library(sandwich)
estimacion_omega<-vcovHC(modelo_sueldo,type = "HC0") 
coeftest(modelo_sueldo,vcov. = estimacion_omega)

## 
## t test of coefficients:
## 
##                Estimate  Std. Error  t value              Pr(>|t|)    
## (Intercept)  8.34322596  0.50982819  16.3648 < 0.00000000000000022 ***
## LSAT         0.00469647  0.00447644   1.0492             0.2960540    
## GPA          0.24752388  0.08861505   2.7932             0.0060073 ** 
## llibvol      0.09499321  0.02703852   3.5133             0.0006095 ***
## lcost        0.03755380  0.03258921   1.1523             0.2512966    
## rank        -0.00332459  0.00030126 -11.0356 < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1