PARCIAL#2
WENDY
19/6/2020
TEORÍA
- Para un modelo de 2 regresores, la matriz de correlación es [1,0.96;0.96,1], el VIF es de: 12.7551
matriz<-matrix(data = c(1,0.96,
0.96,1), nrow = 2,ncol = 2,byrow = TRUE)
VIF<-diag(solve(matriz))
print(VIF)[1] 12.7551 12.7551
- Prueba robusta para evaluar la normalidad de los residuos, independientemente del tamaño muestral: prueba de Jarque_Bera
3.En una prueba de FG, para un modelo de 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 es: 0.4926
det_matriz<- exp(40/-((60-1)-((2*5+5)/6)))
print(det_matriz)[1] 0.4926459
- 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:0.6
Coef<-(2.5-1)/(2.5)
print(Coef)[1] 0.6
- 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: 0.1374
library(nortest)
mat_residuos<-matrix(data = c(10,15,-10,-15,4,-4), nrow=1, ncol = 6, byrow = TRUE)
lillie.test(mat_residuos)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: mat_residuos
## D = 0.1374, p-value = 0.9763- En una prueba de FG, para un modelo con 5 regresores y un alfa de 4.3% el valor critico es de: 18.79093
gl<-(5*(5-1)/2)
vc<-qchisq(0.043,gl,lower.tail = FALSE)
print(vc)[1] 18.79093
- Sea 10, 15, -10,-15,4,-4, los residuos de un modelo.El estadistico de prueba para el contraste de normalidad JB es: 0.51072
library(normtest)
jb.norm.test(mat_residuos)##
## Jarque-Bera test for normality
##
## data: mat_residuos
## JB = 0.51072, p-value = 0.575- Para una tolerancia de 0.05 el VIF es de: 20
vif<-(1/0.05)
print(vif)[1] 20
9.Sean 10,15,-10,-15,4,-4, los residuos de un modelo. El estadístico de prueba para el contraste de normalidad Shapiro Wilk es: 0.96164
shapiro.test(mat_residuos)##
## Shapiro-Wilk normality test
##
## data: mat_residuos
## W = 0.96164, p-value = 0.8323- Para un VIF=2.5 la tolerancia es de: 0.4
tolerancia<-(1/2.5)
print(tolerancia)[1] 0.4
EJERCICIOS PRÁCTICOS
EJERCICIO_1
ENUNCIADO:
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.
Importacion de Datos (Generar la variable de residuos)
library(stargazer)
library(readxl)
ventas_empresa <- read_excel("C:/Users/josue/Downloads/ventas_empresa.xlsx")
# Corriendo el modelo de regresion
estimacion_ventas<- lm(formula = V ~ C+P+M,data = ventas_empresa)
stargazer(estimacion_ventas,title = "modelo ventas",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 |
Pruebas de Normalidad de los Residuos
library(fitdistrplus)
library(stargazer)
ajuste_normal<-fitdist(data = estimacion_ventas$residuals,distr = "norm")
plot(ajuste_normal)
Prueba JB
library(normtest)
jb.norm.test(estimacion_ventas$residuals)##
## Jarque-Bera test for normality
##
## data: estimacion_ventas$residuals
## JB = 1.4004, p-value = 0.2675No se rechaza la hipótesis nula debido a que el p-value es mayor que el nivel de significancia,o.277>0.05.
Prueba de KS(Lilliefors)
library(nortest)
lillie.test(estimacion_ventas$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: estimacion_ventas$residuals
## D = 0.13659, p-value = 0.2935p-value 0.2935>significancia 0.05 por lo tanto no se rechaza la Ho.
Prueba de Shapiro
shapiro.test(estimacion_ventas$residuals)##
## Shapiro-Wilk normality test
##
## data: estimacion_ventas$residuals
## W = 0.95315, p-value = 0.3166No se rechaza la Ho debido a que el p_value es mayor que el nivel de significancia por lo tanto se tiene normalidad en los residuos.
Puebas de Multicolinealidad
Indice de Condicion
# Calculo manual
# Xmat
X_mat<-model.matrix(estimacion_ventas)
print(X_mat)## (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 3# XX
XX_mat<- t(X_mat)%*% X_mat
print(XX_mat)## (Intercept) C P M
## (Intercept) 24 5308 4503 2971
## C 5308 1187852 1007473 664534
## P 4503 1007473 859157 564389
## M 2971 664534 564389 372387# Sn matriz de normalizacion
Sn<-solve(diag(sqrt(diag(XX_mat))))
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_norm
XXmat_norm<-(Sn%*%XX_mat)%*%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
lambdas<-(eigen(XXmat_norm,symmetric = TRUE)$values)
print(lambdas)## [1] 3.9869237681 0.0095007154 0.0027882470 0.0007872695# Indice de Condicion
K<-sqrt(max(lambdas)/min(lambdas))
print(K)## [1] 71.16349Debido a que el indice de condición es 71.16>30, la multicolinealidad es severa.
Indice de Condicion usando mctest
library(mctest)
source(file ="C:/Users/josue/OneDrive/Escritorio/correccion_eigprop.R")
my_eigprop(mod= estimacion_ventas)##
## Call:
## my_eigprop(mod = estimacion_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.50Prueba de FG
library(fastGraph)
m<-ncol( X_mat[,-1])
n<-nrow(X_mat)
determinante_R<-det(cor(X_mat[,-1]))
Chi_FG<--(n-1-(2*m+5)/6)*log(determinante_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.814728shadeDist(xshade = Chi_FG,ddist = "dchisq",parm1 = gl,lower.tail = FALSE,sub=paste("vc:",vc,"FG:",Chi_FG))
Prueba de FG con mctest
library(mctest)
mctest(estimacion_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 testPrueba de FG con psych
library(psych)
library(fastGraph)
FG_test<- cortest.bartlett(X_mat[,-1])
vc1<-qchisq(0.05,FG_test$df,lower.tail = FALSE)
print(FG_test)$chisq [1] 71.20805
$p.value [1] 2.352605e-15
$df [1] 3
shadeDist(xshade = FG_test$chisq,ddist = "dchisq",parm1 = FG_test$df,lower.tail = FALSE,sub=paste("vc:",vc1,"FG:",FG_test$chisq))
Se rechaza la Ho ya que el estadistico de prueba es mayor que el valor critico, lo que evidencia multicolinealidad.
VIF Manual
VIF2<-diag(solve(cor(X_mat[,-1])))
print(VIF2)## C P M
## 7.631451 3.838911 9.449210VIF con librería car
library(car)
VIF_car<-vif(estimacion_ventas)
print(VIF_car)## C P M
## 7.631451 3.838911 9.449210VIF con librería mctest
library(mctest)
mc.plot(estimacion_ventas,vif = 2)
EJERCICIO_2
ENUNCIADO:
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
Carga de Datos (Generar la variable de residuos)
library(stargazer)
load("C:/Users/josue/Downloads/wage2.RData")
# Corriendo el modelo de regresion
estimacion_escolaridad<-lm(formula= educ~sibs+meduc+feduc, data=wage2)
stargazer(estimacion_escolaridad,title = "Modelo estimado 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 |
Pruebas de Normalidad de los Residuos
library(fitdistrplus)
library(stargazer)
ajuste_norm<-fitdist(data = estimacion_escolaridad$residuals,distr = "norm")
plot(ajuste_norm)
# Prueba JB
library(normtest)
jb.norm.test(estimacion_escolaridad$residuals)##
## Jarque-Bera test for normality
##
## data: estimacion_escolaridad$residuals
## JB = 35.655, p-value < 2.2e-16Se rechaza la Ho los residuos no presentan normalidad, debido a que el p_value es menor que el nivel de significancia.
Prueba de KS(Lilliefors)
library(nortest)
lillie.test(estimacion_escolaridad$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: estimacion_escolaridad$residuals
## D = 0.089992, p-value = 3.394e-15Los residuos no siguen una distribucion normal, ya que el p_value es menor que el nivel de significancia, por lo tanto se rechaza la hipótesis nula.
Prueba de Shapiro
shapiro.test(estimacion_escolaridad$residuals)##
## Shapiro-Wilk normality test
##
## data: estimacion_escolaridad$residuals
## W = 0.96692, p-value = 1.058e-11Para un nivel de significancia del 5% se rechaza la hipotesis nula,debido a que el p-value es menor que dicho nivel de significancia.
Puebas de Multicolinealidad
Indice de Condicion
# Calculo manual
# Xmat1
Xmat1<-model.matrix(estimacion_escolaridad)
print(Xmat1)## (Intercept) sibs meduc feduc
## 1 1 1 8 8
## 2 1 1 14 14
## 3 1 1 14 14
## 4 1 4 12 12
## 5 1 10 6 11
## 7 1 1 8 8
## 9 1 2 14 5
## 10 1 1 12 11
## 11 1 1 13 14
## 13 1 2 12 12
## 14 1 3 10 10
## 15 1 1 12 12
## 16 1 1 6 8
## 17 1 3 12 10
## 18 1 2 10 8
## 22 1 2 12 12
## 23 1 5 10 10
## 24 1 2 12 12
## 25 1 0 11 11
## 26 1 3 16 16
## 27 1 2 12 8
## 28 1 0 8 8
## 29 1 3 13 12
## 30 1 2 16 16
## 32 1 1 12 12
## 33 1 1 12 12
## 34 1 2 18 18
## 35 1 1 17 14
## 37 1 1 12 8
## 38 1 0 15 12
## 39 1 1 13 12
## 40 1 1 12 12
## 41 1 3 8 7
## 42 1 1 12 8
## 44 1 3 10 9
## 45 1 1 14 15
## 47 1 3 12 12
## 48 1 1 12 12
## 50 1 2 12 10
## 51 1 1 12 12
## 52 1 2 12 12
## 53 1 7 12 9
## 54 1 1 12 11
## 56 1 1 11 8
## 57 1 2 17 16
## 58 1 4 12 10
## 59 1 3 12 14
## 60 1 1 6 8
## 61 1 1 12 12
## 62 1 3 12 8
## 63 1 2 12 8
## 66 1 8 9 11
## 67 1 2 12 9
## 70 1 2 12 18
## 71 1 1 8 8
## 72 1 2 12 16
## 73 1 1 12 16
## 74 1 1 11 11
## 75 1 3 12 9
## 76 1 2 12 6
## 78 1 1 12 12
## 79 1 3 14 12
## 80 1 1 7 7
## 81 1 2 12 10
## 83 1 4 8 8
## 84 1 3 12 16
## 85 1 4 14 10
## 88 1 1 12 8
## 89 1 4 16 16
## 90 1 2 12 13
## 91 1 3 16 16
## 92 1 1 16 17
## 93 1 7 8 8
## 94 1 1 12 14
## 95 1 4 12 14
## 96 1 3 10 9
## 98 1 3 9 12
## 99 1 3 9 12
## 100 1 3 9 12
## 101 1 1 8 8
## 102 1 5 9 10
## 103 1 5 8 10
## 104 1 4 9 8
## 106 1 1 9 12
## 107 1 1 8 8
## 108 1 5 12 12
## 109 1 2 12 12
## 110 1 1 10 8
## 111 1 6 10 12
## 114 1 1 12 12
## 115 1 3 12 9
## 116 1 0 12 12
## 117 1 6 8 7
## 118 1 1 12 11
## 119 1 3 12 10
## 121 1 0 12 9
## 122 1 1 12 8
## 123 1 3 9 8
## 124 1 4 12 12
## 125 1 3 12 10
## 126 1 3 12 10
## 127 1 1 16 15
## 128 1 3 16 18
## 129 1 1 12 12
## 130 1 0 12 12
## 131 1 3 9 8
## 132 1 3 10 9
## 133 1 3 12 12
## 134 1 4 12 12
## 135 1 1 12 8
## 136 1 4 7 6
## 138 1 3 2 5
## 139 1 14 14 11
## 140 1 1 6 9
## 141 1 2 7 10
## 142 1 0 8 6
## 143 1 1 12 12
## 144 1 1 12 8
## 145 1 2 8 8
## 147 1 4 16 16
## 148 1 0 8 12
## 149 1 2 12 12
## 150 1 2 13 12
## 151 1 3 12 8
## 152 1 6 9 11
## 153 1 2 12 12
## 154 1 1 12 10
## 155 1 6 11 4
## 157 1 2 12 12
## 159 1 2 12 12
## 160 1 2 12 12
## 162 1 6 14 12
## 163 1 0 12 10
## 164 1 4 10 10
## 165 1 1 8 12
## 166 1 3 12 16
## 167 1 1 12 12
## 169 1 2 11 6
## 170 1 1 12 11
## 173 1 1 11 10
## 174 1 3 10 10
## 175 1 4 12 9
## 176 1 2 7 7
## 177 1 3 11 5
## 179 1 4 7 12
## 180 1 2 12 8
## 181 1 2 12 12
## 182 1 1 8 8
## 183 1 4 11 8
## 184 1 2 8 10
## 185 1 4 10 10
## 186 1 1 9 9
## 187 1 3 8 12
## 188 1 2 9 11
## 189 1 1 12 8
## 190 1 2 12 12
## 192 1 3 12 8
## 193 1 1 12 12
## 194 1 5 8 10
## 195 1 6 9 12
## 196 1 4 12 11
## 198 1 0 11 12
## 199 1 0 11 11
## 201 1 1 16 8
## 202 1 2 10 8
## 203 1 1 10 12
## 205 1 0 12 6
## 207 1 1 12 11
## 208 1 1 12 11
## 209 1 1 12 12
## 210 1 2 8 8
## 211 1 3 12 10
## 212 1 1 13 12
## 213 1 1 13 12
## 214 1 3 12 12
## 215 1 3 12 12
## 216 1 1 8 12
## 217 1 4 16 16
## 218 1 5 8 4
## 219 1 4 16 12
## 220 1 5 10 12
## 221 1 2 10 12
## 224 1 1 12 14
## 225 1 1 12 14
## 228 1 2 11 12
## 231 1 1 12 12
## 233 1 7 10 10
## 234 1 1 11 9
## 235 1 5 8 8
## 236 1 1 11 9
## 238 1 10 12 14
## 239 1 1 12 8
## 240 1 6 16 18
## 241 1 3 14 18
## 242 1 2 12 17
## 246 1 2 12 7
## 247 1 4 8 6
## 248 1 3 12 6
## 250 1 6 14 12
## 251 1 4 12 12
## 252 1 2 12 12
## 254 1 0 12 11
## 255 1 2 8 12
## 256 1 2 8 7
## 257 1 0 9 8
## 258 1 3 8 5
## 262 1 3 12 8
## 264 1 0 12 12
## 265 1 3 12 12
## 266 1 2 9 5
## 268 1 1 12 12
## 269 1 2 8 6
## 270 1 1 12 6
## 271 1 3 16 16
## 272 1 1 10 14
## 274 1 2 12 12
## 275 1 1 10 16
## 276 1 2 11 9
## 277 1 1 8 12
## 278 1 6 10 12
## 279 1 2 12 9
## 280 1 4 12 10
## 281 1 4 8 5
## 282 1 3 11 8
## 283 1 4 16 16
## 286 1 3 16 14
## 287 1 5 12 12
## 288 1 1 8 10
## 289 1 5 8 9
## 290 1 2 5 11
## 291 1 2 5 11
## 292 1 1 17 13
## 293 1 3 8 8
## 294 1 13 11 11
## 296 1 4 11 13
## 299 1 8 11 8
## 300 1 2 12 13
## 302 1 1 11 12
## 303 1 2 12 8
## 304 1 2 12 15
## 305 1 0 16 18
## 306 1 3 12 12
## 308 1 3 8 8
## 309 1 3 12 12
## 310 1 1 16 16
## 311 1 3 12 12
## 312 1 2 14 12
## 313 1 2 12 12
## 315 1 2 12 12
## 316 1 3 12 10
## 318 1 1 8 10
## 320 1 3 10 11
## 322 1 5 12 12
## 324 1 2 14 12
## 325 1 2 14 12
## 326 1 6 8 8
## 328 1 3 13 12
## 329 1 2 12 12
## 330 1 2 13 12
## 332 1 3 5 8
## 333 1 0 16 4
## 334 1 0 12 12
## 335 1 2 12 10
## 337 1 3 9 8
## 338 1 4 11 9
## 339 1 1 12 12
## 340 1 1 11 14
## 341 1 1 12 10
## 342 1 3 10 8
## 344 1 3 12 12
## 345 1 6 8 10
## 346 1 2 11 12
## 347 1 3 8 8
## 348 1 3 8 8
## 349 1 0 8 8
## 350 1 2 13 16
## 351 1 2 12 12
## 353 1 1 12 11
## 354 1 2 16 12
## 355 1 2 12 14
## 356 1 3 12 8
## 357 1 2 8 7
## 358 1 2 8 8
## 359 1 3 12 10
## 361 1 6 14 12
## 362 1 4 12 8
## 363 1 3 8 6
## 365 1 6 9 6
## 366 1 4 8 8
## 367 1 3 8 8
## 369 1 7 10 8
## 370 1 4 8 8
## 371 1 2 12 6
## 372 1 5 11 7
## 373 1 2 12 12
## 374 1 3 16 12
## 375 1 3 12 12
## 376 1 1 12 10
## 377 1 2 12 14
## 378 1 2 15 12
## 379 1 0 12 12
## 380 1 1 12 12
## 381 1 2 13 8
## 382 1 3 8 6
## 383 1 3 8 12
## 384 1 5 6 12
## 386 1 3 12 12
## 387 1 2 12 12
## 388 1 1 8 8
## 389 1 4 15 8
## 391 1 1 12 16
## 392 1 4 8 5
## 394 1 3 11 11
## 396 1 1 12 11
## 397 1 1 11 8
## 398 1 6 8 9
## 399 1 3 12 12
## 401 1 5 2 8
## 402 1 3 12 11
## 403 1 1 12 12
## 404 1 1 12 12
## 405 1 4 12 8
## 407 1 1 12 10
## 409 1 3 12 15
## 410 1 2 16 16
## 411 1 2 12 12
## 413 1 2 12 10
## 415 1 2 12 16
## 416 1 2 12 10
## 418 1 2 12 9
## 419 1 2 12 13
## 420 1 3 9 12
## 421 1 3 10 10
## 422 1 3 10 10
## 423 1 2 12 12
## 424 1 3 10 8
## 426 1 9 9 10
## 427 1 6 8 8
## 428 1 5 6 6
## 429 1 5 6 6
## 431 1 0 12 8
## 432 1 4 12 12
## 433 1 1 12 7
## 434 1 3 12 8
## 435 1 3 12 13
## 436 1 3 12 12
## 437 1 3 12 12
## 438 1 1 12 12
## 440 1 0 12 8
## 441 1 6 12 6
## 442 1 1 10 5
## 444 1 3 11 10
## 446 1 5 10 11
## 447 1 8 12 11
## 448 1 0 13 16
## 449 1 2 14 8
## 450 1 1 7 6
## 451 1 2 12 8
## 452 1 4 12 7
## 453 1 1 9 7
## 454 1 10 4 6
## 455 1 6 6 5
## 456 1 12 8 4
## 457 1 4 11 5
## 458 1 3 12 11
## 459 1 0 12 12
## 460 1 4 10 13
## 461 1 7 12 8
## 464 1 5 12 4
## 465 1 5 8 9
## 466 1 6 7 5
## 467 1 3 8 8
## 468 1 0 12 11
## 469 1 7 7 4
## 470 1 2 9 10
## 471 1 1 12 12
## 472 1 4 11 12
## 473 1 1 12 9
## 474 1 1 8 14
## 475 1 3 12 10
## 476 1 2 12 10
## 477 1 5 10 8
## 478 1 2 11 10
## 479 1 2 13 16
## 480 1 3 12 16
## 481 1 0 14 10
## 482 1 4 8 11
## 483 1 3 8 8
## 484 1 3 12 11
## 485 1 2 12 14
## 487 1 2 12 18
## 488 1 2 8 8
## 489 1 3 8 12
## 490 1 1 12 12
## 491 1 1 12 8
## 492 1 4 8 8
## 494 1 6 9 8
## 496 1 3 12 10
## 497 1 2 12 10
## 499 1 2 11 13
## 500 1 2 9 12
## 501 1 2 9 12
## 502 1 2 8 7
## 504 1 2 12 12
## 505 1 7 12 8
## 506 1 3 12 8
## 507 1 3 12 10
## 509 1 1 11 12
## 510 1 6 8 8
## 512 1 10 12 6
## 513 1 1 16 14
## 514 1 3 12 5
## 516 1 2 12 7
## 517 1 1 12 6
## 521 1 3 16 17
## 522 1 2 11 12
## 524 1 3 12 12
## 525 1 8 9 12
## 526 1 1 6 6
## 527 1 2 12 10
## 528 1 1 12 16
## 529 1 2 6 2
## 530 1 2 8 12
## 532 1 5 12 6
## 535 1 2 12 5
## 536 1 3 8 12
## 537 1 3 8 2
## 538 1 1 12 12
## 540 1 1 12 14
## 543 1 3 8 7
## 544 1 13 6 6
## 546 1 1 12 16
## 547 1 6 8 8
## 549 1 2 12 7
## 550 1 2 12 7
## 551 1 5 14 12
## 552 1 1 7 9
## 553 1 4 8 12
## 557 1 1 12 12
## 558 1 3 12 12
## 559 1 1 12 12
## 560 1 1 12 17
## 561 1 2 8 8
## 562 1 6 8 3
## 563 1 1 18 18
## 564 1 6 11 12
## 565 1 1 12 10
## 567 1 8 11 10
## 568 1 5 12 12
## 569 1 1 8 8
## 570 1 2 9 9
## 571 1 5 9 4
## 574 1 8 9 10
## 575 1 11 6 9
## 576 1 2 12 12
## 577 1 3 15 15
## 578 1 0 12 16
## 581 1 4 11 2
## 583 1 2 12 7
## 586 1 2 13 16
## 589 1 9 8 3
## 592 1 2 8 8
## 593 1 11 16 16
## 594 1 2 12 12
## 595 1 2 11 12
## 596 1 4 3 3
## 597 1 1 11 11
## 598 1 0 12 7
## 600 1 1 16 12
## 601 1 3 16 13
## 602 1 2 12 10
## 603 1 0 12 12
## 604 1 2 12 16
## 605 1 1 16 16
## 608 1 1 12 10
## 610 1 0 12 12
## 611 1 1 12 5
## 612 1 0 11 8
## 616 1 3 8 5
## 618 1 3 12 8
## 619 1 1 10 7
## 620 1 3 7 6
## 621 1 1 12 14
## 622 1 2 12 12
## 625 1 1 12 10
## 626 1 1 12 4
## 627 1 1 12 18
## 630 1 0 6 9
## 631 1 1 10 10
## 632 1 1 7 8
## 633 1 7 7 6
## 634 1 3 9 5
## 635 1 1 12 16
## 636 1 0 11 5
## 637 1 0 6 8
## 638 1 0 12 12
## 640 1 1 12 12
## 642 1 2 12 11
## 643 1 6 7 7
## 644 1 1 12 8
## 645 1 2 12 16
## 646 1 5 17 18
## 647 1 3 8 4
## 649 1 4 10 11
## 650 1 3 17 12
## 651 1 2 12 12
## 655 1 2 16 14
## 656 1 3 13 16
## 657 1 2 12 12
## 659 1 5 11 10
## 660 1 10 9 3
## 661 1 7 1 4
## 662 1 9 3 4
## 663 1 9 3 4
## 665 1 2 12 12
## 666 1 6 6 2
## 667 1 2 12 12
## 669 1 2 12 12
## 671 1 2 8 3
## 672 1 3 6 10
## 674 1 7 12 12
## 675 1 4 8 6
## 676 1 4 8 6
## 680 1 4 17 18
## 681 1 1 8 7
## 682 1 2 9 12
## 684 1 5 10 8
## 685 1 14 0 10
## 686 1 2 16 14
## 687 1 1 4 14
## 689 1 3 8 8
## 690 1 5 8 4
## 691 1 3 5 4
## 692 1 2 12 12
## 693 1 2 12 12
## 694 1 4 8 8
## 696 1 2 16 12
## 698 1 3 12 12
## 699 1 2 12 12
## 702 1 5 11 12
## 703 1 2 12 12
## 704 1 1 7 7
## 705 1 2 12 12
## 706 1 3 12 16
## 708 1 2 16 16
## 709 1 5 12 12
## 710 1 2 10 10
## 711 1 2 12 12
## 712 1 2 8 8
## 713 1 5 12 12
## 714 1 4 0 2
## 715 1 3 8 8
## 716 1 0 12 8
## 718 1 1 13 13
## 719 1 0 12 10
## 720 1 3 12 10
## 721 1 3 12 10
## 722 1 0 12 14
## 723 1 2 12 12
## 724 1 1 6 7
## 725 1 5 14 17
## 726 1 1 16 12
## 727 1 4 12 8
## 728 1 2 12 12
## 729 1 1 8 12
## 730 1 3 12 7
## 731 1 7 12 12
## 732 1 7 12 12
## 733 1 7 12 12
## 735 1 0 8 8
## 736 1 4 12 12
## 737 1 1 12 8
## 738 1 1 12 12
## 739 1 7 12 12
## 740 1 2 11 6
## 741 1 1 12 13
## 742 1 4 12 12
## 744 1 3 14 17
## 745 1 4 12 10
## 748 1 1 12 12
## 749 1 2 8 14
## 751 1 2 12 12
## 752 1 1 12 8
## 754 1 5 11 12
## 755 1 3 12 12
## 756 1 4 11 11
## 757 1 1 12 12
## 758 1 2 12 12
## 759 1 1 18 15
## 760 1 1 13 13
## 762 1 2 12 16
## 764 1 4 11 8
## 765 1 1 12 10
## 766 1 1 12 12
## 767 1 6 8 10
## 768 1 1 12 12
## 769 1 3 9 8
## 770 1 1 10 8
## 771 1 5 12 11
## 773 1 2 12 9
## 774 1 4 12 8
## 775 1 9 6 2
## 776 1 2 8 8
## 777 1 3 16 12
## 778 1 3 16 12
## 780 1 3 12 18
## 782 1 4 6 8
## 783 1 1 8 2
## 784 1 5 10 11
## 785 1 5 16 12
## 786 1 1 16 16
## 787 1 0 15 9
## 788 1 7 7 8
## 791 1 3 7 6
## 792 1 1 12 12
## 793 1 4 13 13
## 794 1 3 10 12
## 796 1 2 12 12
## 797 1 3 10 12
## 798 1 3 10 12
## 799 1 3 14 9
## 800 1 3 12 8
## 801 1 0 8 8
## 802 1 7 12 12
## 805 1 5 8 12
## 806 1 4 14 14
## 807 1 3 12 12
## 808 1 2 12 12
## 809 1 2 12 7
## 810 1 4 10 3
## 813 1 8 6 0
## 815 1 6 6 7
## 816 1 5 12 8
## 818 1 6 12 13
## 819 1 2 10 6
## 820 1 6 2 8
## 821 1 3 12 4
## 822 1 5 12 8
## 823 1 2 16 9
## 826 1 1 12 12
## 827 1 1 16 13
## 828 1 1 9 12
## 829 1 1 12 9
## 830 1 1 14 12
## 831 1 1 12 9
## 833 1 1 10 12
## 834 1 1 10 12
## 835 1 7 8 9
## 836 1 1 10 10
## 837 1 3 13 14
## 838 1 0 14 12
## 839 1 7 2 10
## 840 1 9 3 4
## 841 1 9 2 8
## 843 1 0 9 10
## 845 1 4 9 10
## 846 1 3 10 6
## 847 1 0 5 6
## 850 1 0 5 5
## 851 1 4 3 7
## 852 1 4 3 7
## 853 1 5 8 18
## 854 1 2 7 5
## 855 1 1 8 12
## 856 1 5 8 6
## 857 1 1 0 5
## 858 1 1 12 12
## 860 1 3 14 10
## 861 1 1 8 7
## 862 1 1 15 15
## 863 1 4 12 12
## 864 1 1 12 9
## 865 1 7 3 2
## 866 1 2 8 8
## 868 1 6 5 5
## 869 1 1 12 11
## 870 1 1 12 12
## 872 1 0 12 10
## 873 1 1 9 12
## 874 1 7 10 11
## 878 1 3 9 9
## 879 1 1 12 9
## 880 1 2 10 6
## 881 1 7 10 6
## 882 1 7 10 6
## 883 1 9 10 7
## 884 1 10 4 10
## 886 1 3 12 10
## 887 1 5 12 10
## 888 1 7 9 8
## 889 1 4 12 18
## 890 1 4 12 18
## 891 1 1 10 13
## 892 1 4 7 7
## 893 1 7 7 4
## 894 1 6 7 3
## 895 1 4 8 3
## 896 1 2 7 7
## 898 1 4 12 7
## 899 1 2 11 12
## 900 1 1 14 12
## 901 1 1 14 18
## 902 1 5 12 9
## 903 1 4 10 10
## 907 1 5 12 9
## 909 1 2 11 9
## 911 1 2 12 7
## 912 1 1 12 14
## 913 1 3 10 12
## 914 1 0 12 12
## 916 1 2 12 12
## 917 1 2 8 8
## 918 1 8 10 6
## 920 1 5 12 13
## 921 1 1 13 16
## 923 1 1 12 12
## 924 1 2 12 8
## 925 1 2 8 8
## 926 1 7 7 8
## 929 1 3 7 7
## 930 1 3 16 16
## 932 1 7 8 6
## attr(,"assign")
## [1] 0 1 2 3# XX
XX_mat1<- t(Xmat1)%*% Xmat1
print(XX_mat1)## (Intercept) sibs meduc feduc
## (Intercept) 722 2064 7802 7404
## sibs 2064 9552 20967 19949
## meduc 7802 20967 90078 83895
## feduc 7404 19949 83895 83806# Sn matriz de normalizacion
Sn1<-solve(diag(sqrt(diag(XX_mat1))))
print(Sn1)## [,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# XXmat_norm
XXmat_norm1<-(Sn1%*%XX_mat1)%*%Sn1
print(XXmat_norm1)## [,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
lambdas1<-(eigen(XXmat_norm1,symmetric = TRUE)$values)
print(lambdas1)## [1] 3.55762739 0.37556335 0.04172605 0.02508320# Indice de Condicion
K1<-sqrt(max(lambdas1)/min(lambdas1))
print(K1)## [1] 11.90937Indice de Condicion usando mctes
library(mctest)
source(file ="C:/Users/josue/OneDrive/Escritorio/correccion_eigprop.R")
my_eigprop(mod= estimacion_escolaridad)##
## Call:
## my_eigprop(mod = estimacion_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.50El indice de condición es menor que 20 por lo tanto presenta una multicolinealidad leve.
Prueba de FG
library(fastGraph)
m<-ncol( Xmat1[,-1])
n<-nrow(Xmat1)
det_R<-det(cor(Xmat1[,-1]))
Chi_FG1<--(n-1-(2*m+5)/6)*log(det_R)
print(Chi_FG1)## [1] 358.3897#Valor Crítico
gl_1<-m*(m-1)/2
VC_1<-qchisq(0.05,gl_1,lower.tail = FALSE)
print(VC_1)## [1] 7.814728shadeDist(xshade = Chi_FG1,ddist = "dchisq",parm1 = gl_1,lower.tail = FALSE,sub=paste("VC:",VC_1,"FG:",Chi_FG1))
Prueba de FG con mctest
library(mctest)
mctest(estimacion_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 testSe rechaza la hipótesis nula debido a que el estadistico FG es mayor que el valor crítico, por lo tanto se presenta multicolinealidad en el modelo.
Prueba de FG con psych
library(psych)
library(fastGraph)
FG_test_1<- cortest.bartlett(Xmat1[,-1])
Vac1<-qchisq(0.05,FG_test_1$df,lower.tail = FALSE)
print(FG_test_1)$chisq [1] 358.3897
$p.value [1] 2.27501e-77
$df [1] 3
shadeDist(xshade = FG_test_1$chisq,ddist = "dchisq",parm1 = FG_test_1$df,lower.tail = FALSE,sub=paste("VC:",Vac1,"FG:",FG_test_1$chisq))
VIF Manual
VIF_1<-diag(solve(cor(Xmat1[,-1])))
print(VIF_1)## sibs meduc feduc
## 1.098950 1.561254 1.506359VIF con librería Car
library(car)
VIF1_car<-vif(estimacion_escolaridad)
print(VIF1_car)## sibs meduc feduc
## 1.098950 1.561254 1.506359VIF con librería mctest
library(mctest)
mc.plot(estimacion_escolaridad,vif = 2)
EJERCICIO#3
ENUNCIADO:
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)
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
Carga de Datos (Generar la variable de residuos)
load("C:/Users/josue/Downloads/LAWSCH85.RData")
# Corriendo el modelo de regresion
library(stargazer)
estimacion_sal<-lm(formula= lsalary~LSAT+llibvol+GPA+lcost+rank, data=LAWSCH85)
stargazer(estimacion_sal, title= "Modelo Salario", type="html")| Dependent variable: | |
| lsalary | |
| LSAT | 0.005 |
| (0.004) | |
| llibvol | 0.095*** |
| (0.033) | |
| GPA | 0.248*** |
| (0.090) | |
| 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 de los Residuos
library(fitdistrplus)
library(stargazer)
ajuste1_normal<-fitdist(data = estimacion_sal$residuals,distr = "norm")
plot(ajuste1_normal)
Prueba JB
library(normtest)
jb.norm.test(estimacion_sal$residuals)##
## Jarque-Bera test for normality
##
## data: estimacion_sal$residuals
## JB = 0.36511, p-value = 0.826No se rechaza la hipótesis nula, los residuos presentan normalidad ya que el JB<VC,con un JB=0.3651 y un VC=5.99
Prueba de KS(Lilliefors)
library(nortest)
lillie.test(estimacion_sal$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: estimacion_sal$residuals
## D = 0.054571, p-value = 0.4123Los residuos del modelo poseen una distribución normal, por lo tanto no se rechaza la hipótesis nula,con un p_value 0.4123>0.05 nivel de significancia.
Prueba de Shapiro
shapiro.test(estimacion_sal$residuals)##
## Shapiro-Wilk normality test
##
## data: estimacion_sal$residuals
## W = 0.99282, p-value = 0.7235Para un nivel de significancia de 5% no se rechaza la hipótesis nula debido a que el p_value es mayor que el nivel de significancia, por lo tanto los residuos siguen una distribucion normal.
Puebas de Multicolinealidad
Indice de Condicion
# Calculo manual
# Xmat
Xmat2<-model.matrix(estimacion_sal)
print(Xmat2)## (Intercept) LSAT llibvol GPA lcost rank
## 1 1 155 5.375278 3.15 9.028818 128
## 2 1 160 5.545177 3.50 8.850804 104
## 3 1 155 6.049734 3.25 9.703206 34
## 4 1 157 5.796058 3.20 9.773721 49
## 5 1 162 5.805135 3.38 9.030017 95
## 6 1 161 5.739793 3.40 9.030017 98
## 7 1 155 5.393628 3.16 8.702843 124
## 8 1 152 5.438079 3.12 8.697179 157
## 9 1 155 5.438079 3.12 8.473241 145
## 10 1 160 5.056246 3.66 8.946375 91
## 11 1 165 5.768321 3.55 9.782449 50
## 12 1 163 6.152733 3.42 9.690294 23
## 13 1 162 5.799093 3.60 8.748305 78
## 14 1 167 6.396930 3.70 9.340228 5
## 16 1 163 6.295266 3.55 9.431723 19
## 17 1 165 6.152733 3.57 9.409355 13
## 18 1 156 5.337538 3.20 9.661416 115
## 19 1 156 4.990433 3.20 9.371609 171
## 20 1 154 5.370638 3.25 9.467073 131
## 21 1 160 5.863631 3.30 9.713840 72
## 22 1 158 5.720312 3.30 9.721966 55
## 23 1 168 6.318968 3.75 9.872616 4
## 24 1 162 5.826000 3.37 9.329722 90
## 26 1 164 5.634789 3.31 9.436440 65
## 27 1 168 6.599871 3.60 9.929058 7
## 29 1 163 5.991465 3.55 9.862665 10
## 31 1 156 5.347107 3.10 9.536040 137
## 32 1 155 5.337538 3.20 9.501815 141
## 33 1 158 5.616771 3.20 9.630431 47
## 34 1 158 5.743003 3.27 9.554994 82
## 36 1 155 5.247024 3.30 9.433484 76
## 38 1 155 5.480639 3.23 9.530973 88
## 39 1 169 6.109248 3.70 9.853036 9
## 41 1 163 5.560682 3.40 9.750919 43
## 43 1 158 5.846439 3.30 9.341369 81
## 44 1 163 6.016157 3.30 9.792556 22
## 45 1 154 5.225747 3.00 9.400961 142
## 47 1 163 5.998937 3.51 9.778491 31
## 48 1 166 6.590301 3.52 9.851931 18
## 49 1 163 6.122493 3.40 8.884748 46
## 51 1 158 5.298317 3.14 9.585621 79
## 52 1 154 5.283204 3.16 9.486076 74
## 53 1 168 7.464510 3.75 9.818148 1
## 54 1 160 5.442418 3.42 8.964439 139
## 55 1 158 5.978886 3.25 9.725556 28
## 56 1 159 5.991465 3.30 8.895630 48
## 57 1 152 5.480639 2.85 9.172119 116
## 58 1 152 4.983607 3.25 8.826147 132
## 59 1 161 6.385194 3.40 9.443196 38
## 60 1 160 6.234411 3.49 9.423999 30
## 61 1 159 6.016157 3.30 9.357725 109
## 62 1 140 5.081404 3.15 8.885303 172
## 63 1 159 6.588926 3.49 9.229162 17
## 64 1 158 5.634789 3.20 9.487972 113
## 65 1 159 5.783825 3.43 8.853094 62
## 66 1 160 5.796058 3.30 9.183791 92
## 67 1 161 5.783825 3.20 9.539644 123
## 68 1 156 6.291569 3.35 8.353968 83
## 69 1 157 5.463832 3.20 9.173573 93
## 70 1 160 5.652489 3.24 9.543235 73
## 71 1 161 5.831882 3.35 9.717399 36
## 72 1 152 5.438079 3.10 9.593082 155
## 74 1 157 5.393628 3.20 9.441452 40
## 75 1 160 5.783825 3.35 9.491375 57
## 76 1 157 5.652489 3.24 9.623377 37
## 77 1 154 5.505332 3.20 8.923191 140
## 78 1 157 5.529429 3.10 9.532424 105
## 79 1 155 5.971262 3.20 9.759040 107
## 80 1 168 6.620073 3.67 9.882009 2
## 81 1 163 6.684612 3.56 9.468774 20
## 82 1 153 5.560682 3.30 8.743213 54
## 83 1 153 5.393628 3.00 9.259130 85
## 84 1 154 5.501258 3.28 9.403685 96
## 85 1 155 4.820282 3.20 9.136909 122
## 86 1 156 5.717028 3.40 9.071078 97
## 87 1 152 5.488938 3.07 9.319195 114
## 88 1 158 5.857933 3.20 9.020873 125
## 89 1 154 5.932245 3.00 9.721366 86
## 91 1 152 5.521461 3.22 8.818038 163
## 92 1 159 5.105946 3.23 9.732699 110
## 93 1 157 5.298317 3.00 8.781402 160
## 95 1 162 6.322565 3.60 9.807528 14
## 96 1 161 5.828946 3.45 9.705036 35
## 97 1 156 5.416101 3.00 9.738613 136
## 98 1 161 6.380123 3.50 9.409191 33
## 99 1 154 5.568345 3.28 9.126741 80
## 100 1 151 5.375278 3.03 9.291921 134
## 101 1 160 5.673323 3.50 9.447782 53
## 102 1 159 5.634789 3.30 9.699533 162
## 103 1 165 6.291569 3.70 9.891769 8
## 104 1 146 5.351858 3.38 7.872074 165
## 105 1 159 5.707110 3.30 9.532424 129
## 106 1 161 5.375278 3.23 9.549665 148
## 107 1 157 6.109248 3.22 9.272188 64
## 108 1 161 5.973810 3.39 9.273597 60
## 109 1 158 6.013715 3.20 9.648595 70
## 110 1 156 5.991465 3.30 9.511926 68
## 112 1 160 5.768321 3.25 9.709903 52
## 113 1 159 5.501258 3.17 9.667766 56
## 114 1 159 5.347107 3.32 9.651173 61
## 115 1 155 5.755742 3.16 9.672186 87
## 116 1 157 5.786897 3.20 9.263502 118
## 117 1 156 5.049856 3.24 8.840725 153
## 118 1 155 5.669881 3.00 9.441452 168
## 119 1 164 5.799093 3.50 9.765948 26
## 120 1 156 5.710427 3.30 9.125436 106
## 121 1 159 6.086775 3.18 9.762615 42
## 122 1 157 5.828946 3.15 9.695232 75
## 123 1 167 6.025866 3.78 9.808408 6
## 125 1 158 5.703783 3.30 9.570808 108
## 126 1 155 5.765191 3.20 9.761232 51
## 127 1 157 6.084499 3.30 9.495520 45
## 129 1 163 6.745236 3.50 9.064157 12
## 131 1 157 5.560682 3.10 8.386629 101
## 133 1 157 5.560682 3.10 9.237955 154
## 134 1 152 5.736572 2.80 9.579833 174
## 135 1 155 5.560682 3.00 9.072801 100
## 136 1 161 5.575949 3.55 9.051228 29
## 137 1 155 5.370638 3.30 9.525881 69
## 138 1 164 5.796058 3.62 9.784141 16
## 139 1 159 5.164786 3.20 9.623377 152
## 140 1 160 6.040255 3.41 9.656307 63
## 141 1 164 6.551080 3.60 9.660014 15
## 142 1 162 5.521461 3.31 9.560997 111
## 143 1 154 5.525453 3.27 8.853665 102
## 144 1 163 6.109248 3.63 9.210340 25
## 145 1 163 5.693732 3.47 9.517825 16
## 146 1 160 6.165418 3.20 9.784141 41
## 147 1 158 6.028278 3.35 8.809863 67
## 148 1 153 5.707110 3.08 9.373734 135
## 149 1 155 5.438079 3.00 9.677841 156
## 150 1 154 6.175867 3.10 9.560997 138
## 151 1 157 5.497168 3.20 9.457200 66
## 152 1 162 5.703783 3.34 9.512665 17
## 154 1 157 5.159055 3.40 8.908694 143
## 155 1 171 6.745236 3.82 9.892426 3
## attr(,"assign")
## [1] 0 1 2 3 4 5# XX
XX_mat2<- t(Xmat2)%*% Xmat2
print(XX_mat2)## (Intercept) LSAT llibvol GPA lcost rank
## (Intercept) 136.0000 21557.00 783.3715 450.110 1277.008 10847.00
## LSAT 21557.0000 3419799.00 124336.7471 71440.370 202521.842 1697437.00
## llibvol 783.3715 124336.75 4536.4063 2599.264 7362.770 60522.09
## GPA 450.1100 71440.37 2599.2641 1494.950 4228.169 34980.46
## lcost 1277.0080 202521.84 7362.7705 4228.169 12010.096 100735.74
## rank 10847.0000 1697437.00 60522.0934 34980.460 100735.740 1190245.00# Sn matriz de normalizacion
Sn2<-solve(diag(sqrt(diag(XX_mat2))))
print(Sn2)## [,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.01484718 0.00000000 0.000000000 0.0000000000
## [4,] 0.00000000 0.000000000 0.00000000 0.02586346 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# XXmat_norm
XXmat_norm2<-(Sn2%*%XX_mat2)%*%Sn2
print(XXmat_norm2)## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 1.0000000 0.9995823 0.9973380 0.9982420 0.9991966 0.8525542
## [2,] 0.9995823 1.0000000 0.9982590 0.9991485 0.9993057 0.8413471
## [3,] 0.9973380 0.9982590 1.0000000 0.9981161 0.9974980 0.8236445
## [4,] 0.9982420 0.9991485 0.9981161 1.0000000 0.9978511 0.8292662
## [5,] 0.9991966 0.9993057 0.9974980 0.9978511 1.0000000 0.8425432
## [6,] 0.8525542 0.8413471 0.8236445 0.8292662 0.8425432 1.0000000#autovalores
lambdas2<-(eigen(XXmat_norm2,symmetric = TRUE)$values)
print(lambdas2)## [1] 5.7351306262 0.2604004371 0.0020823558 0.0018442636 0.0003778106
## [6] 0.0001645068# Indice de Condicion
K2<-sqrt(max(lambdas2)/min(lambdas2))
print(K2)## [1] 186.7153Indice de Condicion usando mctes
library(mctest)
source(file ="C:/Users/josue/OneDrive/Escritorio/correccion_eigprop.R")
my_eigprop(mod= estimacion_sal)##
## Call:
## my_eigprop(mod = estimacion_sal)
##
## Eigenvalues CI (Intercept) LSAT llibvol GPA lcost rank
## 1 5.7351 1.0000 0.0000 0.0000 0.0001 0.0000 0.0000 0.0021
## 2 0.2604 4.6930 0.0000 0.0000 0.0004 0.0002 0.0001 0.2884
## 3 0.0021 52.4800 0.0058 0.0030 0.8411 0.0007 0.1155 0.1357
## 4 0.0018 55.7648 0.0002 0.0010 0.1095 0.3355 0.1756 0.0161
## 5 0.0004 123.2068 0.4254 0.0588 0.0423 0.4407 0.6610 0.4700
## 6 0.0002 186.7153 0.5686 0.9371 0.0066 0.2229 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.50El indice de condición posee un valor de 180.71 por lo que se presenta multicolinealidad severa ya que 180.71>30.
Prueba de FG
library(fastGraph)
m<-ncol( Xmat2[,-1])
n<-nrow(Xmat2)
determinante_R2<-det(cor(Xmat2[,-1]))
Chi_FG_2<--(n-1-(2*m+5)/6)*log(determinante_R2)
print(Chi_FG_2)## [1] 391.509#Valor Crítico
gl_2<-m*(m-1)/2
vc2<-qchisq(0.05,gl_2,lower.tail = FALSE)
print(vc2)## [1] 18.30704shadeDist(xshade = Chi_FG_2,ddist = "dchisq",parm1 = gl_2,lower.tail = FALSE,sub=paste("VC:",vc2,"FG:",Chi_FG_2))
comentario
Prueba de FG con mctest
library(mctest)
mctest(estimacion_sal)##
## 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 testPrueba de FG con psych
library(psych)
library(fastGraph)
FG_test_2<- cortest.bartlett(Xmat2[,-1])
vc2<-qchisq(0.05,FG_test_2$df,lower.tail = FALSE)
print(FG_test_2)## $chisq
## [1] 391.509
##
## $p.value
## [1] 6.031929e-78
##
## $df
## [1] 10shadeDist(xshade = FG_test_2$chisq,ddist = "dchisq",parm1 = FG_test_2$df,lower.tail = FALSE,sub=paste("VC:",vc2,"FG:",FG_test_2$chisq)) Se rechaza la hipótesis nula debido a que el estadistico de FG es mayor que el valor critico, por lo que presenta multicolinealidad.
VIF Manual
VIF_2<-diag(solve(cor(Xmat2[,-1])))
print(VIF_2)## LSAT llibvol GPA lcost rank
## 3.635214 2.110802 3.369004 1.573583 3.124106VIF con librería Car
library(car)
VIF_car_2<-vif(estimacion_sal)
print(VIF_car_2)## LSAT llibvol GPA lcost rank
## 3.635214 2.110802 3.369004 1.573583 3.124106VIF con librería mctest
library(mctest)
mc.plot(estimacion_sal,vif = 2)