RESOLUCION PARCIAL 2

Resolución primera parte

1. Para un modelo con 2 regresores, la matriz de correlación es [1,0.96;0.96,1], el VIF es de:

R_matrix<- matrix(data= c(1,0.96,
                    0.96,1),
                  nrow = 2,
                  ncol=2)
print(R_matrix)

##      [,1] [,2]
## [1,] 1.00 0.96
## [2,] 0.96 1.00

VIF_1<-diag(solve(R_matrix))
print(VIF_1)

## [1] 12.7551 12.7551

Respuesta: el VIF es 12.7551

2. Prueba robusta para evaluar la normalidad de los residuos independientemente del tamaño muestral.

Respuesta: Prueba Jarque-Bera

3. En una prueba FG, para un modelo con 5 regresores y 60 observaciones conun alfa de 4.3% el estadístico de prueba dio 40, el valor del determinante de la matriz de correlación es:

options(scipen = 999999)
FG_estadistico<-40
m_regresores<-5
n_observaciones<-60
det_R<- exp(FG_estadistico/-((n_observaciones-1)-((2*m_regresores+5)/6)))
print(det_R)

## [1] 0.4926459

Respuesta: el valor del determinante de la matriz de correlación es 0.4926459

4. Si el VIF para una variable es de 2.5 y el coeficiente de correlación entre la variable y el resto de los regresores es de:

VIF_2<-2.5
coef_correlacion<- 1-(1/VIF_2)
print(coef_correlacion)

## [1] 0.6

Respuesta: El coeficiente de relación entre la variable y el resto de regresores es 0.60

5. Sean 10,15,-10,-15,4,-4, los residuos de un modelo. El estadístico de prueba para el contraste de normalidad KS es:

# Obteniendo matriz de residuos
mat_residuos_KS<-matrix(data = c(10,15, -10,
                                 -15, 4, -4),
                        nrow = 6,
                        ncol= 1)
print(mat_residuos_KS)

##      [,1]
## [1,]   10
## [2,]   15
## [3,]  -10
## [4,]  -15
## [5,]    4
## [6,]   -4

# Prueba de normalidad Kolmogorov-Smirnov con ajuste de Lilliefors
library(nortest)
lillie.test(mat_residuos_KS)

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  mat_residuos_KS
## D = 0.1374, p-value = 0.9763

Respuesta: El estadístico de prueba KS es 0.1374

6. En una prueba FG, para un modelo con 5 regresores y un alfa de 4.3% el Valor Crítico es de:

m_regresores2<-5
gl<-m_regresores2*(m_regresores2-1)/2
# Valor crítico
VC1<-qchisq(0.043,gl,lower.tail = FALSE)
print(VC1)

## [1] 18.79093

Respuesta: El valor crítico es 18.79093

7.Sean 10,15,-10,-15,4,-4, los residuos de un modelo. El estadístico de prueba para el contraste de normalidad JB es:

# Obteniendo matriz de residuos
mat_residuos_JB<-matrix(data = c(10, 15, -10,
                                 -15, 4, -4),
                        nrow = 6,
                        ncol= 1)
print(mat_residuos_JB)

##      [,1]
## [1,]   10
## [2,]   15
## [3,]  -10
## [4,]  -15
## [5,]    4
## [6,]   -4

# Prueba Jarque-Bera
library(normtest)
jb.norm.test(mat_residuos_JB)

## 
##  Jarque-Bera test for normality
## 
## data:  mat_residuos_JB
## JB = 0.51072, p-value = 0.5855

Respuesta: El estadístico de prueba JB es 0.51072

8. Para una tolerancia de 0.05 el VIF es de:

Tolerancia<-0.05
VIF_3<-1/Tolerancia
print(VIF_3)

## [1] 20

Respuesta: El VIF es de 20

9. Sean 10,15,-10,-15,4,-4, los residuos de un modelo. El estadístico de prueba para el contraste de normalidad de Shapiro Wilk es:

# Obteniendo matriz de residuos
mat_residuos_SW<-matrix(data = c(10, 15, -10,
                                 -15, 4, -4),
                        nrow = 6,
                        ncol= 1)
print(mat_residuos_SW)

##      [,1]
## [1,]   10
## [2,]   15
## [3,]  -10
## [4,]  -15
## [5,]    4
## [6,]   -4

# Prueba Shapiro Wilk
shapiro.test(mat_residuos_SW)

## 
##  Shapiro-Wilk normality test
## 
## data:  mat_residuos_SW
## W = 0.96164, p-value = 0.8323

Respuesta: El estadístico de prueba SW es 0.96164

10. Para un VIF=2.5, la tolerancia es de:

VIF_4<-2.5
Tolerancia2<- 1/VIF_4
print(Tolerancia2)

## [1] 0.4

Respuesta: La tolerancia es de 0.4

Resolución segunda parte

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.

Carga de datos

library(readxl)
ventas_empresa <- read_excel("C:/Users/usuario/Downloads/ventas_empresa.xlsx")

Estimando el modelo de ventas

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

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

Pruebas de normalidad

Ajuste normal

library(fitdistrplus)
ajuste_norm1<-fitdist(data = modelo_ventas$residuals, distr = "norm")
plot(ajuste_norm1)

Como primera observación a partir de los gráficos se tiene que, a pesar de que algunos tramos difieren, los residuos, de forma general sí siguen cierta tendencia a la normalidad.

Prueba Jarque-Bera

library(normtest) 
jb.norm.test(modelo_ventas$residuals)

## 
##  Jarque-Bera test for normality
## 
## data:  modelo_ventas$residuals
## JB = 1.4004, p-value = 0.2825

Para un nivel de significancia del 5% el valor crítico es de 5.9915 y, a partir de la prueba se calculó JB=1.4004, por tanto se tiene: JB<VC y la hipótesis nula no se rechaza porque hay evidencia de que los residuos tienen distribución normal.

Prueba Kolmogorov-Smirnov con ajuste de Lilliefors

library(nortest)
lillie.test(modelo_ventas$residuals)

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  modelo_ventas$residuals
## D = 0.13659, p-value = 0.2935

La prueba de Lilliefors a un nivel de significancia del 5% evidencia que D<VC (0.13659<0.1726) y a partir de ello, no se rechaza la hipotesis nula, por ende sí hay evidencia de que los residuos siguen una distribucion normal

Prueba Shapiro-Wilk

shapiro.test(modelo_ventas$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  modelo_ventas$residuals
## W = 0.95315, p-value = 0.3166

W1<-0.95315
# Normalizando W
miu1<-miu<-0.0038915*(log(24))^3-0.083751*(log(24))^2-0.31082*(log(24))-1.5861
des1<- exp(0.0030302*(log(24))^2-0.082676*(log(24))-0.4803)
# Wn
Wn1<-(log(1-W1)-miu1)/des1
print(Wn1)

## [1] 0.4772707

Al normalizar el estadístico W se obtiene Wn=0.4772707 y tomando un nivel de significancia del 5% el valor crítico es 1.644854, por lo tanto se tiene Wn<VC (0.4772707<1.644854) y no se rechaza la hipótesis nula, lo que indica que los residuos siguen una distribución normal.

Pruebas de multicolinealidad

Indice de condicion con librería mctest

library(mctest)
source(file = "C:/Users/usuario/Downloads/correccion_eigprop.R")
my_eigprop(mod=modelo_ventas)

## 
## Call:
## my_eigprop(mod = modelo_ventas)
## 
##   Eigenvalues      CI (Intercept)      C      P      M
## 1      3.9869  1.0000      0.0007 0.0001 0.0003 0.0001
## 2      0.0095 20.4852      0.8776 0.0049 0.0877 0.0075
## 3      0.0028 37.8141      0.1183 0.1594 0.8478 0.0636
## 4      0.0008 71.1635      0.0034 0.8356 0.0642 0.9288
## 
## ===============================
## Row 4==> C, proportion 0.835554 >= 0.50 
## Row 3==> P, proportion 0.847805 >= 0.50 
## Row 4==> M, proportion 0.928751 >= 0.50

El índice de condición es igual a 71.1635 y cae dentro del rango mayor a 30 (71.1635>30), por lo que se tiene evidencia de multicolinealidad severa en los regresores del modelo de ventas.

Prueba Farrar-Glaubar con librería psych

Xmat1<-model.matrix(modelo_ventas)
library(psych)
library(fastGraph)
FG1<-cortest.bartlett(Xmat1[,-1])
print(FG1)

## $chisq
## [1] 71.20805
## 
## $p.value
## [1] 0.000000000000002352605
## 
## $df
## [1] 3

VC_FG1<-qchisq(.95,FG1$df)
print(VC_FG1)

## [1] 7.814728

shadeDist(xshade = FG1$chisq, 
          ddist = "dchisq",
          parm1 = FG1$df,
          lower.tail = FALSE,
          sub=paste("VC:",VC_FG1,
                    "FG:",FG1$chisq))

Con un estadistico FG de 71.20805 mayor al valor critico que es 7.81472 (71.20805>7.81472), se rechaza la hipótesis nula ya que la prueba evidencia que existe alta multicolinealidad en los regresores del modelo de ventas.

Factores inflacionarcios de la varianza (FIV)

library(mctest)
mc.plot(modelo_ventas,vif = 2)

El VIF plot muestra que las variables independientes (regresores) superan el umbral de VIF de 2 que se ha establecido, siendo los gastos de comercialización (C) y los costes de materia prima (M) los regresores que más inflan la varianza y aportan un nivel alto de multicolinealidad en el modelo de ventas.

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)

Carga de datos

load("C:/Users/usuario/Downloads/wage2.RData")

Estimando el modelo de Escolaridad

modelo_educ<- lm(formula = educ~sibs+meduc+feduc,data = wage2)
stargazer(modelo_educ, type = "html", title = "Modelo estimado de años de escolaridad")

Modelo estimado de años de escolaridad

	Dependent variable:
	educ
sibs	-0.094***
	(0.034)
meduc	0.131***
	(0.033)
feduc	0.210***
	(0.027)
Constant	10.364***
	(0.359)
Observations	722
R2	0.214
Adjusted R2	0.211
Residual Std. Error	1.987 (df = 718)
F Statistic	65.198*** (df = 3; 718)
Note:	p<0.1; p<0.05; p<0.01

Pruebas de normalidad

Ajuste normal

ajuste_norm2<-fitdist(modelo_educ$residuals, distr = "norm")
plot(ajuste_norm2)

A partir de los gráficos se observa de forma previa a las pruebas correspondientes, que los residuos se alejan significativamente de la distribución normal.

Prueba Jarque-Bera

jb.norm.test(modelo_educ$residuals)

## 
##  Jarque-Bera test for normality
## 
## data:  modelo_educ$residuals
## JB = 35.655, p-value = 0.0005

Para un nivel de significancia del 5% el valor crítico es de 5.9915 y, a partir de la prueba se calculó JB=35.655, por tanto se tiene: JB>VC (35.655>5.9915) y la hipótesis nula se rechaza porque hay evidencia de que los residuales no tienen distribución normal.

Prueba Kolmogorov-Smirnov con ajuste de Lilliefors

lillie.test(modelo_educ$residuals)

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  modelo_educ$residuals
## D = 0.089992, p-value = 0.000000000000003394

La prueba de Lilliefors a un nivel de significancia del 5% evidencia que D>VC (0.089992>0.028644) y a partir de ello, se rechaza la hipotesis nula, por ende no hay evidencia de que los residuales siguen una distribucion normal.

Prueba Shapiro-Wilk

shapiro.test(modelo_educ$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  modelo_educ$residuals
## W = 0.96692, p-value = 0.00000000001058

W2<-0.96692
# Normalizando W
miu2<-miu<-0.0038915*(log(935))^3-0.083751*(log(935))^2-0.31082*(log(935))-1.5861
des2<- exp(0.0030302*(log(935))^2-0.082676*(log(935))-0.4803)
# Wn
Wn2<-(log(1-W2)-miu2)/des2
print(Wn2)

## [1] 7.351479

Al normalizar el estadístico W se obtiene Wn=7.351479 y tomando un nivel de significancia del 5% el valor crítico es 1.644854, por lo tanto se tiene Wn>VC (7.351479>1.644854) y se rechaza la hipótesis nula, lo que indica que los residuales no siguen una distribución normal.

Pruebas de multicolinealidad

Indice de condición con librería mctest

library(mctest)
source(file = "C:/Users/usuario/Downloads/correccion_eigprop.R")
my_eigprop(mod=modelo_educ)

## 
## Call:
## my_eigprop(mod = modelo_educ)
## 
##   Eigenvalues      CI (Intercept)   sibs  meduc  feduc
## 1      3.5576  1.0000      0.0033 0.0194 0.0031 0.0046
## 2      0.3756  3.0778      0.0015 0.7200 0.0107 0.0184
## 3      0.0417  9.2337      0.3235 0.1056 0.0813 0.8786
## 4      0.0251 11.9094      0.6717 0.1549 0.9049 0.0984
## 
## ===============================
## Row 2==> sibs, proportion 0.720032 >= 0.50 
## Row 4==> meduc, proportion 0.904919 >= 0.50 
## Row 3==> feduc, proportion 0.878599 >= 0.50

El índice de condición es igual a 11.9094 y cae dentro del rango menor a 20 (11.9094<20), por lo que se tiene evidencia de que la multicolinealidad en este caso es leve y no se considera un problema.

Prueba Farrar-Glaubar con librería psych

options(scipen = 9)
Xmat2<-model.matrix(modelo_educ)
library(psych)
library(fastGraph)
FG2<-cortest.bartlett(Xmat2[,-1])
print(FG2)

## $chisq
## [1] 358.3897
## 
## $p.value
## [1] 2.27501e-77
## 
## $df
## [1] 3

VC_FG2<-qchisq(.95,FG2$df)
print(VC_FG2)

## [1] 7.814728

shadeDist(xshade = FG2$chisq, 
          ddist = "dchisq",
          parm1 = FG2$df,
          lower.tail = FALSE,
          sub=paste("VC:",VC_FG2,
                    "FG:",FG2$chisq))

Con un estadistico FG de 358.38 mayor al valor crítico que es 7.81472 (358.38>7.81472) se rechaza la hipótesis nula ya que la prueba evidencia que existe multicolinealidad severa en los regresores del modelo de ventas.

Factores inflacionarios de la varianza (FIV)

mc.plot(modelo_educ,vif = 2)

El VIF plot muestra que ninguno de los regresores supera el umbral de 2 y por lo tanto no existe evidencia de multicolinealidad severa, sino que en este caso, se trata de una colinealidad leve.

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(LSAT,GPA ,log(libvol),log(cost),rank)

Carga de datos

load("C:/Users/usuario/Downloads/LAWSCH85.RData")

Estimando el modelo de salarios

options(scipen = 9999)
library(dplyr)
modelo_salary<- lm(formula= lsalary~LSAT+GPA+llibvol+lcost+rank, data = LAWSCH85)
stargazer(modelo_salary, type = "html", title = "Modelo Estimado de Salarios")

Modelo Estimado de Salarios

	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

Pruebas de normalidad

Prueba de Jarque-Bera

jb.norm.test(modelo_salary$residuals)

## 
##  Jarque-Bera test for normality
## 
## data:  modelo_salary$residuals
## JB = 0.36511, p-value = 0.82

La prueba JB evidencia un estadistico JB menor que el VC (0.36<5.99), entonces, no se rechaza la hipotesis nula, por ende, los residuos siguen una distribucion normal.

Prueba Kolmogorov-Smirnov con ajuste de Lilliefors

lillie.test(modelo_salary$residuals)

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  modelo_salary$residuals
## D = 0.054571, p-value = 0.4123

Con una significancia del 5% la prueba de Lilliefors evidencia que D<VC (0.05<0.07) y a partir de ello, no se rechaza la hipotesis nula, por ende si hay evidencia que los residuos siguen una distribucion normal

Prueba Shapiro-Wilk

shapiro.test(modelo_salary$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  modelo_salary$residuals
## W = 0.99282, p-value = 0.7235

W3<-0.99282
# Normalizando W
miu3<-0.0038915*(log(156))^3-0.083751*(log(156))^2-0.31082*(log(156))-1.5861
des3<- exp(0.0030302*(log(156))^2-0.082676*(log(156))-0.4803)
# Wn
Wn3<-(log(1-W3)-miu3)/des3
print(Wn3)

## [1] -0.3320221

Con una significancia de 5% el valor crítico es 1.644854, a partir del valor normalizado de W (Wn) se observa que Wn < VC (-0.3320221<1.644854) y por ello, la hipotesis nula no se rechaza y se concluye que los residuos siguen una distribucion normal.

Pruebas de multicolinealidad

Indice de condición con librería mctest

library(mctest)
source(file = "C:/Users/usuario/Downloads/correccion_eigprop.R")
my_eigprop(mod=modelo_salary)

## 
## Call:
## my_eigprop(mod = modelo_salary)
## 
##   Eigenvalues       CI (Intercept)   LSAT    GPA llibvol  lcost   rank
## 1      5.7351   1.0000      0.0000 0.0000 0.0000  0.0001 0.0000 0.0021
## 2      0.2604   4.6930      0.0000 0.0000 0.0002  0.0004 0.0001 0.2884
## 3      0.0021  52.4800      0.0058 0.0030 0.0007  0.8411 0.1155 0.1357
## 4      0.0018  55.7648      0.0002 0.0010 0.3355  0.1095 0.1756 0.0161
## 5      0.0004 123.2068      0.4254 0.0588 0.4407  0.0423 0.6610 0.4700
## 6      0.0002 186.7153      0.5686 0.9371 0.2229  0.0066 0.0478 0.0877
## 
## ===============================
## Row 6==> LSAT, proportion 0.937119 >= 0.50 
## Row 3==> llibvol, proportion 0.841136 >= 0.50 
## Row 5==> lcost, proportion 0.661004 >= 0.50

El indice de condicion es de 186.7153 un valor muy por encima de 30 (186.7153>30), lo cual representa evidencia de multicolinealidad severa en el modelo, que puede ser causada por las variables que sufrieron una modificación logarítmica.

Prueba Farrar-Glaubar con librería psych

options(scipen = 9)
Xmat3<-model.matrix(modelo_salary)
library(psych)
library(fastGraph)
FG3<-cortest.bartlett(Xmat3[,-1])

## R was not square, finding R from data

print(FG3)

## $chisq
## [1] 391.509
## 
## $p.value
## [1] 6.031929e-78
## 
## $df
## [1] 10

VC_FG3<-qchisq(.95,FG3$df)
print(VC_FG3)

## [1] 18.30704

shadeDist(xshade = FG3$chisq, 
          ddist = "dchisq",
          parm1 = FG3$df,
          lower.tail = FALSE,
          sub=paste("VC:",VC_FG3,
                    "FG:",FG3$chisq))

Con un estadístico FG de 391.5089 mayor al valor critico que es 18.307 (FG>VC) se rechaza la hipótesis nula y se evidencia que existe alta multicolinealidad en los regresores del modelo de salario.

Factores inflacionarios de la varianza (FIV)

mc.plot(modelo_salary,vif = 2)

El VIF plot muestra que las variables independientes (regresores) que superan el umbral de VIF de 2 que se ha establecido, son las variables LSAT, GPA y rank ya que son las que más inflan la varianza y contribuyen a que la multicolinealidad del modelo de salario sea severa.