1. (clave A) 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. Estime el modelo de regresión lineal, correspondiente y verifique el supuesto de normalidad, usando todas las pruebas vistas en clase. Comente sus resultados.
b. Utilizando todas las herramientas vistas en clase, evalué la situación de colinealidad de los regresores del modelo. Comente sus resultados.
carga de datos
library(readxl)
ventas_empresa <- read_excel("C:/Users/Kathya Hernandez/Downloads/ventas_empresa.xlsx")
# modelo de regresion estimado
library(stargazer)
options(scipen = 99999)
modelo_ventas<-lm(formula= V~C+P+M, data= ventas_empresa)
stargazer(modelo_ventas, title="Modelo Ventas", type="html")
Modelo 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
|
a. Normalidad
Prueba de normalidad en los residuos
library(fitdistrplus)
ajuste_normal<-fitdist(data= modelo_ventas$residuals, distr = "norm")
plot(ajuste_normal)
R/ mediante los graficas se puede decir por el comportamiento de los puntos que se observa evidencia de distribucion normal en los residuos
Prueba JB
library(normtest)
jb.norm.test(modelo_ventas$residuals)
##
## Jarque-Bera test for normality
##
## data: modelo_ventas$residuals
## JB = 1.4004, p-value = 0.2795
R/ si asumimos un nivel de significancia del 5%, cuando se usa la prueba JB, se encuentra evidencia de que los residuos siguen una distribución normal, por lo que no se rechaza la hipotesis nula. El JB es menor que el valor crítico correspondiente a 5.9915.
Prueba KS (lilliefors)
library(nortest)
lillie.test(modelo_ventas$residuals)
##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: modelo_ventas$residuals
## D = 0.13659, p-value = 0.2935
R/ si asumimos un nivel de significancia del 5%, cuando se usa la prueba KS, el p-value obtenido es de 0.2935, p-vale es mayor que 5%. El VC es mayor que D (para un tamaño de muestra de 25 y un ivel de significancia del 5% es de 0.1726), por lo tanto no se rechaza la Ho y los residuos siguen una distribución normal.
Prueba shapiro
shapiro.test(modelo_ventas$residuals)
##
## Shapiro-Wilk normality test
##
## data: modelo_ventas$residuals
## W = 0.95315, p-value = 0.3166
# normalizacion de W
U<-(0.00389*(log(24)^3)-0.083751*(log(24)^2)-0.31082*(log(24))-1.5861)
S<-exp(1)^((0.0030302*(log(24)^2))-0.082676*(log(24))-0.4803)
# calculando Wn
Wn<-((log(1-0.95315)-U)/S)
print(Wn)
## [1] 0.4773689
R/ si asumimos un nivel de significancia del 5%, siendo para este un Valor Crítico de 1.64459, al aplicar la prueba shapiro, no se rechaza la Ho ya que Wn es menor que el VC, por lo tanto se aporta evidencia de que los residuos siguen una distribución de probabilidad normal.
b. Colinealidad
Calculando indice de condición (forma manual)
# Calculando Sigma matriz
mat_x<-model.matrix(modelo_ventas)
print(mat_x[1:5,]) # siendo una matriz de orden 24x4.
## (Intercept) C P M
## 1 1 197 173 110
## 2 1 208 152 107
## 3 1 181 150 99
## 4 1 194 150 102
## 5 1 192 163 109
mat_xx<-t(mat_x)%*%mat_x
print(mat_xx)
## (Intercept) C P M
## (Intercept) 24 5308 4503 2971
## C 5308 1187852 1007473 664534
## P 4503 1007473 859157 564389
## M 2971 664534 564389 372387
# Matriz de normalización (Sn)
sn<-diag(1/sqrt(diag(mat_xx)))
print(sn)
## [,1] [,2] [,3] [,4]
## [1,] 0.2041241 0.000000000 0.000000000 0.000000000
## [2,] 0.0000000 0.000917527 0.000000000 0.000000000
## [3,] 0.0000000 0.000000000 0.001078857 0.000000000
## [4,] 0.0000000 0.000000000 0.000000000 0.001638712
# Matriz normalizada
mat_nor<-(sn%*%mat_xx)%*%sn
print(mat_nor)
## [,1] [,2] [,3] [,4]
## [1,] 1.0000000 0.9941322 0.9916538 0.9938018
## [2,] 0.9941322 1.0000000 0.9972774 0.9991686
## [3,] 0.9916538 0.9972774 1.0000000 0.9978035
## [4,] 0.9938018 0.9991686 0.9978035 1.0000000
# Autovalores (lambdas)
lambdas<-eigen(mat_nor, symmetric = TRUE)$values
print(lambdas)
## [1] 3.9869237681 0.0095007154 0.0027882470 0.0007872695
# Indice de condición (K)
K<-sqrt(max(lambdas)/min(lambdas))
print(K)
## [1] 71.16349
R/ se puede observar que el indice de condicion (k) es de 71.16349, lo que nos indica que los regresores poseen multicolinealidad severa ya que k es mayor que 30.
Indice de condicion usando mctest
library(mctest)
source(file = "C:/Users/Kathya Hernandez/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
R/ Ya sea de forma manual o utilizando libreria mctest el indice de condicion nos da lo mismo y nos muestra que tiene una multicolinealidad severa.
Prueba FG (manual)
library(fastGraph)
m<-ncol(mat_x[,-1]) # Cantidad de variables explicativas K-1
n<-nrow(mat_x)
# Determinante R
det_R<-det(cor(mat_x[,-1]))
Chi_FG<-(-(n-1-(2*m+5)/6)*log(det_R))
print(Chi_FG)
## [1] 71.20805
# Valor Crítico
gl<-m*(m-1)/2
VC<-qchisq(0.05, gl,lower.tail = FALSE)
print(VC)
## [1] 7.814728
# P-value
Pval<-pchisq(Chi_FG,gl, lower.tail = FALSE)
print(Pval)
## [1] 0.000000000000002352605
shadeDist(xshade = Chi_FG,ddist= "dchisq", parm1= gl, lower.tail= FALSE, sub=paste("VC:", VC, "FG:", Chi_FG))
R/ el estadístico de prueba es mayor que el valor critico, por lo tanto se rechaza la Ho y hay evidencia de multicolinealidad en los regresores.
Prueba FG con libreria mctest
library(mctest)
mctest(modelo_ventas)
##
## Call:
## omcdiag(mod = mod, Inter = TRUE, detr = detr, red = red, conf = conf,
## theil = theil, cn = cn)
##
##
## Overall Multicollinearity Diagnostics
##
## MC Results detection
## Determinant |X'X|: 0.0346 0
## Farrar Chi-Square: 71.2080 1
## Red Indicator: 0.8711 1
## Sum of Lambda Inverse: 20.9196 1
## Theil's Method: 0.5430 1
## Condition Number: 105.2299 1
##
## 1 --> COLLINEARITY is detected by the test
## 0 --> COLLINEARITY is not detected by the test
Prueba FG con libreria psych
library(psych)
library(fastGraph)
FG_test<-cortest.bartlett(mat_x[,-1])
VC_1<-qchisq(0.05,FG_test$df, lower.tail = FALSE)
print(FG_test)
## $chisq
## [1] 71.20805
##
## $p.value
## [1] 0.000000000000002352605
##
## $df
## [1] 3
shadeDist(xshade = FG_test$chisq,ddist= "dchisq", parm1= FG_test$df, lower.tail=FALSE, sub=paste("VC:", VC_1, "FG:", FG_test$chisq))
R/ Cuando se realiza la prueba FG de manera manual o utilizando librerias, se llega a un mismo resultado en el cual nos muestra que el estadístico de prueba es mayor que el valor critico, lo que nos conduce a rechazar la Ho, por lo tanto hay evidencia de multicolinealidad en los regresores, de igual manera es importante mencionar que la matriz de regresores no es una matriz identidad.
VIF con librerias (mctest y car)
# usando mctest
library(mctest)
mc.plot(modelo_ventas, vif=2)
# usando car
library(car)
VIF_car<-vif(modelo_ventas)
print(VIF_car)
## C P M
## 7.631451 3.838911 9.449210
R/ Cuando observamos los graficos obtenidos de la libreria mctest observamos que se establece un umbral de 2 donde todas las variables independientes o regresores superan este umbral, siendo M ( costes de materia prima) el regresor que mas infla la varianza, seguido por C (gastos de comercializacion), mostrando que aportan un nivel alto de multicolinealidad en el modelo de ventas, al contrario P, el cual muestra un valor mas bajo por lo que su multicolinealidad se considera un valor aceptable.
2. (clave B) 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. Estime el modelo de regresión lineal, correspondiente y verifique el supuesto de normalidad, usando todas las pruebas vistas en clase. Comente sus resultados.
b. Utilizando todas las herramientas vistas en clase, evalue la situación de colinealidad del modelo. Comente sus resultados
Carga de datos
load("C:/Users/Kathya Hernandez/Downloads/wage2.RData")
# estimando el modelo de regresion
library(stargazer)
options(scipen = 99999)
modelo_escolaridad<-lm(formula= educ~sibs+meduc+feduc, data=wage2)
stargazer(modelo_escolaridad, title="Modelo de escolaridad", type="html")
Modelo 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
|
a. Normalidad
Pruebas de normalidad en los residuos
library(fitdistrplus)
ajuste_normal_2<-fitdist(data= modelo_escolaridad$residuals, distr = "norm")
plot(ajuste_normal_2)
R/ Como se puede ver en los graficos que los residuos se alejan significativamente de la distribución normal, lo que nos indica que los residuos no siguen una distribución normal.
Prueba JB
library(normtest)
jb.norm.test(modelo_escolaridad$residuals)
##
## Jarque-Bera test for normality
##
## data: modelo_escolaridad$residuals
## JB = 35.655, p-value < 0.00000000000000022
R/ Si asumimos un nivel de significancia del 5%, cuando usamos la prueba JB, el VC que le corresponde es de 5.9915, el estadístico JB es mayor que el VC, por lo tanto se rechaza Ho, lo que nos dice no hay evidencia de distribucion normal en los residuos
Preuba KS (lilliefors)
library(nortest)
lillie.test(modelo_escolaridad$residuals)
##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: modelo_escolaridad$residuals
## D = 0.089992, p-value = 0.000000000000003394
R/ Si asumimos un nivel de significancia del 5%, cuando aplicamos la prueba KS, el p-value es mucho menor que el nivel de significancia del 0.05, con esto se cumple una de las condiciones para rechazar la Ho, al rechazarla hay evidencia de que los residuos no siguen una distribución normal.
Prueba Shapiro Wilk
shapiro.test(modelo_escolaridad$residuals)
##
## Shapiro-Wilk normality test
##
## data: modelo_escolaridad$residuals
## W = 0.96692, p-value = 0.00000000001058
# Normalizando W
U2<-(0.00389*(log(722)^3)-0.083751*(log(722)^2)-0.31082*(log(722))-1.5861)
S2<-exp(1)^((0.0030302*(log(722)^2))-0.082676*(log(722))-0.4803)
Wn_2<-((log(1-0.96692)-U2)/S2)
print(Wn_2)
## [1] 6.699004
R/ Si asumimos un nivel de significancia del 5%, al usar la prueba SW obtenemos que Wn es mayor que el VC de 1.64454,lo que nos conduce a rechazar la Ho, podemos decir que no hay evidencia de distribucion normal de los residuos.
b.Pruebas de colinealidad
R/ en este caso el indice de condicion es menor a 20, lo que nos indica que los regresores poseen multicolinealidad leve y esta no es un problema.
Indice de condición usando libreria mctest
library(mctest)
source(file = "C:/Users/Kathya Hernandez/Downloads/correccion_eigprop.R")
my_eigprop(mod= modelo_escolaridad)
##
## Call:
## my_eigprop(mod = modelo_escolaridad)
##
## 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
R/ Cuando calculamos el indice de condicion ya sea manual o usando libreria nos da el mismo resultado, el cual nos indica que hay una multicolinealidad leve.
Prueba FG
library(fastGraph)
m2<-ncol(matx_2[,-1]) # Cantidad de variables explicativas K-1
n2<-nrow(matx_2)
# Determinante R
detR_2<-det(cor(matx_2[,-1]))
Chi_FG2<-(-(n2-1-(2*m2+5)/6)*log(detR_2))
print(Chi_FG2)
## [1] 358.3897
# Valor Crítico
gl_2<-m2*(m2-1)/2
VC_2<-qchisq(0.05, gl_2,lower.tail = FALSE)
print(VC_2)
## [1] 7.814728
# P-value
Pval_2<-pchisq(Chi_FG2,gl_2, lower.tail = FALSE)
print(Pval_2)
## [1] 0.0000000000000000000000000000000000000000000000000000000000000000000000000000227501
options(scipen = 0)
shadeDist(xshade = Chi_FG2,ddist= "dchisq", parm1= gl_2, lower.tail= FALSE, sub=paste("VC:", VC_2, "FG:", Chi_FG2))
R/ Al realizar la prueba FG obtenemos un FG de 358.38 mayor al valor crítico que es 7.81472 (358.38>7.81472), lo cual nos dice que se rechaza Ho, por tanto hay evidencia de multicolinealidad en los regresores.
prueba FG con librerias
# usando libreria mctest
library(mctest)
mctest(modelo_escolaridad)
##
## Call:
## omcdiag(mod = mod, Inter = TRUE, detr = detr, red = red, conf = conf,
## theil = theil, cn = cn)
##
##
## Overall Multicollinearity Diagnostics
##
## MC Results detection
## Determinant |X'X|: 0.6075 0
## Farrar Chi-Square: 358.3897 1
## Red Indicator: 0.3952 0
## Sum of Lambda Inverse: 4.1666 0
## Theil's Method: 0.3575 0
## Condition Number: 11.2768 0
##
## 1 --> COLLINEARITY is detected by the test
## 0 --> COLLINEARITY is not detected by the test
# usando libreria psych
library(psych)
library(fastGraph)
FG_test2<-cortest.bartlett(matx_2[,-1])
VC_2<-qchisq(0.05,FG_test2$df, lower.tail = FALSE)
print(FG_test2)
## $chisq
## [1] 358.3897
##
## $p.value
## [1] 2.27501e-77
##
## $df
## [1] 3
options(scipen = 0)
shadeDist(xshade = FG_test2$chisq,ddist= "dchisq", parm1= FG_test2$df, lower.tail=FALSE, sub=paste("VC:", VC_2, "FG:", FG_test2$chisq))
R/ Cuando realizamos la prueba FG de todas las formas ya sea manual o usando librerias nos da el mismo resultado, el cual nos muestra que hay evidencia de colinealidad en los regresores.
VIF (manual)
VIF_2<-diag(solve(cor(matx_2[,-1])))
print(VIF_2)
## sibs meduc feduc
## 1.098950 1.561254 1.506359
VIF con librerias
# usando libreria mctest
library(mctest)
mc.plot(modelo_escolaridad, vif=2)
# usando libreria car
library(car)
VIF_car2<-vif(modelo_escolaridad)
print(VIF_car2)
## sibs meduc feduc
## 1.098950 1.561254 1.506359
R/ el grafico de los VIF ( factores inflacionarios de la varianza) usando libreria mctest, con un umbral de 2, nos muestra que ninguno de los regresores supera el umbral de 2, por lo tanto no existe evidencia de multicolinealidad severa, al contrario se trata de una colinealidad leve.
3. (clave C) 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. Estime el modelo de regresión lineal, correspondiente y verifique el supuesto de normalidad, usando todas las pruebas vistas en clase. Comente sus resultados.
b. Utilizando todas las herramientas vistas en clase, evalue la situación de colinealidad del modelo. Comente sus resultados
Carga de datos
load("C:/Users/Kathya Hernandez/Downloads/LAWSCH85.RData")
# Estimando el modelo de salarios
library(stargazer)
options(scipen = 99999)
modelo_salario<-lm(formula= lsalary~LSAT+GPA+llibvol+lcost+rank, data=LAWSCH85)
stargazer(modelo_salario, title= "Modelo de Salario", type="html")
Modelo de Salario
|
|
|
|
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
|
a. Pruebas de Normalidad
Normalidad en los residuos
library(fitdistrplus)
ajuste_normal3<-fitdist(data= modelo_salario$residuals, distr = "norm")
plot(ajuste_normal3)
R/ Por medio de los graficos y el comportamiento de los puntos se observa que los residuos pueden seguir una distribución normal.
Prueba JB
library(normtest)
jb.norm.test(modelo_salario$residuals)
##
## Jarque-Bera test for normality
##
## data: modelo_salario$residuals
## JB = 0.36511, p-value = 0.814
R/ Asumiendo un nivel de significancia del 5% y al aplicar la prueba JB, no se rechaza Ho, pues JB es menor que el VC de 5.9915 y obtenemos evidencia de que los residuos siguen una distribución normal.
Prueba KS (lilliefors)
library(nortest)
lillie.test(modelo_salario$residuals)
##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: modelo_salario$residuals
## D = 0.054571, p-value = 0.4123
R/ Asumiendo un nivel de significancia y aplicando la prueba KS obtenemos un p-value mayor que el nivel de significancia 0.05, 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_salario$residuals)
##
## Shapiro-Wilk normality test
##
## data: modelo_salario$residuals
## W = 0.99282, p-value = 0.7235
W3<-0.99282
# Normalizando W
U3<-0.0038915*(log(136))^3-0.083751*(log(136))^2-0.31082*(log(136))-1.5861
S3<- exp(0.0030302*(log(136))^2-0.082676*(log(136))-0.4803)
# Wn
Wn3<-(log(1-W3)-U3)/S3
print(Wn3)
## [1] -0.5943665
R/ Con un nivel de significancia de 5% el valor crítico es 1.644854, cuando calculamos el valor normalizado de W (Wn) se observa que Wn < VC (-0.3320221<1.644854) y por tanto, la Ho no se rechaza y se concluye que los residuos siguen una distribucion normal.
b. Pruebas de colinealidad
Indice de condición (manual)
matx_3<-model.matrix(modelo_salario)
mxx_3<-t(matx_3)%*%matx_3
# matriz de normalización (Sn)
sn3<-diag(1/sqrt(diag(mxx_3)))
print(sn3)
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 0.08574929 0.000000000 0.00000000 0.00000000 0.000000000 0.0000000000
## [2,] 0.00000000 0.000540754 0.00000000 0.00000000 0.000000000 0.0000000000
## [3,] 0.00000000 0.000000000 0.02586346 0.00000000 0.000000000 0.0000000000
## [4,] 0.00000000 0.000000000 0.00000000 0.01484718 0.000000000 0.0000000000
## [5,] 0.00000000 0.000000000 0.00000000 0.00000000 0.009124872 0.0000000000
## [6,] 0.00000000 0.000000000 0.00000000 0.00000000 0.000000000 0.0009166041
# Matriz normalizada
mat_nor3<-(sn3%*%mxx_3)%*%sn3
print(mat_nor3)
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 1.0000000 0.9995823 0.9982420 0.9973380 0.9991966 0.8525542
## [2,] 0.9995823 1.0000000 0.9991485 0.9982590 0.9993057 0.8413471
## [3,] 0.9982420 0.9991485 1.0000000 0.9981161 0.9978511 0.8292662
## [4,] 0.9973380 0.9982590 0.9981161 1.0000000 0.9974980 0.8236445
## [5,] 0.9991966 0.9993057 0.9978511 0.9974980 1.0000000 0.8425432
## [6,] 0.8525542 0.8413471 0.8292662 0.8236445 0.8425432 1.0000000
# Autovalores (lambdas)
lambdas_3<-eigen(mat_nor3, symmetric = TRUE)$values
print(lambdas_3)
## [1] 5.7351306262 0.2604004371 0.0020823558 0.0018442636 0.0003778106
## [6] 0.0001645068
# Indice de condición (K)
K_3<-sqrt(max(lambdas_3)/min(lambdas_3))
print(K_3)
## [1] 186.7153
R/ Cuando se calcula el indice de condicion (k) se obtiene un indice de 186.7153, un valor mucho mas alto que 30 (186.7153>30), indicandonos que representa evidencia de multicolinealidad severa en el modelo.
Indice de condición usando libreria mctest
library(mctest)
source(file = "C:/Users/Kathya Hernandez/Downloads/correccion_eigprop.R")
my_eigprop(mod= modelo_salario)
##
## Call:
## my_eigprop(mod = modelo_salario)
##
## 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
R/ cuando usamos la libreria se llega al mismo resultado que haciendolo de forma manual, donde la multicolinealidad es severa.
Prueba FG (manual)
library(fastGraph)
m3<-ncol(matx_3[,-1]) ## Cantidad de variables explicativas K-1
n3<-nrow(matx_3)
# Determinante R
detR_3<-det(cor(matx_3[,-1]))
Chi_FG3<-(-(n3-1-(2*m3+5)/6)*log(detR_3))
print(Chi_FG3)
## [1] 391.509
# Valor Crítico
gl_3<-m3*(m3-1)/2
VC_3<-qchisq(0.05, gl_3,lower.tail = FALSE)
print(VC_3)
## [1] 18.30704
# P-value
Pval_3<-pchisq(Chi_FG3,gl_3, lower.tail = FALSE)
print(Pval_3)
## [1] 0.000000000000000000000000000000000000000000000000000000000000000000000000000006031929
options(scipen = 0)
shadeDist(xshade = Chi_FG3,ddist= "dchisq", parm1= gl_3, lower.tail= FALSE, sub=paste("VC:", VC_3, "FG:", Chi_FG3))
R/ Con un estadístico FG de 391.5089 mayor al valor critico que es 18.307 (FG>VC) se rechaza la Ho y se evidencia que existe multicolinealidad en los regresores del modelo de salario, la cual es severa.
Prueba FG usando librerias
# usando mctest
library(mctest)
mctest(modelo_salario)
##
## Call:
## omcdiag(mod = mod, Inter = TRUE, detr = detr, red = red, conf = conf,
## theil = theil, cn = cn)
##
##
## Overall Multicollinearity Diagnostics
##
## MC Results detection
## Determinant |X'X|: 0.0521 0
## Farrar Chi-Square: 391.5090 1
## Red Indicator: 0.5819 1
## Sum of Lambda Inverse: 13.8127 0
## Theil's Method: -0.3680 0
## Condition Number: 181.9505 1
##
## 1 --> COLLINEARITY is detected by the test
## 0 --> COLLINEARITY is not detected by the test
# usando psych
library(psych)
library(fastGraph)
FG_test3<-cortest.bartlett(matx_3[,-1])
VC_3<-qchisq(0.05,FG_test3$df, lower.tail = FALSE)
print(FG_test3)
## $chisq
## [1] 391.509
##
## $p.value
## [1] 6.031929e-78
##
## $df
## [1] 10
options(scipen = 0)
shadeDist(xshade = FG_test3$chisq,ddist= "dchisq", parm1= FG_test3$df, lower.tail=FALSE, sub=paste("VC:", VC_3, "FG:", FG_test3$chisq))
R/ cuando realizamos la prueba FG ya sea de forma manual o con libreria, el resultado es el mismo, en el cual se evidencia que existe multicolinealidad en los regresores del modelo de salario
VIF (manual)
VIF3<-diag(solve(cor(matx_3[,-1])))
print(VIF3)
## LSAT GPA llibvol lcost rank
## 3.635214 3.369004 2.110802 1.573583 3.124106
VIF con librerias
# usando libreria car
library(car)
VIF_car3<-vif(modelo_salario)
print(VIF_car3)
## LSAT GPA llibvol lcost rank
## 3.635214 3.369004 2.110802 1.573583 3.124106
# usando libreria mctest
library(mctest)
mc.plot(modelo_salario, vif=2)
R/ A partir del grafico de los VIF ( factores inflacionarios de la varianza) con un umbral de 2 que se ha establecido, muestra que las variables independientes (regresores) que superan el umbral de VIF de 2, son las variables LSAT, GPA y rank las que más inflan la varianza y contribuyen a que la multicolinealidad del modelo de salario sea severa.