Solución parciales
GLORIA ABIGAIL RIVERA CUA, RC14054
19/6/2020
Parte 1 Teorica
1- Para un modelo con 2 regresores, la matriz de correlación es [1,0.96;0.96,1] ,el VIF es de:
options(scipen = 999999)
Matr<-matrix(data = c(1,0.96,0.96,1),nrow = 2,ncol = 2,byrow = FALSE)
VIF<-diag(solve(Matr))
print(VIF)## [1] 12.7551 12.7551R: El VIF es igual a 12.7551
2- Prueba robusta para evaluar la normalidad de los residuos independientemente del tamaño muestral: R: Prueba de Jarque-Bera.
3- En una prueba de FG, para un modelo con 5 regresores, y 60 observaciones con un alfa de 4.3%, el estadístico de prueba dio 40, el valor del determinante de la matriz de correlación del modelo es de:
options(scipen = 999999)
FG<-40
m<-5
n<-60
determinante_R<- exp(FG/-((n-1)-((2*m+5)/6)))
print(determinante_R)## [1] 0.4926459R: El valor del determinante es 0.4926459
4- Si el VIF para una variable es de 2.5, el coeficiente de correlación entre la variable y el resto de regresores es de:
VIF2<-2.5
coeficiente_de_correlacion<- 1-(1/VIF2)
print(coeficiente_de_correlacion)## [1] 0.6R: El coeficiente de correlación entre la variable y el resto de regresores es de 0.6
5- Sean 10,15,-10,-15,4,-4, los residuos de un modelo. El estadístico de prueba para el contraste de normalidad de KS es:
options(scipen = 999999)
KS_Residuos<-matrix(data = c(10,15,-10,-15,4,-4),
nrow = 6,ncol = 1,
byrow = FALSE)
library(nortest)
lillie.test(KS_Residuos)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: KS_Residuos
## D = 0.1374, p-value = 0.9763R: El estadístico de prueba para el contraste de normalidad KS es 0.1374.
6- En una prueba de FG, para un modelo con 5 regresores y un alfa de 4.3%, el valor crítico es de:
gl<-5*(5-1)/2
# Valor crítico
VC_<-qchisq(0.043,gl,lower.tail = FALSE)
print(VC_)## [1] 18.79093R: El Valor Crítico es de: 18.79093
- Sean 10,15,-10,-15,4,-4, los residuos de un modelo. El estadístico de prueba para el contraste de normalidad JB es:
JB_residuals<-matrix(data = c(10, 15, -10,
-15, 4, -4),
nrow = 6,
ncol= 1)
print(JB_residuals)## [,1]
## [1,] 10
## [2,] 15
## [3,] -10
## [4,] -15
## [5,] 4
## [6,] -4# Prueba de JB
library(normtest)
jb.norm.test(JB_residuals)##
## Jarque-Bera test for normality
##
## data: JB_residuals
## JB = 0.51072, p-value = 0.587R: El estadístico de prueba para el contraste de normalidad JB es 0.51072.
- Para una tolerancia de 0.05 el VIF es de:
Tolerancia<-0.05
VIF3<-1/Tolerancia
print(VIF3)## [1] 20R: 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:
SW_Residuals<-matrix(data = c(10, 15, -10,
-15, 4, -4),
nrow = 6,
ncol= 1)
print(SW_Residuals)## [,1]
## [1,] 10
## [2,] 15
## [3,] -10
## [4,] -15
## [5,] 4
## [6,] -4# Prueba de SW
shapiro.test(SW_Residuals)##
## Shapiro-Wilk normality test
##
## data: SW_Residuals
## W = 0.96164, p-value = 0.8323R: El estadístico de prueba para el contraste de normalidad de SW es: 0.96164.
10- Para un VIF=2.5, la tolerancia es de:
Tolerancia<-1/2.5
print(Tolerancia)## [1] 0.4R: La toleracia es de 0.4.
Parte 2
Solución clave 1 (Modelo de ventas)
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.
- Estime el modelo de regresión lineal, correspondiente y verifique el supuesto de normalidad, usando todas las pruebas vistas en clase. Comente sus resultados.
- 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(stargazer)
library(readxl)
ventas_empresa <- read_excel("C:/Users/IRMA/Downloads/ventas_empresa.xlsx")
# Corriendo el modelo
regresion<-lm(formula = V~C+P+M,data = ventas_empresa)
stargazer(regresion,title = "Modelo estimado",type = "html")| 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 |
1. Prueba de normalidad de los residuos
library(fitdistrplus)
ajuste_normal<-fitdist(data = regresion$residuals,distr = "norm")
plot(ajuste_normal)
Comentario: En los graficos se puede ver que los residuos siguen una distribución normal.
Prueba de JB
library(normtest)
jb.norm.test(regresion$residuals)##
## Jarque-Bera test for normality
##
## data: regresion$residuals
## JB = 1.4004, p-value = 0.28Comentario: En la prueba de JB > VC, eso significa que Sigue una distribución normal, por lo tanto no se rechaza la Ho.
prueba de KS
library(nortest)
lillie.test(regresion$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: regresion$residuals
## D = 0.13659, p-value = 0.2935Comentario: En los resultados obtenidos, los residuos siguen una distribución normal, eso permite que no se rechaze H0.
Prueba de Shapiro Wilk
shapiro.test(regresion$residuals)##
## Shapiro-Wilk normality test
##
## data: regresion$residuals
## W = 0.95315, p-value = 0.3166#Shapiro Wilk normalizado
w1<-0.95315
S<- 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)
Wn1<- (log(1-w1)-S)/des1
print(Wn1)## [1] 0.4772707Comentario: En esta prueva el resultado nos indica que los residuos tienen una distribución normal.
Pruebas de colinealidad
- Utilizando todas las herramientas vistas en clase, evalué la situación de colinealidad de los regresores del modelo. Comente sus resultados.
# calculo manual
Xmat<-model.matrix(regresion)
print(Xmat)## (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
## 6 1 196 179 114
## 7 1 203 169 113
## 8 1 200 166 113
## 9 1 198 159 115
## 10 1 221 206 119
## 11 1 218 181 120
## 12 1 213 192 123
## 13 1 207 191 122
## 14 1 228 217 131
## 15 1 249 190 133
## 16 1 225 221 135
## 17 1 237 189 133
## 18 1 236 192 128
## 19 1 231 193 134
## 20 1 260 233 135
## 21 1 254 196 139
## 22 1 239 199 138
## 23 1 248 202 146
## 24 1 273 240 153
## attr(,"assign")
## [1] 0 1 2 3XXmat<-t(Xmat)%*%Xmat
print(XXmat)## (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<-diag(1/sqrt(diag(XXmat)))
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# XXmat normalizada
XXmat_norm<-(Sn%*%XXmat)%*%Sn
print(XXmat_norm)## [,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
lambas<-eigen(XXmat_norm,symmetric = TRUE)$values
print(lambas)## [1] 3.9869237681 0.0095007154 0.0027882470 0.0007872695# Indice de condición
K<-sqrt(max(lambas)/min(lambas))
print(K)## [1] 71.16349Indice de condición usando mctes
library(mctest)
source(file = "C:/Users/IRMA/Downloads/correccion_eigprop.R")
my_eigprop(mod = regresion)##
## Call:
## my_eigprop(mod = regresion)
##
## 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.50Prueba de FG
library(fastGraph)
m<-ncol(Xmat[,-1]) #cantidad de variables explicativas K-1
n<-nrow(Xmat)
determinante_R<-det(cor(Xmat[,-1]))
chi_FG<--(n-1-(2*m+5)/6)*log(determinante_R)
print(chi_FG)## [1] 71.20805# Valor Critico
gl<-m*(m-1)/2
VC<-qchisq(0.05,gl,lower.tail = FALSE)
print(VC)## [1] 7.814728shadeDist(xshade = chi_FG,ddist = "dchisq",parm1 = gl,lower.tail = FALSE,sub=paste("VC:",VC,"FG",chi_FG))
En FG de 71.20805 siendo > VC de 7.814728, hay evidencia de colinealidad en los regresores, en este caso se rechaza Ho.
VIF
library(psych)
library(fastGraph)
FG_test<-cortest.bartlett(Xmat[,-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))
#VIF
VIF<-diag(solve(cor(Xmat[,-1])))
print(VIF) C P M 7.631451 3.838911 9.449210
VIF con libreria car
library(car)
VIF_Car<-vif(regresion)
print(VIF_Car)## C P M
## 7.631451 3.838911 9.449210VIF con libreria mctest
library(mctest)
mc.plot(regresion,vif=2)
Al realizar la prueba con mctest con los VIF, existe un umbral de 2, esto da a conocer que hay un margen de tolerancia de colinealidad del 0.5, siendo C y M el que más infla la varianza, esto nos permite conocer que existe un margen de colinealidad en los regresores.
Solución clave 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)
Estime el modelo de regresión lineal, correspondiente y verifique el supuesto de normalidad, usando todas las pruebas vistas en clase. Comente sus resultados.
Utilizando todas las herramientas vistas en clase, evalue la situación de colinealidad del modelo. Comente sus resultados.
library(stargazer)
load("C:/Users/IRMA/Downloads/wage2.RData")
# Estimando el modelo
modelo_escolaridad<-lm(formula= educ~sibs+meduc+feduc,data=wage2)
stargazer(modelo_escolaridad,title="Modelo de escolaridad", type="html")| 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 |
- Supuestos de normalidad
library(fitdistrplus)
ajuste_normal_2<-fitdist(data= modelo_escolaridad$residuals, distr = "norm")
plot(ajuste_normal_2)
Comentario: Con los graficos podemos concluir que los residuos no siguen una distribución normal
Prueba de JB
library(normtest)
jb.norm.test(modelo_escolaridad$residuals)##
## Jarque-Bera test for normality
##
## data: modelo_escolaridad$residuals
## JB = 35.655, p-value < 0.00000000000000022Comentario: Al aplicar la prueba JB, con un nivel de significancia de 5%, de VC de 5.9915, se aporta evidencia de que los residuos no siguen una distribución normal, debido a esto se rechaza Ho, JB>VC.
Prueba KS
library(nortest)
lillie.test(modelo_escolaridad$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: modelo_escolaridad$residuals
## D = 0.089992, p-value = 0.000000000000003394Comentario: Al aplicar la prueba KS, el p-value es < 5% del nivel de significancia, hay evidencia de que los residuos no siguen una distribución normal, por lo tanto se rechaza Ho.
Prueba de SW
shapiro.test(modelo_escolaridad$residuals)##
## Shapiro-Wilk normality test
##
## data: modelo_escolaridad$residuals
## W = 0.96692, p-value = 0.00000000001058# Normalizando W.
## Utilizando W:
W2 <- 0.96692
# Cálculo Miu.
miu2 <- 0.0038915*((log(722))^3)-0.083751*((log(722))^2)-0.31082*(log(722))-1.5861
# cálculo de Sigma.
sigma2 <- exp((0.0030302*(log(722)^2))-0.082676*(log(722))-0.4803)
# Cálculo Wn.
Wn2 <- (log(1-W2)-miu2)/sigma2
print(Wn2)## [1] 6.697959Comentario: Considerando un α = 5%, se obtiene un VC de 1.644854, aplicando la prueba SW y del VC se tiene que 6.697959 > 1.644854, se rechaza H0, por lo tanto existe evidencia de que los residuos no tienen una distribución normal. Al aplicar el supuesto de normalidad se puede concluir que en las 3 pruebas hay evidencia de que no tienen distribución normal los residuos.
2. Evidencia de colinealidad
# Calculando sigma matriz
matx_2<-model.matrix(modelo_escolaridad)
mxx_2<-t(matx_2)%*%matx_2
# matriz de normalización sn
sn_2<-diag(1/sqrt(diag(mxx_2)))
print(sn_2)## [,1] [,2] [,3] [,4]
## [1,] 0.03721615 0.00000000 0.00000000 0.000000000
## [2,] 0.00000000 0.01023182 0.00000000 0.000000000
## [3,] 0.00000000 0.00000000 0.00333189 0.000000000
## [4,] 0.00000000 0.00000000 0.00000000 0.003454319# Matriz normalizada
mat_nor2<-(sn_2%*%mxx_2)%*%sn_2
print(mat_nor2)## [,1] [,2] [,3] [,4]
## [1,] 1.0000000 0.7859482 0.9674488 0.9518319
## [2,] 0.7859482 1.0000000 0.7147921 0.7050768
## [3,] 0.9674488 0.7147921 1.0000000 0.9655820
## [4,] 0.9518319 0.7050768 0.9655820 1.0000000# Autovalores
lambdas_2<-eigen(mat_nor2, symmetric = TRUE)$values
print(lambdas_2)## [1] 3.55762739 0.37556335 0.04172605 0.02508320# Indice de condición K
K_2<-sqrt(max(lambdas_2)/min(lambdas_2))
print(K_2)## [1] 11.90937Indice de condición mctest
library(mctest)
source(file = "C:/Users/IRMA/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.50Comentario: Al obtener el indice de condición K, de ambas formas, obtenemos evidencia de que los regresores poseen colinealidad leve por que es < que 20.
Prueba de F-G
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.0000000000000000000000000000000000000000000000000000000000000000000000000000227501options(scipen = 0)
shadeDist(xshade = Chi_FG2,ddist= "dchisq", parm1= gl_2, lower.tail= FALSE, sub=paste("VC:", VC_2, "FG:", Chi_FG2))
Comentario: Al aplicar la prueba FG, se tiene que el X2FG > VC, (358.3897 > 7.81), se rechaza H0 y la prueba nos indica que existe evidencia de colineadlidad en los regresores.
Prueba FG (psych)
library(psych)
library(fastGraph)
FG_test2<-cortest.bartlett(matx_2[,-1])## R was not square, finding R from dataVC_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] 3options(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))
Comentario: Al aplicar la prueba FG, de todas las formas, obtenemos un FG > VC, por tanto hay evidencia de colinealidad en los regresores, se rechaza Ho.
VIF manual
VIF_2<-diag(solve(cor(matx_2[,-1])))
print(VIF_2)## sibs meduc feduc
## 1.098950 1.561254 1.506359VIF (car)
VIF_car2<-vif(modelo_escolaridad)
print(VIF_car2)## sibs meduc feduc
## 1.098950 1.561254 1.506359Comentario: Considerando un coeficiente de correlación entre los regresores menor o igual a 0.5, se obtiene un umbral de tolerancia para los VIF igual a 2, con el cual se evaluan los regresores y se determina que ninguno supera dicho umbral por lo que ninguno infla considerablemente la varianza.
Clave 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)
1.Estime el modelo de regresión lineal, correspondiente y verifique el supuesto de normalidad, usando todas las pruebas vistas en clase. Comente sus resultados.
- Utilizando todas las herramientas vistas en clase, evalue la situación de colinealidad del modelo. Comente sus resultados.
load("C:/Users/IRMA/Downloads/LAWSCH85.RData")
# Estimando el modelo
library(stargazer)
options(scipen = 99999)
modelo_salario<-lm(formula=salary~LSAT+GPA+libvol+cost+rank,data=LAWSCH85)
stargazer(modelo_salario,title= "Modelo de Salario", type="html")| Dependent variable: | |
| salary | |
| LSAT | 155.286 |
| (192.598) | |
| GPA | 14,500.240*** |
| (4,357.070) | |
| libvol | 12.956*** |
| (3.261) | |
| cost | 0.366** |
| (0.146) | |
| rank | -115.815*** |
| (16.153) | |
| Constant | -33,124.550 |
| (25,210.760) | |
| Observations | 136 |
| R2 | 0.806 |
| Adjusted R2 | 0.798 |
| Residual Std. Error | 5,525.860 (df = 130) |
| F Statistic | 107.948*** (df = 5; 130) |
| Note: | p<0.1; p<0.05; p<0.01 |
Prueba de normalidad
library(fitdistrplus)
ajuste_normal3<-fitdist(data= modelo_salario$residuals, distr = "norm")
plot(ajuste_normal3)
Comentario: Se puede observar que los residuos seguen una distribución normal.
Prueba JB
library(normtest)
jb.norm.test(modelo_salario$residuals)##
## Jarque-Bera test for normality
##
## data: modelo_salario$residuals
## JB = 2.9134, p-value = 0.1755Comentario: En la prueba JB, con un nivel de significancia del 5%, obtenemos evidencia de que los residuos siguen una distribución normal, pues JB es < VC de 5.9915, por lo tanto no se rechaza Ho.
Prueba KS (lilliefors)
library(nortest)
lillie.test(modelo_salario$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: modelo_salario$residuals
## D = 0.05251, p-value = 0.4749Comentario: Con un α = 5%, al aplicar la prueba KS, se obtiene el p-value 0.4123 > 0.05, por lo tanto no se rechaza H0, eso significa que sigue una distribucio normal.
Prueba SW
shapiro.test(modelo_salario$residuals)##
## Shapiro-Wilk normality test
##
## data: modelo_salario$residuals
## W = 0.98925, p-value = 0.3759# Normalizando W.
## Utilizando W:
W3 <- 0.99282
# Cálculo Miu.
miu3 <- 0.0038915*((log(136))^3)-0.083751*((log(136))^2)-0.31082*(log(136))-1.5861
## cálculo de Sigma.
sigma3 <- exp((0.0030302*(log(136)^2))-0.082676*(log(136))-0.4803)
## Cálculo Wn.
Wn3 <- (log(1-W3)-miu3)/sigma3
print(Wn3)## [1] -0.5943665Comentario: Con un α = 5%, se tiene un VC de 1.644854, en la prueba S-W y a través del VC se tiene que -0.5943665 < 1.644854, no se rechaza H0, por lo tanto existe evidencia de que los residuos tienen una distribución normal. Al evaluar el supuesto de normalidad a través de las 3 pruebas, se tiene un escenario robusto que evidencia que los residuos tienen distribución normal.
- Pruebas de colinealidad
# Calculando sigma matriz
matx_3<-model.matrix(modelo_salario)
mxx_3<-t(matx_3)%*%matx_3
# Sn, matriz de normalización
sn3<-diag(1/sqrt(diag(mxx_3)))
print(sn3)## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 0.08574929 0.000000000 0.00000000 0.0000000000 0.000000000000 0.0000000000
## [2,] 0.00000000 0.000540754 0.00000000 0.0000000000 0.000000000000 0.0000000000
## [3,] 0.00000000 0.000000000 0.02586346 0.0000000000 0.000000000000 0.0000000000
## [4,] 0.00000000 0.000000000 0.00000000 0.0002146439 0.000000000000 0.0000000000
## [5,] 0.00000000 0.000000000 0.00000000 0.0000000000 0.000006414093 0.0000000000
## [6,] 0.00000000 0.000000000 0.00000000 0.0000000000 0.000000000000 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.8777615 0.9526497 0.8525542
## [2,] 0.9995823 1.0000000 0.9991485 0.8854472 0.9564693 0.8413471
## [3,] 0.9982420 0.9991485 1.0000000 0.8924483 0.9551331 0.8292662
## [4,] 0.8777615 0.8854472 0.8924483 1.0000000 0.8838801 0.5968945
## [5,] 0.9526497 0.9564693 0.9551331 0.8838801 1.0000000 0.7365870
## [6,] 0.8525542 0.8413471 0.8292662 0.5968945 0.7365870 1.0000000# Autovalores
lambdas_3<-eigen(mat_nor3, symmetric = TRUE)$values
print(lambdas_3)## [1] 5.4381011892 0.4246396131 0.0956695851 0.0406281319 0.0008117738
## [6] 0.0001497069# Indice de condición K
K_3<-sqrt(max(lambdas_3)/min(lambdas_3))
print(K_3)## [1] 190.5912Indice de condición (mctest)
library(mctest)
source(file = "C:/Users/IRMA/Downloads/correccion_eigprop.R")
my_eigprop(mod= modelo_salario)##
## Call:
## my_eigprop(mod = modelo_salario)
##
## Eigenvalues CI (Intercept) LSAT GPA libvol cost rank
## 1 5.4381 1.0000 0.0000 0.0000 0.0000 0.0036 0.0019 0.0024
## 2 0.4246 3.5786 0.0000 0.0000 0.0000 0.1027 0.0059 0.1449
## 3 0.0957 7.5394 0.0000 0.0000 0.0001 0.6338 0.2511 0.1135
## 4 0.0406 11.5694 0.0011 0.0007 0.0048 0.2023 0.5568 0.3114
## 5 0.0008 81.8476 0.1395 0.0221 0.7961 0.0381 0.0862 0.3480
## 6 0.0001 190.5912 0.8594 0.9771 0.1990 0.0195 0.0981 0.0798
##
## ===============================
## Row 6==> LSAT, proportion 0.977125 >= 0.50
## Row 5==> GPA, proportion 0.796061 >= 0.50
## Row 3==> libvol, proportion 0.633756 >= 0.50
## Row 4==> cost, proportion 0.556845 >= 0.50Comentario: Calculando el Índice de Condición por medio de la librería mctest, se obtiene un K(x)= 186.7153 > 30, lo que indica un nivel de colinealidad servera, por lo que se considera un problema grave.
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] 363.9343# 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.000000000000000000000000000000000000000000000000000000000000000000000004385631options(scipen = 0)
shadeDist(xshade = Chi_FG3,ddist= "dchisq", parm1= gl_3, lower.tail= FALSE, sub=paste("VC:", VC_3, "FG:", Chi_FG3))
Comentario: Al aplicar la prueba FG, se tiene que el X2FG > VC, (391.508999 > 18.3070), se rechaza H0 y la prueba aporta evidencia de la existencia de colinealidad en los regresores.
VIF (car)
library(car)
VIF_car3<-vif(modelo_salario)
print(VIF_car3)## LSAT GPA libvol cost rank
## 3.469461 3.264910 1.735231 1.558141 2.777994Comentario: Considerando un coeficiente de correlación entre los regresores menor o igual a 0.5, se obtiene un umbral de tolerancia para los VIF igual a 2, con el cual se evaluan los regresores y se determina que ninguno supera dicho umbral por lo que ninguno infla considerablemente la varianza.