Resolucion Parcial 2
CARLOS RAUL NOVELLINO VASQUEZ
18 de junio de 2020
TEORIA
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)
regresor<-matrix(data = c(1,0.96,0.96,1),nrow = 2,ncol = 2,byrow = FALSE)
VIF<-diag(solve(regresor))
print(VIF)## [1] 12.7551 12.7551#Su VIF es 12.7551- Prueba robusta para evaluar la normalidad de los residuos, independientemente del tamaño muestral: Prueba Jarquer 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
det<-40/-(59-1-(2*4+5)/6)
determinante<-exp(det)
print(determinante)## [1] 0.488499#Su determinante es 0.4884994- 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
#VIF=1/1-R^2
#2.5=1/1-R^2
1-1/2.5## [1] 0.6 #coeficiente de correlación es de 0.65- 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)
Residuos<-matrix(data = c(10,15,-10,-15,4,-4),nrow = 6,ncol = 1,byrow = FALSE) #matriz/residuos
library(nortest)
lillie.test(Residuos)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: Residuos
## D = 0.1374, p-value = 0.97636- En una prueba de FG, para un modelo con 5 regresores y un alfa de 4.3%, el valor crÃtico es de
gl<-4*(4-1)/2 #grados de libertad
VC<-qchisq(0.043,gl,lower.tail = FALSE) #valor critico
print(VC)## [1] 13.00226#El valor critico es 13.002267- Sean 10,15,-10,-15,4,-4, los residuos de un modelo. El estadÃstico de prueba para el contraste de normalidad de JB es
library(normtest)
jb.norm.test(Residuos)##
## Jarque-Bera test for normality
##
## data: Residuos
## JB = 0.51072, p-value = 0.586#El valor de la prueba Jarque Bera es 0.510728- Para una tolerancia de 0.05 el VIF es de
VIF<- 1/0.05
print(VIF)## [1] 20#El VIF para una tolerancia del 0.05 el VIF es de 209- 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
shapiro.test(Residuos)##
## Shapiro-Wilk normality test
##
## data: Residuos
## W = 0.96164, p-value = 0.8323# Shapiro Wilk normalizado (Wn)
W<-0.96164
n<- 6
U<-(0.0038915%*%log(n)^3)-(0.083751%*%log(n)^2)-(0.31082%*%log(n))-1.5861
V<-exp((0.0030302%*%log(n)^2)-(0.082676%*%log(n))-0.4803)
Wn<-(log(1-W)-(U))/V
print(Wn)## [,1]
## [1,] -1.617473#El resultado del estadistico de prueba Shapiro Wilk es W = 0.96164 y Wn = -1.61747310- Para un VIF=2.5, la tolerancia es de
tolerancia<-1/2.5
print(tolerancia)## [1] 0.4#La tolerancia para un VIF de 2.5 es de 0.4SOLUCION EJERCICIO 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.
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.
options(scipen = 9999999)
library(stargazer)
library(readxl)
ventas_empresa <- read_excel("C:/Users/Jennyfer/Desktop/ventas_empresa.xlsx")
modelo_venta<-lm(formula = V~C+P+M, data = ventas_empresa)
stargazer(modelo_venta, title = "modelo parcial 2",type = "text")##
## modelo parcial 2
## ===============================================
## 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.01Pruebas de normalidad de los residuos
library(fitdistrplus)
ajuste_normal<-fitdist(data = modelo_venta$residuals, distr = 'norm')
plot(ajuste_normal)
#Prueba de JB
library(normtest)
jb.norm.test(modelo_venta$residuals)##
## Jarque-Bera test for normality
##
## data: modelo_venta$residuals
## JB = 1.4004, p-value = 0.2925# los criterios de la prueba estadistica de Jarque Bera para Rechazar la Ho los cuales son (JB ??? V.C o si el p-value ??? ??), los resultados nos muestran que el valor p-value ??? ??, por lo tanto se Rechaza la Ho esto es que no hay evidencia de distribución normal en los residuos.Prueba de KS con ajuste de Lilliefors
library(nortest)
lillie.test(modelo_venta$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: modelo_venta$residuals
## D = 0.13659, p-value = 0.2935# los criterios de la prueba estadistica de Kolmogorov Smirnov (Rechazar Ho si D ??? V.C o si el p-value ??? ??), en este caso nuestro valor p-value ??? ??, por lo que Rechazamos HO. Entonces que no hay evidencia de distribución normal en los residuos.Prueba de Shapiro-Wilk (Extendida)
shapiro.test(modelo_venta$residuals)##
## Shapiro-Wilk normality test
##
## data: modelo_venta$residuals
## W = 0.95315, p-value = 0.3166## Calculando U
U<-(0.00389*(log(24)^3)-0.083751*(log(54)^2)-0.31082*(log(24))-1.5861)
print(U)## [1] -3.781685S<-exp(1)^((0.0030302*(log(24)^2))-0.082676*(log(24))-0.4803)
print(S)## [1] 0.4904442## Normalizando W
Wn<-((log(1-0.95315)-U)/S)
print(Wn)## [1] 1.469853#Los criterios para No Rechazar Ho si Wn ??? V.C o si el p-value ??? ??, en este caso nuestro valor p-value ??? ??, por lo que no rechazamos Ho y se concluye que hay evidencia de que los residuales tienen una distribución normal.Pruebas de Colinealidad
2.Utilizando todas las herramientas vistas en clase, evalué la situación de colinealidad de los regresores del modelo. Comente sus resultados. Indice de condición
# Calculo manual
# Xmat
Xmat<-model.matrix(modelo_venta)
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 3# Construyendo sima-matriz XXmat
XXmat<-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# Sig-matriz normalizada
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_norm Matriz 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 condicion
K<-sqrt(max(lambas)/min(lambas))
print(K)## [1] 71.16349#Indice de condicion utilizando mctest
library(mctest)
source(file = "C://Users//Jennyfer//Documents//Bluetooth Folder//correccion_eigprop.R")
my_eigprop(modelo_venta)##
## Call:
## my_eigprop(mod = modelo_venta)
##
## 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
print(m)## [1] 3n<-nrow(Xmat)
print(n)## [1] 24determinante_R<-det(cor(Xmat[,-1]))
print(determinante_R)## [1] 0.03459107chi_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))
#Como chi_FG (71.2080) ??? V.C(7.814728),Se rechaza Ho, por lo que se concluye que hay evidencia de colinealidad en los regresores.FG con mctest
library(mctest)
mctest(modelo_venta)##
## 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 testlibrary(psych)
library(fastGraph)
FG_test<-cortest.bartlett(Xmat[,-1])
print(FG_test)## $chisq
## [1] 71.20805
##
## $p.value
## [1] 0.000000000000002352605
##
## $df
## [1] 3VC_1<-qchisq(0.05,FG_test$df,lower.tail = FALSE)
shadeDist(xshade = FG_test$chisq,
ddist = "dchisq",
parm1 = FG_test$df,
lower.tail = FALSE,
sub=paste("VC:",VC_1,"FG:",FG_test$chisq))
VIF manual
VIF<-diag(solve(cor(Xmat[,-1])))
print(VIF)## C P M
## 7.631451 3.838911 9.449210Calculo de VIF con libreria car
library(car)
VIF_car<-vif(modelo_venta)
print(VIF_car)## C P M
## 7.631451 3.838911 9.449210VIF con libreria mctest
library(mctest)
mc.plot(modelo_venta,vif = 2)
# Conociendo el criterios VIF > 5 O VIF > 10 se consideran variables altamente colineales y teniendo un umbral de entre 2 y 5, por lo tanto que es un valor aceptable, en el caso del modelo de las ventas los valores de las variables se encuentran en tre el umbral, por lo que la colinealidad de las variables siendo aceptableSOLUCION EJERCICIO 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).
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.
options(scipen = 9999999)
library(readr)
trabajos_hombres<-load("C:/Users/Jennyfer/Desktop/wage2.RData")
modelo_hombre<-lm(formula = educ~sibs+meduc+feduc,data = wage2)
summary(modelo_hombre)##
## Call:
## lm(formula = educ ~ sibs + meduc + feduc, data = wage2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.0906 -1.5957 -0.3677 1.6138 5.6103
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 10.36426 0.35850 28.910 < 0.0000000000000002 ***
## sibs -0.09364 0.03447 -2.716 0.00676 **
## meduc 0.13079 0.03269 4.001 0.0000696319512857 ***
## feduc 0.21000 0.02747 7.644 0.0000000000000679 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.987 on 718 degrees of freedom
## (213 observations deleted due to missingness)
## Multiple R-squared: 0.2141, Adjusted R-squared: 0.2108
## F-statistic: 65.2 on 3 and 718 DF, p-value: < 0.00000000000000022Pruebas de normalidad de los residuos
library(fitdistrplus)
ajuste_normal<-fitdist(data = modelo_hombre$residuals, distr = 'norm')
plot(ajuste_normal)
Prueba de JB
library(normtest)
jb.norm.test(modelo_hombre$residuals)##
## Jarque-Bera test for normality
##
## data: modelo_hombre$residuals
## JB = 35.655, p-value < 0.00000000000000022# Teniendo en cuenta los criterios de la prueva estadistica de Jarque Bera para Rechazar la Ho los cuales son (JB ??? V.C o si el p-value ??? ??), los resultados nos muestran que el valor p-value ??? ??, por lo que se Rechaza la Ho y se concluye que no hay evidencia de distribución normal en los residuos.Prueba de KS con ajuste de Lilliefors
library(nortest)
lillie.test(modelo_hombre$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: modelo_hombre$residuals
## D = 0.089992, p-value = 0.000000000000003394# los criterios de la prueba estadistica de Kolmogorov Smirnov (Rechazar Ho si D ??? V.C o si el p-value ??? ??), en este caso nuestro valor p-value ??? ??, por lo que Rechazamos HO y no hay evidencia de distribución normal en los residuos.Prueba de Shapiro-Wilk (Extendida)
shapiro.test(modelo_hombre$residuals)##
## Shapiro-Wilk normality test
##
## data: modelo_hombre$residuals
## W = 0.96692, p-value = 0.00000000001058Calculando U
U<-(0.00389*(log(722)^3)-0.083751*(log(722)^2)-0.31082*(log(722))-1.5861)
print(U)## [1] -6.151027S<-exp(1)^((0.0030302*(log(722)^2))-0.082676*(log(722))-0.4803)
print(S)## [1] 0.4093446Normalizando W
Wn<-((log(1-0.96692)-U)/S)
print(Wn)## [1] 6.699004#Para No Rechazar Ho si Wn ??? V.C o si el p-value ??? ??, en este caso nuestro valor p-value ??? ??, por lo que no rechazamos Ho y por lo tanto hay evidencia de que los residuales tienen una distribución normal.Pruebas de Colinealidad
2.Utilizando todas las herramientas vistas en clase, evalue la situación de colinealidad del modelo. Comente sus resultados #Indice de condición
# Calculo manual
# Xmat
Xmat<-model.matrix(modelo_hombre)
print(Xmat)## (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# Construyendo sigma-matriz XXmat
XXmat<-t(Xmat)%*%Xmat
print(XXmat)## (Intercept) sibs meduc feduc
## (Intercept) 722 2064 7802 7404
## sibs 2064 9552 20967 19949
## meduc 7802 20967 90078 83895
## feduc 7404 19949 83895 83806# Sigma-matriz normalizada
Sn<-diag(1/sqrt(diag(XXmat)))
print(Sn)## [,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.003454319XXmat_norm<-(Sn%*%XXmat)%*%Sn
print(XXmat_norm)## [,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
lambas<-eigen(XXmat_norm,symmetric = TRUE)$values
print(lambas)## [1] 3.55762739 0.37556335 0.04172605 0.02508320# Indice de condicion
K<-sqrt(max(lambas)/min(lambas))
print(K)## [1] 11.90937#Indice de condicion utilizando mctest
library(mctest)
source(file = "C://Users//Jennyfer//Documents//Bluetooth Folder//correccion_eigprop.R")
my_eigprop(modelo_hombre)##
## Call:
## my_eigprop(mod = modelo_hombre)
##
## 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.50Prueba de FG
library(fastGraph)
m<-ncol(Xmat[,-1]) # Cantidad de variables explicativas k-1
print(m)## [1] 3n<-nrow(Xmat)
print(n)## [1] 722determinante_R<-det(cor(Xmat[,-1]))
print(determinante_R)## [1] 0.6075382chi_FG<--(n-1-(2*m+5)/6)*log(determinante_R)
print(chi_FG)## [1] 358.3897Valor 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))
#Como chi_FG (358.3897) ??? V.C(7.814728),Se rechaza Ho, por lo que se concluye que hay evidencia de colinealidad en los regresores.FG con mctest
library(mctest)
mctest(modelo_hombre)##
## 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 testlibrary(psych)
library(fastGraph)
FG_test<-cortest.bartlett(Xmat[,-1])
print(FG_test)## $chisq
## [1] 358.3897
##
## $p.value
## [1] 0.0000000000000000000000000000000000000000000000000000000000000000000000000000227501
##
## $df
## [1] 3VC_1<-qchisq(0.05,FG_test$df,lower.tail = FALSE)
shadeDist(xshade = FG_test$chisq,
ddist = "dchisq",
parm1 = FG_test$df,
lower.tail = FALSE,
sub=paste("VC:",VC_1,"FG:",FG_test$chisq))
VIF manual
VIF<-diag(solve(cor(Xmat[,-1])))
print(VIF)## sibs meduc feduc
## 1.098950 1.561254 1.506359Calculo de VIF con libreria car
library(car)
VIF_car<-vif(modelo_hombre)
print(VIF_car)## sibs meduc feduc
## 1.098950 1.561254 1.506359VIF con libreria mctest
library(mctest)
mc.plot(modelo_hombre,vif = 2)
# Conociendo el criterios VIF > 5 O VIF > 10 se consideran variables altamente colineales y teniendo un umbral de entre 2 y 5 es un valor aceptable, en el caso de los datos de los trabajadores las variables estan entre ese unbral, y colinealidad de las variables se acepta.SOLUCION EJERCICO 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.
options(scipen = 9999999)
library(readr)
sueldo<-load("C:/Users/Jennyfer/Desktop/LAWSCH85.RData")
modelo_sueldo<-lm(formula = log(salary)~(LSAT+GPA+log(libvol)+log(cost)+rank) ,data = LAWSCH85)
summary(modelo_sueldo)##
## Call:
## lm(formula = log(salary) ~ (LSAT + GPA + log(libvol) + log(cost) +
## rank), data = LAWSCH85)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.301356 -0.084982 -0.004359 0.077935 0.288614
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.3432262 0.5325192 15.667 < 0.0000000000000002 ***
## LSAT 0.0046965 0.0040105 1.171 0.24372
## GPA 0.2475238 0.0900371 2.749 0.00683 **
## log(libvol) 0.0949932 0.0332544 2.857 0.00499 **
## log(cost) 0.0375539 0.0321061 1.170 0.24427
## rank -0.0033246 0.0003485 -9.541 < 0.0000000000000002 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1124 on 130 degrees of freedom
## (20 observations deleted due to missingness)
## Multiple R-squared: 0.8417, Adjusted R-squared: 0.8356
## F-statistic: 138.2 on 5 and 130 DF, p-value: < 0.00000000000000022Pruebas de normalidad de los residuos
library(fitdistrplus)
ajuste_normal<-fitdist(data = modelo_sueldo$residuals, distr = 'norm')
plot(ajuste_normal)
Prueba de JB
library(normtest)
jb.norm.test(modelo_sueldo$residuals)##
## Jarque-Bera test for normality
##
## data: modelo_sueldo$residuals
## JB = 0.36511, p-value = 0.8145#Los criterios de la prueva estadistica de Jarque Bera para Rechazar la Ho los cuales son (JB ??? V.C o si el p-value ??? ??), los resultados nos muestran que el valor p-value ??? ??, por lo tanto se Rechaza la Ho y no hay evidencia de distribución normal en los residuos.Prueba de KS con ajuste de Lilliefors
library(nortest)
lillie.test(modelo_sueldo$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: modelo_sueldo$residuals
## D = 0.054571, p-value = 0.4123# Los criterios de la prueba estadistica de Kolmogorov Smirnov (Rechazar Ho si D ??? V.C o si el p-value ??? ??), en este caso nuestro valor p-value ??? ??, Rechazamos HO y no hay evidencia de distribución normal en los residuos.Prueba de Shapiro-Wilk (Extendida)
shapiro.test(modelo_sueldo$residuals)##
## Shapiro-Wilk normality test
##
## data: modelo_sueldo$residuals
## W = 0.99282, p-value = 0.7235## Calculando U
U<-(0.00389*(log(136)^3)-0.083751*(log(136)^2)-0.31082*(log(136))-1.5861)
print(U)## [1] -4.673103S<-exp(1)^((0.0030302*(log(136)^2))-0.082676*(log(136))-0.4803)
print(S)## [1] 0.4433804## Normalizando W
Wn<-((log(1-0.99282)-U)/S)
print(Wn)## [1] -0.5939654#Los criterios para No Rechazar Ho si Wn ??? V.C o si el p-value ??? ??, en este caso nuestro valor p-value ??? ??, por lo que no rechazamos Ho y se concluye que hay evidencia de que los residuales tienen una distribución normal.Pruebas de Colinealidad
2.Utilizando todas las herramientas vistas en clase, evalue la situación de colinealidad del modelo. Comente sus resultados #Indice de condición
# Calculo manual
# Xmat
Xmat<-model.matrix(modelo_sueldo)
print(Xmat)## (Intercept) LSAT GPA log(libvol) log(cost) rank
## 1 1 155 3.15 5.375278 9.028818 128
## 2 1 160 3.50 5.545177 8.850804 104
## 3 1 155 3.25 6.049733 9.703206 34
## 4 1 157 3.20 5.796058 9.773720 49
## 5 1 162 3.38 5.805135 9.030017 95
## 6 1 161 3.40 5.739793 9.030017 98
## 7 1 155 3.16 5.393628 8.702843 124
## 8 1 152 3.12 5.438079 8.697179 157
## 9 1 155 3.12 5.438079 8.473241 145
## 10 1 160 3.66 5.056246 8.946375 91
## 11 1 165 3.55 5.768321 9.782449 50
## 12 1 163 3.42 6.152733 9.690294 23
## 13 1 162 3.60 5.799093 8.748305 78
## 14 1 167 3.70 6.396930 9.340228 5
## 16 1 163 3.55 6.295266 9.431722 19
## 17 1 165 3.57 6.152733 9.409355 13
## 18 1 156 3.20 5.337538 9.661416 115
## 19 1 156 3.20 4.990433 9.371609 171
## 20 1 154 3.25 5.370638 9.467073 131
## 21 1 160 3.30 5.863631 9.713839 72
## 22 1 158 3.30 5.720312 9.721966 55
## 23 1 168 3.75 6.318968 9.872616 4
## 24 1 162 3.37 5.826000 9.329722 90
## 26 1 164 3.31 5.634790 9.436440 65
## 27 1 168 3.60 6.599870 9.929058 7
## 29 1 163 3.55 5.991465 9.862666 10
## 31 1 156 3.10 5.347108 9.536041 137
## 32 1 155 3.20 5.337538 9.501815 141
## 33 1 158 3.20 5.616771 9.630431 47
## 34 1 158 3.27 5.743003 9.554993 82
## 36 1 155 3.30 5.247024 9.433484 76
## 38 1 155 3.23 5.480639 9.530974 88
## 39 1 169 3.70 6.109248 9.853036 9
## 41 1 163 3.40 5.560682 9.750919 43
## 43 1 158 3.30 5.846439 9.341369 81
## 44 1 163 3.30 6.016157 9.792556 22
## 45 1 154 3.00 5.225747 9.400961 142
## 47 1 163 3.51 5.998937 9.778491 31
## 48 1 166 3.52 6.590301 9.851931 18
## 49 1 163 3.40 6.122493 8.884749 46
## 51 1 158 3.14 5.298317 9.585621 79
## 52 1 154 3.16 5.283204 9.486076 74
## 53 1 168 3.75 7.464510 9.818148 1
## 54 1 160 3.42 5.442418 8.964440 139
## 55 1 158 3.25 5.978886 9.725556 28
## 56 1 159 3.30 5.991465 8.895630 48
## 57 1 152 2.85 5.480639 9.172119 116
## 58 1 152 3.25 4.983607 8.826147 132
## 59 1 161 3.40 6.385194 9.443197 38
## 60 1 160 3.49 6.234411 9.423999 30
## 61 1 159 3.30 6.016157 9.357725 109
## 62 1 140 3.15 5.081404 8.885303 172
## 63 1 159 3.49 6.588926 9.229162 17
## 64 1 158 3.20 5.634790 9.487972 113
## 65 1 159 3.43 5.783825 8.853094 62
## 66 1 160 3.30 5.796058 9.183791 92
## 67 1 161 3.20 5.783825 9.539644 123
## 68 1 156 3.35 6.291569 8.353968 83
## 69 1 157 3.20 5.463832 9.173573 93
## 70 1 160 3.24 5.652489 9.543235 73
## 71 1 161 3.35 5.831882 9.717399 36
## 72 1 152 3.10 5.438079 9.593083 155
## 74 1 157 3.20 5.393628 9.441452 40
## 75 1 160 3.35 5.783825 9.491375 57
## 76 1 157 3.24 5.652489 9.623377 37
## 77 1 154 3.20 5.505332 8.923191 140
## 78 1 157 3.10 5.529429 9.532424 105
## 79 1 155 3.20 5.971262 9.759040 107
## 80 1 168 3.67 6.620073 9.882009 2
## 81 1 163 3.56 6.684612 9.468774 20
## 82 1 153 3.30 5.560682 8.743213 54
## 83 1 153 3.00 5.393628 9.259131 85
## 84 1 154 3.28 5.501258 9.403684 96
## 85 1 155 3.20 4.820282 9.136909 122
## 86 1 156 3.40 5.717028 9.071078 97
## 87 1 152 3.07 5.488938 9.319195 114
## 88 1 158 3.20 5.857933 9.020873 125
## 89 1 154 3.00 5.932245 9.721366 86
## 91 1 152 3.22 5.521461 8.818038 163
## 92 1 159 3.23 5.105945 9.732699 110
## 93 1 157 3.00 5.298317 8.781402 160
## 95 1 162 3.60 6.322565 9.807527 14
## 96 1 161 3.45 5.828946 9.705037 35
## 97 1 156 3.00 5.416100 9.738613 136
## 98 1 161 3.50 6.380123 9.409191 33
## 99 1 154 3.28 5.568345 9.126741 80
## 100 1 151 3.03 5.375278 9.291920 134
## 101 1 160 3.50 5.673323 9.447781 53
## 102 1 159 3.30 5.634790 9.699534 162
## 103 1 165 3.70 6.291569 9.891769 8
## 104 1 146 3.38 5.351858 7.872074 165
## 105 1 159 3.30 5.707110 9.532424 129
## 106 1 161 3.23 5.375278 9.549666 148
## 107 1 157 3.22 6.109248 9.272188 64
## 108 1 161 3.39 5.973810 9.273597 60
## 109 1 158 3.20 6.013715 9.648595 70
## 110 1 156 3.30 5.991465 9.511925 68
## 112 1 160 3.25 5.768321 9.709903 52
## 113 1 159 3.17 5.501258 9.667765 56
## 114 1 159 3.32 5.347108 9.651173 61
## 115 1 155 3.16 5.755742 9.672186 87
## 116 1 157 3.20 5.786897 9.263502 118
## 117 1 156 3.24 5.049856 8.840725 153
## 118 1 155 3.00 5.669881 9.441452 168
## 119 1 164 3.50 5.799093 9.765948 26
## 120 1 156 3.30 5.710427 9.125436 106
## 121 1 159 3.18 6.086775 9.762615 42
## 122 1 157 3.15 5.828946 9.695233 75
## 123 1 167 3.78 6.025866 9.808407 6
## 125 1 158 3.30 5.703782 9.570808 108
## 126 1 155 3.20 5.765191 9.761233 51
## 127 1 157 3.30 6.084499 9.495519 45
## 129 1 163 3.50 6.745236 9.064158 12
## 131 1 157 3.10 5.560682 8.386629 101
## 133 1 157 3.10 5.560682 9.237956 154
## 134 1 152 2.80 5.736572 9.579833 174
## 135 1 155 3.00 5.560682 9.072801 100
## 136 1 161 3.55 5.575949 9.051227 29
## 137 1 155 3.30 5.370638 9.525881 69
## 138 1 164 3.62 5.796058 9.784141 16
## 139 1 159 3.20 5.164786 9.623377 152
## 140 1 160 3.41 6.040255 9.656307 63
## 141 1 164 3.60 6.551080 9.660014 15
## 142 1 162 3.31 5.521461 9.560997 111
## 143 1 154 3.27 5.525453 8.853665 102
## 144 1 163 3.63 6.109248 9.210340 25
## 145 1 163 3.47 5.693732 9.517825 16
## 146 1 160 3.20 6.165418 9.784141 41
## 147 1 158 3.35 6.028279 8.809863 67
## 148 1 153 3.08 5.707110 9.373734 135
## 149 1 155 3.00 5.438079 9.677841 156
## 150 1 154 3.10 6.175867 9.560997 138
## 151 1 157 3.20 5.497168 9.457200 66
## 152 1 162 3.34 5.703782 9.512665 17
## 154 1 157 3.40 5.159055 8.908695 143
## 155 1 171 3.82 6.745236 9.892427 3
## attr(,"assign")
## [1] 0 1 2 3 4 5# Construyendo sigma-matriz XXmat
XXmat<-t(Xmat)%*%Xmat
print(XXmat)## (Intercept) LSAT GPA log(libvol) log(cost)
## (Intercept) 136.0000 21557.00 450.110 783.3715 1277.008
## LSAT 21557.0000 3419799.00 71440.370 124336.7464 202521.842
## GPA 450.1100 71440.37 1494.950 2599.2640 4228.169
## log(libvol) 783.3715 124336.75 2599.264 4536.4063 7362.770
## log(cost) 1277.0080 202521.84 4228.169 7362.7704 12010.096
## rank 10847.0000 1697437.00 34980.460 60522.0931 100735.741
## rank
## (Intercept) 10847.00
## LSAT 1697437.00
## GPA 34980.46
## log(libvol) 60522.09
## log(cost) 100735.74
## rank 1190245.00# Sigma-matriz normalizada
Sn<-diag(1/sqrt(diag(XXmat)))
print(Sn)## [,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# XXmat_norm Matriz normalizada
XXmat_norm<-(Sn%*%XXmat)%*%Sn
print(XXmat_norm)## [,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
lambas<-eigen(XXmat_norm,symmetric = TRUE)$values
print(lambas)## [1] 5.7351306271 0.2604004362 0.0020823558 0.0018442637 0.0003778105
## [6] 0.0001645067# Indice de condicion
K<-sqrt(max(lambas)/min(lambas))
print(K)## [1] 186.7153Indice de condicion utilizando mctest
#Indice de condicion utilizando mctest
library(mctest)
source(file = "C://Users//Jennyfer//Documents//Bluetooth Folder//correccion_eigprop.R")
my_eigprop(modelo_sueldo)##
## Call:
## my_eigprop(mod = modelo_sueldo)
##
## Eigenvalues CI (Intercept) LSAT GPA log(libvol) log(cost)
## 1 5.7351 1.0000 0.0000 0.0000 0.0000 0.0001 0.0000
## 2 0.2604 4.6930 0.0000 0.0000 0.0002 0.0004 0.0001
## 3 0.0021 52.4800 0.0058 0.0030 0.0007 0.8411 0.1155
## 4 0.0018 55.7648 0.0002 0.0010 0.3355 0.1095 0.1756
## 5 0.0004 123.2068 0.4254 0.0588 0.4407 0.0423 0.6610
## 6 0.0002 186.7153 0.5686 0.9371 0.2229 0.0066 0.0478
## rank
## 1 0.0021
## 2 0.2884
## 3 0.1357
## 4 0.0161
## 5 0.4700
## 6 0.0877
##
## ===============================
## Row 6==> LSAT, proportion 0.937119 >= 0.50
## Row 3==> log(libvol), proportion 0.841136 >= 0.50
## Row 5==> log(cost), proportion 0.661004 >= 0.50Prueba de FG
library(fastGraph)
m<-ncol(Xmat[,-1]) # Cantidad de variables explicativas k-1
print(m)## [1] 5n<-nrow(Xmat)
print(n)## [1] 136determinante_R<-det(cor(Xmat[,-1]))
print(determinante_R)## [1] 0.05208987chi_FG<--(n-1-(2*m+5)/6)*log(determinante_R)
print(chi_FG)## [1] 391.509# Valor critico
gl<-m*(m-1)/2
VC<-qchisq(0.05,gl,lower.tail = FALSE)
print(VC)## [1] 18.30704shadeDist(xshade = chi_FG,ddist = "dchisq",parm1 = gl,lower.tail = FALSE,sub=paste("VC:",VC,"FG:",chi_FG))
#Como chi_FG (391.509) ??? V.C(18.30704),Se rechaza Ho, por lo que se concluye que hay evidencia de colinealidad en los regresores.FG con mctest
library(mctest)
mctest(modelo_sueldo)##
## 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.9504 1
##
## 1 --> COLLINEARITY is detected by the test
## 0 --> COLLINEARITY is not detected by the testlibrary(psych)
library(fastGraph)
FG_test<-cortest.bartlett(Xmat[,-1])
print(FG_test)## $chisq
## [1] 391.509
##
## $p.value
## [1] 0.000000000000000000000000000000000000000000000000000000000000000000000000000006031952
##
## $df
## [1] 10VC_1<-qchisq(0.05,FG_test$df,lower.tail = FALSE)
shadeDist(xshade = FG_test$chisq,
ddist = "dchisq",
parm1 = FG_test$df,
lower.tail = FALSE,
sub=paste("VC:",VC_1,"FG:",FG_test$chisq))
VIF manual
VIF<-diag(solve(cor(Xmat[,-1])))
print(VIF)## LSAT GPA log(libvol) log(cost) rank
## 3.635214 3.369004 2.110801 1.573583 3.124106Calculo de VIF con libreria car
library(car)
VIF_car<-vif(modelo_sueldo)
print(VIF_car)## LSAT GPA log(libvol) log(cost) rank
## 3.635214 3.369004 2.110801 1.573583 3.124106VIF con libreria mctest
library(mctest)
mc.plot(modelo_sueldo,vif = 2)
# Conociendo el criterios VIF > 5 O VIF > 10 se consideran variables altamente colineales y teniendo un umbral de entre 2 y 5 siendo un valor aceptable en nuestro caso existen 4 variables que estan entre ese unbral y solo la variable log(cost) se encuentra por debajo de este, por lo que la colinealidad de las variables se acepta