Soluciones
PH17001-Patricia Lilibeth Portillo Hernandez
6/16/2020
PARTE TEORICA - RESPUESTAS
1. Para una tolerancia de 0.05 el VIF es de:
#Ya que VIF=1/1-R^2*(Tolerancia), entonces:
1/0.05## [1] 202. Sean 10,15,-10,-15,4,-4, los residuos de un modelo. El estadistico de prueba para el contraste de normalidad de JB es:
library(normtest)
matriz_residuos<-matrix(data = c(10,15, -10,
-15, 4, -4), nrow = 1, ncol = 6, byrow = TRUE)
print(matriz_residuos)## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 10 15 -10 -15 4 -4jb.norm.test(matriz_residuos)##
## Jarque-Bera test for normality
##
## data: matriz_residuos
## JB = 0.51072, p-value = 0.58853. Para un modelo con 2 regresores, la matriz de correlacion es
matriz_cor<-matrix(data = c(1,0.96, 0.96,
1), nrow = 2, ncol = 2, byrow = TRUE)
print(matriz_cor)## [,1] [,2]
## [1,] 1.00 0.96
## [2,] 0.96 1.00El VIF es de
#Ya que matricialmente los VIF, se obtienen de la diagonal principal de la inversa de la matriz de Correlacion
VIF<-diag(solve(matriz_cor))
print(VIF)## [1] 12.7551 12.75514. Si el VIF para una variable es de 2.5, el coeficiente de correlacion entre la variable y el resto de regresores es de
#VIF=1/1-R^2
#Para este caso, 2.5=1/1-R^2, por lo tanto R^2 es igual a:
1-1/2.5## [1] 0.65. Sean 10,15,-10,-15,4,-4, los residuos de un modelo. El estadistico de prueba para el contraste de normalidad de KS es:
library(nortest)
lillie.test(matriz_residuos)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: matriz_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 critico es:
gl<-4*(4-1)/2
VC<-qchisq(0.043,gl,lower.tail = TRUE)
print(VC)## [1] 1.5369857. Sean 10,15,-10,-15,4,-4, los residuos de un modelo. El estadistico de prueba para el contraste de normalidad de Shapiro-Wilk es:
shapiro.test(matriz_residuos)##
## Shapiro-Wilk normality test
##
## data: matriz_residuos
## W = 0.96164, p-value = 0.83238. Para un VIF=2.5, la tolerancia es de:
#VIF=1/1-R^2
#Por lo tanto:
1/2.5## [1] 0.49. Prueba robusta para evaluar la normalidad de los residuos, independientemente del tamaño muestral:
La prueba de Jarque Bera, ya que puede utilizarse con cualquier tamaño muestral e involucra la curtosis y la asimetria.
10. En una prueba FG, para un modelo con 5 regresores y 60 observaciones con un alfa de 4.5%, el estadistico de prueba dio 40, el valor del determinante de la matriz de correlacion del modelo es:
#Calculando el determinante
#chi_FG = -(n-1-(2*m+5)/6)*log(determinante)
#quedando: 40/-(59-1-(2*4+5)/6)=ln(determinante)
#Por lo tanto:
dt<- 40/-(59-1-(2*4+5)/6)
print(dt)## [1] -0.7164179determinante<-exp(dt)
print(determinante)## [1] 0.488499Modelo para trabajadores
library(stargazer)
load("C:/Users/Lilibeth Portillo/Downloads/wage2.RData")
#Corriendo el modelo de regresion
regresion<-lm(formula = educ~sibs+meduc+feduc,data = wage2)
stargazer(regresion, title = "Modelo Estimado", 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.
Prueba JB
library(normtest)
jb.norm.test(regresion$residuals)##
## Jarque-Bera test for normality
##
## data: regresion$residuals
## JB = 35.655, p-value = 5e-04Asumiendo que el nivel de significancia es de 0.05, ya que P-value < alfa, por lo que SE RECHAZA la hipotesis nula, es decir los residuos NO poseen una distribucion normal segun la prueba JB
Prueba de KS (Lilliefors)
library(nortest)
lillie.test(regresion$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: regresion$residuals
## D = 0.089992, p-value = 3.394e-15Asumiendo que el nivel de significancia es de 0.05, resulta que, al ser P-value < alfa SE RECHAZA la hipotesis nula, es decir que los residuos NO poseen una distribucion normal segun la prueba KS
Prueba Shapiro Wilk
shapiro.test(regresion$residuals)##
## Shapiro-Wilk normality test
##
## data: regresion$residuals
## W = 0.96692, p-value = 1.058e-11Calculando Wn
W<-0.96692
mew<-0.0038915*I(log(935))^3-0.083751*I(log(935))^2-0.31082*I(log(935))-1.5861
des<-exp(0.0030302*I(log(935))^2-0.083751*(log(935))-0.4803)
Wn<-(log(1-W)-mew)/des
print(Wn)## [1] 7.405738Asumiendo que el nivel de significancia es de 0.05, ya que p < alfa SE RECHAZA la hipotesis nula, es decir los residuos NO poseen una distribucion normal.
Pruebas de multicolinealidad
Indice de condicion
Calculo manual
# Xmat
Xmat<-model.matrix(regresion)
print(head(Xmat,n=6))## (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# 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# Sigmamatriz normalizada
Sn<-solve(diag(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.003454319# Xmat_norm
XXmat_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
lamdas<-eigen(XXmat_norm,symmetric = TRUE)$values
print(lamdas)## [1] 3.55762739 0.37556335 0.04172605 0.02508320# Indice de condicion
K<-sqrt(max(lamdas)/min(lamdas))
print(K)## [1] 11.90937Para este caso, κ(x) < 30 la MULTICOLINEALIDAD es LEVE, dado que el valor obtenido es de 11.90937
Indice de condicion con mctest
library(mctest)
source(file = "C:/Users/Lilibeth Portillo/Downloads/correccion_eigprop.R")
my_eigprop(mod = regresion)##
## Call:
## my_eigprop(mod = regresion)
##
## 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.50Ya que el valor obtenido es de 11.9094 en este modelo, la MULTICOLINEALIDAD es LEVE entre los regresores.
Prueba de Farrar-Glaubar
De forma manual
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] 358.3897#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))
Asumiendo que el nivel de signifancia es de 0.05, los resultados arrojados por esta prueba dieron 358.3897 > 7.814728, es decir que FG > VC, por lo que hay evidencia de multicolinealidad en los regresores.
FG con mctest
library(mctest)
mctest(regresion)##
## 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 testFG con Psych
library(psych)
library(fastGraph)
FG_test<-cortest.bartlett(Xmat[,-1])
print(FG_test)$chisq [1] 358.3897
$p.value [1] 2.27501e-77
$df [1] 3
VC_1<-qchisq(0.05,FG_test$df,lower.tail = FALSE)
#Graficando
shadeDist(xshade = FG_test$chisq, ddist = "dchisq", parm1 = FG_test$df, lower.tail = FALSE, sub=paste("VC:",VC_1,"FG:",FG_test$chisq))
Factores Inflacionarios de la Varianza (VIF)
VIF manual
VIF<-diag(solve(cor(Xmat[,-1])))
print(VIF)## sibs meduc feduc
## 1.098950 1.561254 1.506359VIF con library mctest
library(mctest)
mc.plot(regresion,vif = 2)
A un umbral de 2, no existe colinealidad entre ninguno de los parametros, por lo que no hay presencia de factores inflacionarios en las variancias en las variables que estan representando.
Modelo de recien graduados de la Facultad de economia
library(stargazer)
load("C:/Users/Lilibeth Portillo/Downloads/LAWSCH85.RData")
#Corriendo el modelo de regresion
regresion_lm<-lm(formula = lsalary~LSAT+GPA+llibvol+lcost+rank,data = LAWSCH85)
stargazer(regresion_lm, title = "Modelo Estimado", type = "html")| Dependent variable: | |
| lsalary | |
| LSAT | 0.005 |
| (0.004) | |
| GPA | 0.248*** |
| (0.090) | |
| llibvol | 0.095*** |
| (0.033) | |
| lcost | 0.038 |
| (0.032) | |
| rank | -0.003*** |
| (0.0003) | |
| Constant | 8.343*** |
| (0.533) | |
| Observations | 136 |
| R2 | 0.842 |
| Adjusted R2 | 0.836 |
| Residual Std. Error | 0.112 (df = 130) |
| F Statistic | 138.230*** (df = 5; 130) |
| Note: | p<0.1; p<0.05; p<0.01 |
Pruebas de Normalidad de los residuos.
Prueba JB
library(normtest)
jb.norm.test(regresion_lm$residuals)##
## Jarque-Bera test for normality
##
## data: regresion_lm$residuals
## JB = 0.36511, p-value = 0.804Asumiendo que el nivel de significancia es de 0.05, ya que P-value > alfa, por lo que NO se RECHAZA la hipotesis nula, es decir los residuos SI poseen una distribucion normal segun la prueba JB
Prueba de KS (Lilliefors)
library(nortest)
lillie.test(regresion_lm$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: regresion_lm$residuals
## D = 0.054571, p-value = 0.4123Asumiendo que el nivel de significancia es de 0.05, resulta que, al ser P-value > alfa por lo que NO se RECHAZA la hipotesis nula, es decir que los residuos SI poseen una distribucion normal segun la prueba KS
Prueba Shapiro Wilk
shapiro.test(regresion_lm$residuals)##
## Shapiro-Wilk normality test
##
## data: regresion_lm$residuals
## W = 0.99282, p-value = 0.7235Calculando Wn
W<-0.99282
mew<-0.0038915*I(log(156))^3-0.083751*I(log(156))^2-0.31082*I(log(156))-1.5861
des<-exp(0.0030302*I(log(156))^2-0.083751*(log(156))-0.4803)
Wn<-(log(1-W)-mew)/des
print(Wn)## [1] -0.3338294Asumiendo que el nivel de significancia es de 0.05, ya que p > alfa NO se RECHAZA la hipotesis nula, es decir los residuos SI poseen una distribucion normal.
Pruebas de multicolinealidad
Indice de condicion
Calculo manual
# Xmat
Xmat<-model.matrix(regresion_lm)
print(head(Xmat,n=6))## (Intercept) LSAT GPA llibvol lcost 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.049734 9.703206 34
## 4 1 157 3.20 5.796058 9.773721 49
## 5 1 162 3.38 5.805135 9.030017 95
## 6 1 161 3.40 5.739793 9.030017 98# XXmat
XXmat<-t(Xmat)%*%Xmat
print(XXmat)## (Intercept) LSAT GPA llibvol lcost rank
## (Intercept) 136.0000 21557.00 450.110 783.3715 1277.008 10847.00
## LSAT 21557.0000 3419799.00 71440.370 124336.7471 202521.842 1697437.00
## GPA 450.1100 71440.37 1494.950 2599.2641 4228.169 34980.46
## llibvol 783.3715 124336.75 2599.264 4536.4063 7362.770 60522.09
## lcost 1277.0080 202521.84 4228.169 7362.7705 12010.096 100735.74
## rank 10847.0000 1697437.00 34980.460 60522.0934 100735.740 1190245.00# Sigmamatriz normalizada
Sn<-solve(diag(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# Xmat_norm
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
lamdas<-eigen(XXmat_norm,symmetric = TRUE)$values
print(lamdas)## [1] 5.7351306262 0.2604004371 0.0020823558 0.0018442636 0.0003778106
## [6] 0.0001645068# Indice de condicion
K<-sqrt(max(lamdas)/min(lamdas))
print(K)## [1] 186.7153Para este caso, k(x) > 30, por lo que la MULTICOLINEALIDAD es SEVERA, dado que el valor obtenido es de 186.7153
Indice de condicion con mctest
library(mctest)
source(file = "C:/Users/Lilibeth Portillo/Downloads/correccion_eigprop.R")
my_eigprop(mod = regresion_lm)##
## Call:
## my_eigprop(mod = regresion_lm)
##
## Eigenvalues CI (Intercept) LSAT GPA llibvol lcost rank
## 1 5.7351 1.0000 0.0000 0.0000 0.0000 0.0001 0.0000 0.0021
## 2 0.2604 4.6930 0.0000 0.0000 0.0002 0.0004 0.0001 0.2884
## 3 0.0021 52.4800 0.0058 0.0030 0.0007 0.8411 0.1155 0.1357
## 4 0.0018 55.7648 0.0002 0.0010 0.3355 0.1095 0.1756 0.0161
## 5 0.0004 123.2068 0.4254 0.0588 0.4407 0.0423 0.6610 0.4700
## 6 0.0002 186.7153 0.5686 0.9371 0.2229 0.0066 0.0478 0.0877
##
## ===============================
## Row 6==> LSAT, proportion 0.937119 >= 0.50
## Row 3==> llibvol, proportion 0.841136 >= 0.50
## Row 5==> lcost, proportion 0.661004 >= 0.50Ya que el valor obtenido es de 186.7153 en este modelo, la MULTICOLINEALIDAD es SEVERA entre los regresores.
Prueba de Farrar-Glaubar
De forma manual
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] 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))
Asumiendo que el nivel de signifancia es de 0.05, los resultados arrojados por esta prueba dieron 391.5089 > 18.3070, es decir que FG > VC, por lo que hay evidencia de multicolinealidad en los regresores.
FG con mctest
library(mctest)
mctest(regresion_lm)##
## 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 testFG con Psych
library(psych)
library(fastGraph)
FG_test<-cortest.bartlett(Xmat[,-1])
print(FG_test)$chisq [1] 391.509
$p.value [1] 6.031929e-78
$df [1] 10
VC_1<-qchisq(0.05,FG_test$df,lower.tail = FALSE)
#Graficando
shadeDist(xshade = FG_test$chisq, ddist = "dchisq", parm1 = FG_test$df, lower.tail = FALSE, sub=paste("VC:",VC_1,"FG:",FG_test$chisq))
Factores Inflacionarios de la Varianza (VIF)
VIF manual
VIF<-diag(solve(cor(Xmat[,-1])))
print(VIF)## LSAT GPA llibvol lcost rank
## 3.635214 3.369004 2.110802 1.573583 3.124106VIF con library mctest
library(mctest)
mc.plot(regresion_lm,vif = 2)
A un umbral de 2, existe colinealidad 4 de los 5 parametros, por lo que hay presencia de factores inflacionarios en las variancias en dichas variables a las que estan representando.
Modelo ventas
Carga de Datos.
library(stargazer)
library(readxl)
ventas_empresa <- read_excel("C:/Users/Lilibeth Portillo/Downloads/ventas_empresa.xlsx")
#Corriendo el modelo de regresion
modelo_ventas<-lm(formula = V~C+P+M,data = ventas_empresa)
stargazer(modelo_ventas,title = " Regresion de modelo ventas ",type = "html",digits = 8)| Dependent variable: | |
| V | |
| C | 0.92256720*** |
| (0.22273310) | |
| P | 0.95017690*** |
| (0.15584520) | |
| M | 1.29778600*** |
| (0.43072950) | |
| Constant | 107.44350000*** |
| (18.05749000) | |
| Observations | 24 |
| R2 | 0.97981680 |
| Adjusted R2 | 0.97678940 |
| Residual Std. Error | 9.50557000 (df = 20) |
| F Statistic | 323.64150000*** (df = 3; 20) |
| Note: | p<0.1; p<0.05; p<0.01 |
Pruebas de Normalidad de los residuos.
Prueba JB
library(normtest)
jb.norm.test(modelo_ventas$residuals)##
## Jarque-Bera test for normality
##
## data: modelo_ventas$residuals
## JB = 1.4004, p-value = 0.281Asumiendo que el nivel de significancia es de 0.05, entonces, P>alfa NO se rechaza la Ho es decir los residuos poseen una distribucion normal.
Prueba de KS (Lilliefors)
library(nortest)
lillie.test(modelo_ventas$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: modelo_ventas$residuals
## D = 0.13659, p-value = 0.2935Asumiendo que el nivel de significancia es de 0.05, ya que P>alfa, NO se rechaza la Ho es decir los residuos poseen una distribucion normal
Prueba Shapiro Wilk
shapiro.test(modelo_ventas$residuals)##
## Shapiro-Wilk normality test
##
## data: modelo_ventas$residuals
## W = 0.95315, p-value = 0.3166Calculando Wn
W<-0.95315
mew<-0.0038915*I(log(24))^3-0.083751*I(log(24))^2-0.31082*I(log(24))-1.5861
des<-exp(0.0030302*I(log(24))^2-0.083751*(log(24))-0.4803)
Wn<-(log(1-W)-mew)/des
print(Wn)## [1] 0.4789041Asumiendo que el nivel de significancia es de 0.05, ya que Wn<VC, NO se rechaza Ho, es decir los residuos poseen una distribucion normal, a su vez, ya que p>alfa, NO se rechaza Ho es decir los residuos poseen una distribucion normal.
Pruebas de multicolinealidad
Calculo de Indice de Condicion
De forma manual
# Xmat
Xmat<-model.matrix(modelo_ventas)
print(head(Xmat,n=6))## (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# 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# Sigmamatriz normalizada
Sn<-solve(diag(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# Xmat_norm
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
lamdas<-eigen(XXmat_norm,symmetric = TRUE)$values
print(lamdas)## [1] 3.9869237681 0.0095007154 0.0027882470 0.0007872695# Indice de condicion
K<-sqrt(max(lamdas)/min(lamdas))
print(K)## [1] 71.16349Indice de condicion con mctest
library(mctest)
source(file = "C:/Users/Lilibeth Portillo/Downloads/correccion_eigprop.R")
my_eigprop(mod = modelo_ventas)##
## Call:
## my_eigprop(mod = modelo_ventas)
##
## Eigenvalues CI (Intercept) C P M
## 1 3.9869 1.0000 0.0007 0.0001 0.0003 0.0001
## 2 0.0095 20.4852 0.8776 0.0049 0.0877 0.0075
## 3 0.0028 37.8141 0.1183 0.1594 0.8478 0.0636
## 4 0.0008 71.1635 0.0034 0.8356 0.0642 0.9288
##
## ===============================
## Row 4==> C, proportion 0.835554 >= 0.50
## Row 3==> P, proportion 0.847805 >= 0.50
## Row 4==> M, proportion 0.928751 >= 0.50En el caso de que K(x)>30 la multicolinealidad es severa, dado que el valor obtenido es de 71.16349 en este modelo la colinealidad es fuerte entre los regresores
Prueba de Farrar-Glaubar
Prueba de FG
library(fastGraph)
m<-ncol(Xmat[,-1]) # cantidad de variables explicativas k-1
n<-nrow(Xmat)
determinante_R<- det(cor(Xmat[,-1])) # determinanre de la matriz de correlacion
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,"F
G:",chi_FG))
FG con mctest
library(mctest)
mctest(modelo_ventas)##
## Call:
## omcdiag(mod = mod, Inter = TRUE, detr = detr, red = red, conf = conf,
## theil = theil, cn = cn)
##
##
## Overall Multicollinearity Diagnostics
##
## MC Results detection
## Determinant |X'X|: 0.0346 0
## Farrar Chi-Square: 71.2080 1
## Red Indicator: 0.8711 1
## Sum of Lambda Inverse: 20.9196 1
## Theil's Method: 0.5430 1
## Condition Number: 105.2299 1
##
## 1 --> COLLINEARITY is detected by the test
## 0 --> COLLINEARITY is not detected by the testFG con Psych
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] 2.352605e-15
$df [1] 3
#Graficando
shadeDist(xshade = FG_test$chisq, ddist = "dchisq", parm1 = FG_test$df, lower.tail = FALSE, sub=paste("VC:",VC_1,"FG:",FG_test$chisq))
Asumiendo que el nivel de signifancia es de 0.05, ya que FG>VC, por lo tanto hay evidencia de multicolinealidad en los regresores, asi mismo debido a 0.000000000000002352605<0.05, es decir P<alfa, entonces si hay evidencia de multicolinealidad en los regresores
Factores Inflacionarios de la Varianza (VIF)
VIF manual
VIF<-diag(solve(cor(Xmat[,-1])))
print(VIF)## C P M
## 7.631451 3.838911 9.449210VIF con library mctest
library(mctest)
mc.plot(modelo_ventas,vif = 2,)
Para un umbral de 2, existe una alta colinealidad entre los gastos de comercializacion y los gastos de materia prima, por lo tanto, existen factores inflacionarios de la varianza en los parametros de las variables que estan representando.