Ejercicio 1.

Una institución no gubernamental (ONG) debe generar una línea base sobre la cual pueda verificar el desempeño de sus funciones de acuerdo a sus estatutos,para ello ha considerado crear un indicador, que debe sintetizar la información de 6 variables de interés para tal fin (X1, X2, X3, X4, X5, X6)

Se va a ponderar a cada experto por sus años de experiencia y los espertos 1 y 3 han asignado su ranking asumiendo que los pesos para el indicador, se obtendrán mediante ranking reciproco, por otro lado el experto 2 los asigno porponiendo que los pesos se obtengan a traves del ranking exponencial, saturando fuertemente los primeros lugares (sugiere un valor de p=4)

  • Obtenga los ponderadores para las bariables, a partir de las sugerencias de los expertos

Comenzamos haciendo la base para la jerarquía exponencial:

Jerarquía de Suma

library(magrittr)
library(kableExtra)
# Vector de Jerarquías
rj_Exp2 <- c(5, 6, 4, 1, 3, 2)
names(rj_Exp2) <- c("X1", "X2", "X3", "X4", "X5", "X6")

#Función para generar los pesos
ponderadores_subjetivos_ranking_suma <- function(vector_jerarquias){
  n <- length(vector_jerarquias)
  vector_pesos <- n-vector_jerarquias+1
  list(w_brutos = vector_pesos, 
       w_normalizados = vector_pesos/sum(vector_pesos))
}
#Aplicando la función:
pesos_ranking_suma_Exp2 <- ponderadores_subjetivos_ranking_suma(rj_Exp2)
#Pesos brutos
pesos_brutos_suma_Exp2 <- pesos_ranking_suma_Exp2$w_brutos
pesos_brutos_suma_Exp2 %>% head() %>% 
  kable(caption = "Pesos brutos - Método Ranking - Jerarquía de Suma - Experto 2", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")
Pesos brutos - Método Ranking - Jerarquía de Suma - Experto 2
x
X1 2
X2 1
X3 3
X4 6
X5 4
X6 5 
#Pesos normalizados
pesos_normalizados_Exp2 <- pesos_ranking_suma_Exp2$w_normalizados %>% round(digits = 3)
pesos_normalizados_Exp2 %>% head() %>% 
  kable(caption = "Pesos normalizados - Método Ranking - Jerarquía de Suma - Experto 2", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")
Pesos normalizados - Método Ranking - Jerarquía de Suma - Experto 2
x
X1 0.095
X2 0.048
X3 0.143
X4 0.286
X5 0.190
X6 0.238 
#Gráfico de los pesos normalizados
barplot(pesos_ranking_suma_Exp2$w_normalizados,
        main = "Ponderadores Ranking de Suma - Experto 2",
        ylim = c(0,0.9),col = "red")

Jerarquía Recíproca

Experto 1

library(magrittr)

#Vector de Jerarquías
rj_exp1 <- c(4, 3, 3, 1, 4, 5)
names(rj_exp1) <- c("X1", "X2", "X3", "X4", "X5", "X6")

#Función para generar los pesos
ponderadores_subjetivos_rank_reciproco_exp1 <- function(vector_jerarquias){
  vector_pesos_exp1 <- 1/vector_jerarquias
  list(w_brutos = vector_pesos_exp1,
       w_normalizados = vector_pesos_exp1/sum(vector_pesos_exp1))
}
#Aplicando la función:
pesos_ranking_reciproco_exp1 <- ponderadores_subjetivos_rank_reciproco_exp1(rj_exp1)
#Pesos brutos
pesos_brutos_reciproco_exp1 <- pesos_ranking_reciproco_exp1$w_brutos
pesos_brutos_reciproco_exp1 %>% head() %>% 
  kable(caption = "Pesos brutos - Método Ranking - Jerarquía Recíproca - Experto 1", 
        align = "c", 
        digits = 3) %>%
  kable_material(html_font = "sans-serif")
Pesos brutos - Método Ranking - Jerarquía Recíproca - Experto 1
x
X1 0.250
X2 0.333
X3 0.333
X4 1.000
X5 0.250
X6 0.200 
library(magrittr)
library(kableExtra)
#Pesos normalizados
pesos_normalizados_reciproco_exp1 <- pesos_ranking_reciproco_exp1$w_normalizados %>% round(digits = 3)
pesos_normalizados_reciproco_exp1 %>% head() %>% 
  kable(caption = "Pesos normalizado - Método Ranking - Jerarquía Recíproca - Experto 1", 
        align = "c", 
        digits = 3) %>%
  kable_material(html_font = "sans-serif")
Pesos normalizado - Método Ranking - Jerarquía Recíproca - Experto 1
x
X1 0.106
X2 0.141
X3 0.141
X4 0.423
X5 0.106
X6 0.085 
library(magrittr)
#Gráfico de los pesos normalizados
barplot(pesos_ranking_reciproco_exp1$w_normalizados,
        main = "Ponderadores Ranking Recíproco, Experto 1",
        ylim = c(0,0.6),col = "orange")

Experto 3

library(magrittr)
library(kableExtra)
#Vector de Jerarquías
rj_exp3 <- c(4, 4, 2, 1, 2, 3)
names(rj_exp3) <- c("X1", "X2", "X3", "X4", "X5", "X6")

#Función para generar los pesos
ponderadores_subjetivos_rank_reciproco_exp3 <- function(vector_jerarquias){
  vector_pesos_exp3 <- 1/vector_jerarquias
  list(w_brutos = vector_pesos_exp3,
       w_normalizados = vector_pesos_exp3/sum(vector_pesos_exp3))
}
#Aplicando la función:
pesos_ranking_reciproco_exp3 <- ponderadores_subjetivos_rank_reciproco_exp3(rj_exp3)
#Pesos brutos
pesos_brutos_reciproco_exp3 <- pesos_ranking_reciproco_exp3$w_brutos
pesos_brutos_reciproco_exp3 %>% head() %>% 
  kable(caption = "Pesos brutos - Método Ranking - Jerarquía Recíproca - Experto 3", 
        align = "c", 
        digits = 3) %>%
  kable_material(html_font = "sans-serif")
Pesos brutos - Método Ranking - Jerarquía Recíproca - Experto 3
x
X1 0.250
X2 0.250
X3 0.500
X4 1.000
X5 0.500
X6 0.333 
library(magrittr)
#Pesos normalizados
pesos_normalizados_reciproco_exp3 <- pesos_ranking_reciproco_exp3$w_normalizados %>% round(digits = 3)
pesos_normalizados_reciproco_exp3 %>% head() %>% 
  kable(caption = "Pesos normalizado - Método Ranking - Jerarquía Recíproca - Experto 3", 
        align = "c", 
        digits = 3) %>%
  kable_material(html_font = "sans-serif")
Pesos normalizado - Método Ranking - Jerarquía Recíproca - Experto 3
x
X1 0.088
X2 0.088
X3 0.176
X4 0.353
X5 0.176
X6 0.118 
library(magrittr)
#Gráfico de los pesos normalizados
barplot(pesos_ranking_reciproco_exp3$w_normalizados,
        main = "Ponderadores Ranking Recíproco, Experto 3",
        ylim = c(0,0.6),col = "pink")

Experto 2

library(magrittr)
library(kableExtra)
#Vector de Jerarquías
rj_exp2 <- c(5, 6, 4, 1, 3, 2)
names(rj_exp2) <- c("X1", "X2", "X3", "X4", "X5", "X6")

#Función para generar los pesos
ponderadores_subjetivos_ranking_exponencial_exp2 <- function(vector_jerarquias,p=4){
  n <- length(vector_jerarquias)
  vector_pesos_exp2 <- (n-vector_jerarquias+1)^p
  list(w_brutos = vector_pesos_exp2,
       w_normalizados = vector_pesos_exp2/sum(vector_pesos_exp2))
}
#Aplicando la función:
pesos_ranking_exponencial_exp2<-ponderadores_subjetivos_ranking_exponencial_exp2(rj_exp2)
#Pesos brutos
pesos_brutos_exponencial_exp2 <- pesos_ranking_exponencial_exp2$w_brutos
pesos_brutos_exponencial_exp2 %>% head() %>% 
  kable(caption = "Pesos brutos - Método Ranking - Jerarquía Exponencial - Experto 2", 
        align = "c") %>%
  kable_material(html_font = "sans-serif")
Pesos brutos - Método Ranking - Jerarquía Exponencial - Experto 2
x
X1 16
X2 1
X3 81
X4 1296
X5 256
X6 625 
#Pesos normalizados
pesos_normalizados_exponencial_exp2 <- pesos_ranking_exponencial_exp2$w_normalizados %>% round(digits = 3)
pesos_normalizados_exponencial_exp2 %>% head() %>% 
  kable(caption = "Pesos normalizados - Método Ranking - Jerarquía Exponencial - Experto 2", 
        align = "c",
        digits = 3) %>%
  kable_material(html_font = "sans-serif")
Pesos normalizados - Método Ranking - Jerarquía Exponencial - Experto 2
x
X1 0.007
X2 0.000
X3 0.036
X4 0.570
X5 0.113
X6 0.275 
#Gráfico de los pesos normalizados (por default p=2)
barplot(pesos_ranking_suma_Exp2$w_normalizados,
        main = "Ponderadores Ranking Exponencial, Experto 2",
        ylim = c(0,1),col = "blue")

#Comparación de valores de "p"

par(mfrow=c(1,3))
for(p in 2:4){
  
  pesos_exp2 <- ponderadores_subjetivos_ranking_exponencial_exp2(vector_jerarquias = rj_exp2,
                                                    p = p)
  barplot(pesos_exp2$w_normalizados,
          main = paste0("p=",p),
          ylim = c(0,1.2),
          col = "purple",
          cex.main=3,
          cex.axis = 3)
}

A medida que se aumenta el valor de “p”, se saturan más aquellas variables que tienen mayor importancia, pero se extrae el peso del resto de variables. Siendo las variables X4 y X6 las más saturadas.

Ejercicio 2.

Una empresa especializada en el diseño de automóviles de turismo desea estudiar cuáles son los deseos del público que compra automóviles. Para ello diseña una encuesta con 10 preguntas donde se le pide a cada uno de los 20 encuestados que valore de 1 a 5 si una característica es a no muy importante. Los encuestados deberán contestar con un 5 si la característica es muy importante, un 4 si es importante, un 3 si tiene regular importancia, un 2 si es poco importante y 1 si no es nada importante. Las 10 características (V1 a V10) a valorar son: precio, financiación, consumo, combustible, seguridad, confort, capacidad, prestaciones, modernidad y aerodinámica. El fichero 6-2.RData recoge los datos a ser utilizados.

Realiza un análisis factorial que permita extraer unos factores adecuados a los datos que resuman correctamente la información que contienen. Proponga una solución adecuada de la cantidad de factores a retener y justifique su respuesta, sobre la base de las pruebas de validación del Análisis factorial, estudiadas en clase e indique las variables que se agruparían en cada factor.

Importación de los datos

load("/cloud/project/6-2.RData")

Matriz de Información

library(kableExtra)
mat_X<-X6_2
mat_X1<-mat_X[,c(-1,-2)]
mat_X1 %>% head() %>% 
  kable(caption ="Matriz de información:" ,align = "c",digits = 6) %>% 
  kable_material(html_font = "sans-serif")
Matriz de información:
V3 V4 V5 V6 V7 V8 V9 V10
4 3 3 2 4 4 4 4
4 4 3 3 4 1 1 3
3 1 4 2 1 5 4 5
1 1 4 4 2 5 5 4
2 1 5 5 4 3 3 2
5 5 3 3 4 2 2 1

Cálculo de V(X)

library(dplyr)
library(kableExtra)
cov(mat_X1) %>% 
  kable(caption="Cálculo de V(X) para el diseño de automoviles de turismo",
        align = "c",
        digits = 3) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
Cálculo de V(X) para el diseño de automoviles de turismo
V3 V4 V5 V6 V7 V8 V9 V10
V3 1.421 1.526 -0.526 -0.316 0.289 -0.921 -1.105 -0.868
V4 1.526 2.484 -0.800 -0.484 0.347 -1.611 -1.832 -1.389
V5 -0.526 -0.800 0.853 0.800 0.205 0.374 0.463 0.153
V6 -0.316 -0.484 0.800 1.379 0.626 0.216 0.095 -0.374
V7 0.289 0.347 0.205 0.626 1.608 -0.529 -0.337 -0.708
V8 -0.921 -1.611 0.374 0.216 -0.529 1.924 1.811 1.366
V9 -1.105 -1.832 0.463 0.095 -0.337 1.811 2.168 1.558
V10 -0.868 -1.389 0.153 -0.374 -0.708 1.366 1.558 1.818

Cálculo de R(X)

library(dplyr)
library(kableExtra)
cor(mat_X1) %>% 
  kable(caption="Cálculo de R(X) para el diseño de automoviles de turismo",
        align = "c",
        digits = 3) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
Cálculo de R(X) para el diseño de automoviles de turismo
V3 V4 V5 V6 V7 V8 V9 V10
V3 1.000 0.812 -0.478 -0.226 0.192 -0.557 -0.630 -0.540
V4 0.812 1.000 -0.550 -0.262 0.174 -0.737 -0.789 -0.654
V5 -0.478 -0.550 1.000 0.738 0.175 0.292 0.341 0.123
V6 -0.226 -0.262 0.738 1.000 0.421 0.132 0.055 -0.236
V7 0.192 0.174 0.175 0.421 1.000 -0.301 -0.180 -0.414
V8 -0.557 -0.737 0.292 0.132 -0.301 1.000 0.886 0.730
V9 -0.630 -0.789 0.341 0.055 -0.180 0.886 1.000 0.785
V10 -0.540 -0.654 0.123 -0.236 -0.414 0.730 0.785 1.000

**Matriz de Correlación & Pruebas de Barlett y KMO

#Matriz de correlación
library(PerformanceAnalytics)
chart.Correlation(as.matrix(mat_X1),histogram = TRUE,pch=12)

Existe una clara correlación entre las variables propuestas en la batería de indicadores, esto es gracias a los asteriscos representativos en el histograma. Las diversas correlaciones son significativas a más del 1%. Aún así se mantienen correlaciones que no son significativas a más del 1%.

#Prueba de Barlett
library(psych)
options(scipen = 99999)
Barlett<-cortest.bartlett(mat_X1)
print(Barlett)
## $chisq
## [1] 108.6792
## 
## $p.value
## [1] 0.00000000001898822
## 
## $df
## [1] 28

El P-value está más cerca de 0, eso quiere decir que se rechaza la hipótesis nula, por lo tanto no se rechaza la hipótesis alternativa, con ello hay evidencia de correlación poblacional entre la batería de indicadores propuestas.

#KMO
library(psych)
KMO<-KMO(mat_X1)
print(KMO)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = mat_X1)
## Overall MSA =  0.7
## MSA for each item = 
##   V3   V4   V5   V6   V7   V8   V9  V10 
## 0.82 0.85 0.61 0.42 0.45 0.66 0.71 0.88

El valor mínimo de KMO se considera adecuado para el análisis factorial si es de 0.5, de lo contrario no; y la base de datos tiene un KMO de 0.7, por lo tanto es apropiado continuar con el análisis.

Extracción de los componentes

Extracción Manual

library(kableExtra)
library(dplyr)
library(Hmisc)
Rx_2<-mat_X1 %>% as.matrix() %>% rcorr()
Rx_2$r %>% kable(caption="Matriz R(X)",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
Matriz R(X)
V3 V4 V5 V6 V7 V8 V9 V10
V3 1.00 0.81 -0.48 -0.23 0.19 -0.56 -0.63 -0.54
V4 0.81 1.00 -0.55 -0.26 0.17 -0.74 -0.79 -0.65
V5 -0.48 -0.55 1.00 0.74 0.18 0.29 0.34 0.12
V6 -0.23 -0.26 0.74 1.00 0.42 0.13 0.05 -0.24
V7 0.19 0.17 0.18 0.42 1.00 -0.30 -0.18 -0.41
V8 -0.56 -0.74 0.29 0.13 -0.30 1.00 0.89 0.73
V9 -0.63 -0.79 0.34 0.05 -0.18 0.89 1.00 0.78
V10 -0.54 -0.65 0.12 -0.24 -0.41 0.73 0.78 1.00 
Rx_2$P %>% kable(caption="p-values de R(X)",
        align = "c",
        digits = 2) %>% 
  kable_classic_2(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
p-values de R(X)
V3 V4 V5 V6 V7 V8 V9 V10
V3 NA 0.00 0.03 0.34 0.42 0.01 0.00 0.01
V4 0.00 NA 0.01 0.27 0.46 0.00 0.00 0.00
V5 0.03 0.01 NA 0.00 0.46 0.21 0.14 0.61
V6 0.34 0.27 0.00 NA 0.06 0.58 0.82 0.32
V7 0.42 0.46 0.46 0.06 NA 0.20 0.45 0.07
V8 0.01 0.00 0.21 0.58 0.20 NA 0.00 0.00
V9 0.00 0.00 0.14 0.82 0.45 0.00 NA 0.00
V10 0.01 0.00 0.61 0.32 0.07 0.00 0.00 NA

Descomposición de los autovalores y autovectores

library(stargazer)
descomposicion_2<-eigen(Rx_2$r)
t(descomposicion_2$values) %>% kable(caption="Autovalores de R(X)",
        align = "c",
        digits = 2) %>% 
  kable_classic_2(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
Autovalores de R(X)
4.18 2.06 0.67 0.47 0.28 0.16 0.13 0.06 
descomposicion_2$vectors %>% kable(caption="Autovectores de R(X)",
        align = "c",
        digits = 2) %>% 
  kable_classic_2(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
Autovectores de R(X)
-0.40 0.08 -0.26 0.67 -0.32 -0.24 0.38 -0.09
-0.45 0.08 -0.05 0.24 -0.06 0.38 -0.76 0.03
0.26 -0.51 0.30 0.13 -0.61 -0.27 -0.26 0.25
0.10 -0.63 0.13 0.35 0.29 0.47 0.17 -0.35
-0.14 -0.47 -0.78 -0.33 -0.06 0.04 0.01 0.19
0.43 0.10 -0.22 0.48 0.39 -0.01 -0.09 0.61
0.45 0.09 -0.36 0.13 0.01 -0.32 -0.38 -0.64
0.39 0.31 -0.18 0.00 -0.54 0.64 0.17 -0.01

Extracción por R

library(dplyr)
library(factoextra)
library(kableExtra)
library(stargazer)
library(ggplot2)
options(scipen = 99999)
PC_2<-princomp(x = mat_X1,cor = TRUE,fix_sign = FALSE)
factoextra::get_eig(PC_2) %>% kable(caption="Resumen de PCA",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("hover"))
Resumen de PCA
eigenvalue variance.percent cumulative.variance.percent
Dim.1 4.18 52.23 52.23
Dim.2 2.06 25.70 77.93
Dim.3 0.67 8.43 86.36
Dim.4 0.47 5.87 92.23
Dim.5 0.28 3.47 95.71
Dim.6 0.16 1.97 97.68
Dim.7 0.13 1.57 99.25
Dim.8 0.06 0.75 100.00

Al observar la tabla se puede determinar la cantidad de factores a retener:

Por el criterio de raíz promedio/latente (donde eigen>1): Se tendrían 2 componentes (Dim 1 y Dim 2).

Por el criterio de porcentaje de varianzas explicadas (corresponde al 75% de varianza): Se tendrían tres componentes, (Dim 1, Dim 2 y Dim 3) ya que estas 3 variables son superior a 3/4 partes de la varianza total.

Gráfico de Sedimentación con Autovalores

fviz_eig(PC_2,
         choice = "eigenvalue",
         barcolor = "pink",
         barfill = "pink",
         addlabels = TRUE, 
       )+labs(title = "Gráfico de Sedimentación",subtitle = "Usando princomp, con Autovalores")+
  xlab(label = "Componentes")+
  ylab(label = "Autovalores")+geom_hline(yintercept = 1)

Por medio de este criterio se puede observar que el punto de inflexión ocurre en las primeras tres variables. Los criterios de extracción se mantienen entre 2 y 3 factores.

Gráfico de Sedimentación con %Varianza Explicada

fviz_eig(PC_2,
         choice = "variance",
         barcolor = "orange",
         barfill = "orange",
         addlabels = TRUE,
       )+labs(title = "Gráfico de Sedimentación",
              subtitle = "Usando princomp, con %Varianza Explicada")+
  xlab(label = "Componentes")+
  ylab(label = "%Varianza")

Correlación de los componentes con las variables

library(dplyr)
library(factoextra)
library(kableExtra)
variables_pca_2<-get_pca_var(PC_2)
variables_pca_2$coord%>% 
  kable(caption="Correlación de X con las componentes, para el dieseño de los autimoviles de turismo",
        align = "c",
        digits = 3) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))
Correlación de X con las componentes, para el dieseño de los autimoviles de turismo
Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7 Dim.8
V3 -0.819 0.116 -0.217 0.461 -0.170 -0.094 -0.134 -0.022
V4 -0.928 0.117 -0.039 0.164 -0.031 0.152 0.270 0.008
V5 0.527 -0.727 0.246 0.089 -0.319 -0.105 0.093 0.061
V6 0.213 -0.904 0.107 0.239 0.152 0.187 -0.061 -0.085
V7 -0.282 -0.674 -0.641 -0.226 -0.034 0.015 -0.003 0.046
V8 0.880 0.142 -0.183 0.326 0.205 -0.004 0.033 0.149
V9 0.912 0.123 -0.296 0.091 0.005 -0.125 0.134 -0.156
V10 0.799 0.440 -0.146 -0.003 -0.282 0.253 -0.060 -0.002

Representación Gráfica de la correlación de los componentes

library(corrplot)
corrplot(variables_pca_2$coord,is.corr = FALSE,method = "square",addCoef.col="black",number.cex = 0.75)

Análisis Factorial

Modelo de 2 factores con rotación

library(psych)
library(corrplot)
library(dplyr)
#Modelo de 2 Factores (Rotado)
numero_de_factores_2<-3
modelo_3_factores_2<-principal(r = Rx_2$r,
                             nfactors = numero_de_factores_2,
                             covar = FALSE,
                             rotate = "varimax")
print(modelo_3_factores_2)
## Principal Components Analysis
## Call: principal(r = Rx_2$r, nfactors = numero_de_factores_2, rotate = "varimax", 
##     covar = FALSE)
## Standardized loadings (pattern matrix) based upon correlation matrix
##       RC1   RC2   RC3   h2    u2 com
## V3  -0.65 -0.48  0.29 0.73 0.268 2.3
## V4  -0.81 -0.45  0.16 0.88 0.123 1.6
## V5   0.24  0.90  0.04 0.87 0.134 1.1
## V6  -0.04  0.88  0.31 0.87 0.126 1.2
## V7  -0.19  0.21  0.93 0.95 0.055 1.2
## V8   0.90  0.12 -0.09 0.83 0.171 1.1
## V9   0.96  0.10  0.01 0.93 0.066 1.0
## V10  0.88 -0.15 -0.25 0.85 0.147 1.2
## 
##                        RC1  RC2  RC3
## SS loadings           3.66 2.10 1.14
## Proportion Var        0.46 0.26 0.14
## Cumulative Var        0.46 0.72 0.86
## Proportion Explained  0.53 0.30 0.17
## Cumulative Proportion 0.53 0.83 1.00
## 
## Mean item complexity =  1.4
## Test of the hypothesis that 3 components are sufficient.
## 
## The root mean square of the residuals (RMSR) is  0.05 
## 
## Fit based upon off diagonal values = 0.99

Al hacerlo con un modelo de 3 factores, la tercer variable el 0.73% de su varianza explicada por la solución. La cuarta variable el 0.87% de su varianza explicada por la extracción. Por último, la quinta variable, el 0.86% de su varianza es explicada. Por lo tanto, es una solución representativa de los datos originales.

correlaciones_modelo_2<-variables_pca_2$coord
correlaciones_modelo_rotada_2<-varimax(correlaciones_modelo_2[,1:numero_de_factores_2])$loadings

corrplot(correlaciones_modelo_rotada_2[,1:numero_de_factores_2],
         is.corr = FALSE,
         method = "square",
         addCoef.col="black",
         number.cex = 0.75)

  • La Dimensión 1, está explicada por las variables V1 y V2
  • La Dimensión 2, está explicada por las variables V5 y V6
  • La Dimensión 3, está explicada por la variable V7

Verificación de Supuestos: Prueba de Barlett y KMO

library(psych)
options(scipen = 99999)
Barlett_2<-cortest.bartlett(mat_X1)
print(Barlett_2)
## $chisq
## [1] 108.6792
## 
## $p.value
## [1] 0.00000000001898822
## 
## $df
## [1] 28

El P-value está más cerca de 0, eso quiere decir que se rechaza la hipótesis nula, por lo tanto no se rechaza la hipótesis alternativa, con ello hay evidencia de correlación poblacional entre la batería de indicadores propuestas.

library(rela)
KMO<-paf(as.matrix(mat_X1))$KMO
print(KMO)
## [1] 0.69892

El valor mínimo de KMO se considera adecuado para el análisis factorial si es de 0.5, de lo contrario no; y la base de datos tiene un KMO de 0.69, por lo tanto es apropiado continuar con el análisis.