Practica_Unidad_2_MAE

Exámen Clave A

Se necesita construir un indicador multivariado sintético, que mida la “Seguridad Municipal” Para ello se dispone de la siguiente información:

	Variable	Correlación con la variable compleja
X1	% de Negocios victimizados durante el año por - robo o hurto	Positiva
X2	% de Negocios victimizados durante el año - extorsión o secuestro	Positiva
X3	% de Negocios que consideran que el crimen fue mayor en el año actual comparado con el año anterior	Positiva
X4	% de Negocios que consideran que el crimen local es mayor que en los municipios vecinos	Negativa
X5	Erogaciones municipales per cápita en seguridad pública (US$)	Positiva
X6	Costo del crimen a negocios por cada US$1,000 de ventas durante el año previo	Negativa
X7	% de Negocios que califican a la municipalidad como buena en prevención y control del delito	Positiva
X8	% de Negocios que consideran que la calidad del alumbrado público es adecuada para la seguridad de los negocios en el municipio	Positiva

Ejercicio 1.

A través del análisis de componentes principales, identifique para un modelo de 3 factores:

a. Los ponderadores normalizados para cada factor.

Importación de los datos

load("/cloud/project/data_parcial_2_A_rev.RData")

Matriz de Información

library(kableExtra)
mat_X<-datos_parcial_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:
X1	X2	X3	X4	X5	X6	X7	X8
9	2	20.00000	20.00000	0.00000	0.000000	2	56.4000
10	6	62.50000	50.00000	37.50000	3.947368	11	147.3750
10	20	50.00000	50.00000	50.00000	2.564103	16	135.0000
8	3	42.85714	42.85714	14.28571	1.351351	35	121.1429
7	7	75.00000	75.00000	75.00000	9.090909	8	202.5000
6	13	30.00000	30.00000	30.00000	8.108108	25	81.0000

Normalización de los datos

library(dplyr)
norm_directa<-function(x){(x-min(x))/(max(x)-min(x))}
norm_inversa<-function(x){(max(x)-x)/(max(x)-min(x))}
#Seleccionando las variables con correlación positiva para la Seguridad Municipal
mat_X1 %>% 
  select(X1,X2,X3,X5,X7,X8) %>% 
  apply(MARGIN = 2,FUN = norm_directa) %>% as.data.frame()->variables_corr_positiva
#Seleccionando las variables con correlación negativa para la Seguridad Municipal
mat_X1 %>% 
  select(X4,X6) %>% 
  apply(MARGIN = 2,FUN = norm_inversa) %>% as.data.frame()->variables_corr_negativa
#Juntando y reordenando las variables
variables_corr_positiva %>% 
  bind_cols(variables_corr_negativa) %>% 
  select(X1,X2,X3,X4,X5,X6,X7,X8)->datos_seguridad_municipal_normalizados
head(datos_seguridad_municipal_normalizados)%>% 
  kable(caption ="Datos Normalizados:",
        align = "c",
        digits = 6) %>% 
  kable_material(html_font = "sans-serif")

Datos Normalizados:
X1	X2	X3	X4	X5	X6	X7	X8
0.193548	0.000000	0.040000	0.800000	0.000000	1.000000	0.000000	0.158227
0.225806	0.017167	0.550000	0.500000	0.428571	0.784413	0.098901	0.516749
0.225806	0.077253	0.400000	0.500000	0.571429	0.859961	0.153846	0.467980
0.161290	0.004292	0.314286	0.571429	0.163265	0.926195	0.362637	0.413371
0.129032	0.021459	0.700000	0.250000	0.857143	0.503497	0.065934	0.733990
0.096774	0.047210	0.160000	0.700000	0.342857	0.557173	0.252747	0.255172

Matriz de Correlación & Pruebas de Barlett y KMO

#Matriz de correlación
library(PerformanceAnalytics)
chart.Correlation(as.matrix(datos_seguridad_municipal_normalizados),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%.

#Prueba de Barlett
library(psych)
options(scipen = 99999)
Barlett<-cortest.bartlett(datos_seguridad_municipal_normalizados)
print(Barlett)

## $chisq
## [1] 1025.923
## 
## $p.value
## [1] 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004695093
## 
## $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.68
## MSA for each item = 
##   X1   X2   X3   X4   X5   X6   X7   X8 
## 0.75 0.62 0.69 0.64 0.80 0.76 0.66 0.61

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.68, por lo tanto es apropiado continuar con el análisis.

Análisis Factorial

library(FactoMineR)
library(factoextra)
library(kableExtra)

Rx<-cor(datos_seguridad_municipal_normalizados)
PC<-princomp(x = datos_seguridad_municipal_normalizados,cor = TRUE,fix_sign = FALSE)
variables_pca<-get_pca_var(PC)
factoextra::get_eig(PC) %>% 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	3.90	48.72	48.72
Dim.2	1.96	24.55	73.27
Dim.3	0.84	10.52	83.78
Dim.4	0.50	6.24	90.03
Dim.5	0.45	5.68	95.70
Dim.6	0.28	3.45	99.16
Dim.7	0.07	0.82	99.98
Dim.8	0.00	0.02	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

fviz_eig(PC,
         choice = "eigenvalue",
         barcolor = "red",
         barfill = "red",
         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 dos variables. Los criterios de extracción se mantienen entre 2 y 3 factores.

Utilizando Corrplot en un modelo de 3 factores con rotación

library(corrplot)
#Modelo de 3 Factores (Rotada)
numero_de_factores_A<-3
modelo_3_factores_A<-principal(r = Rx,
                             nfactors = numero_de_factores_A,
                             covar = FALSE,
                             rotate = "varimax")
print(modelo_3_factores_A)

## Principal Components Analysis
## Call: principal(r = Rx, nfactors = numero_de_factores_A, rotate = "varimax", 
##     covar = FALSE)
## Standardized loadings (pattern matrix) based upon correlation matrix
##      RC1   RC2   RC3   h2     u2 com
## X1 -0.16  0.80 -0.03 0.67 0.3316 1.1
## X2  0.08  0.84 -0.03 0.71 0.2879 1.0
## X3  0.93 -0.09  0.28 0.95 0.0493 1.2
## X4 -0.95  0.05 -0.26 0.98 0.0208 1.2
## X5  0.43 -0.06  0.80 0.83 0.1742 1.5
## X6 -0.25  0.03 -0.91 0.89 0.1142 1.2
## X7 -0.07  0.83 -0.04 0.69 0.3107 1.0
## X8  0.96 -0.06  0.27 0.99 0.0087 1.2
## 
##                        RC1  RC2  RC3
## SS loadings           2.97 2.05 1.68
## Proportion Var        0.37 0.26 0.21
## Cumulative Var        0.37 0.63 0.84
## Proportion Explained  0.44 0.31 0.25
## Cumulative Proportion 0.44 0.75 1.00
## 
## Mean item complexity =  1.2
## Test of the hypothesis that 3 components are sufficient.
## 
## The root mean square of the residuals (RMSR) is  0.06 
## 
## Fit based upon off diagonal values = 0.98

Al hacerlo con un modelo de 3 factores, la primer variable el 0.67% de su varianza explicada por la solución. La segunda variable el 0.71% de su varianza explicada por la extracción. Por último, la tercer variable, el 0.95% de su varianza es explicada. Por lo tanto, es una solución representativa de los datos originales.

En los ponderadores que se han extraído, la primera variable que se construya va a tener un ponderador de 0.44, la segunda tendrá un ponderador de 0.31 y por lo cual, la tercera de 0.25.

b. Las variables incluidas en cada factor.

library(factoextra)

correlaciones_modelo_A<- variables_pca$coord
rotacion_a <- varimax(correlaciones_modelo_A[,1:numero_de_factores_A])
correlaciones_modelo_rotada_A <- rotacion_a$loadings

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

La Dimensión 1, está explicada por X3, X4 y X8.
La Dimensión 2, está explicada por X1, X2 y X7.
La Dimensión 3, está explicada por X5, X6.

library(kableExtra)
cargas<-rotacion_a$loadings[1:8,1:numero_de_factores_A]
ponderadores_extraidos<-prop.table(apply(cargas^2,MARGIN = 2,sum))
t(ponderadores_extraidos) %>% kable(caption="Ponderadores de los Factores Extraídos",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

Ponderadores de los Factores Extraídos
Dim.1	Dim.2	Dim.3
0.44	0.31	0.25

Para el factor 1 se le debe asignar un peso del 44%, al factor 2 un peso del 31% y al factor 3 un 25%.

contribuciones_A<- apply(cargas^2,
                          MARGIN = 2,
                          prop.table)
contribuciones_A %>% kable(caption = "Contribución de las variables en los Factores",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

Contribución de las variables en los Factores
	Dim.1	Dim.2	Dim.3
X1	0.01	0.31	0.00
X2	0.00	0.34	0.00
X3	0.29	0.00	0.05
X4	0.31	0.00	0.04
X5	0.06	0.00	0.38
X6	0.02	0.00	0.49
X7	0.00	0.33	0.00
X8	0.31	0.00	0.04

Ejercicio 2.

Para el factor 1, utilice el método CRITIC para obtener los ponderadores normalizados para cada variable.

Normalización de datos y realización de cálculos:

library(dplyr)
#Funciones para normalizar los datos
norm_directa_A <- function(x){
  return((x-min(x)) / (max(x)-min(x)))
}

norm_inverza_A <- function(x){
  return((max(x)-x) / (max(x)-min(x)))
}

#Normalización de los datos
datos_parcial_2 %>% dplyr::select(X3,X4,X8) %>% 
  dplyr::transmute(X3 = norm_directa_A(X3),
                   X4 = norm_inverza_A(X4), 
                   X8 = norm_directa_A(X8)) -> data_factor_1A
data_factor_1A %>% head() %>% 
  kable(caption = "Datos normalizados, método CRITIC", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Datos normalizados, método CRITIC
X3	X4	X8
0.040000	0.800000	0.158227
0.550000	0.500000	0.516749
0.400000	0.500000	0.467980
0.314286	0.571429	0.413371
0.700000	0.250000	0.733990
0.160000	0.700000	0.255172

#Cálculo de las desviaciones estándar de cada variable
data_factor_1A %>% dplyr::summarise(S3 = sd(X3),
                                     S4 = sd(X4),
                                     S8 = sd(X8)) -> sd_vectorA
sd_vectorA %>% head() %>% 
  kable(caption = "Desviaciones estándar, método CRITIC", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Desviaciones estándar, método CRITIC
S3	S4	S8
0.246279	0.201113	0.208742

#Cálculo de la matriz de correlación
cor(data_factor_1A) -> mat_R_F1A
mat_R_F1A %>% head() %>%
  kable(caption = "Matriz de correlación, método CRITIC", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Matriz de correlación, método CRITIC
	X3	X4	X8
X3	1.000000	-0.938716	0.959045
X4	-0.938716	1.000000	-0.995848
X8	0.959045	-0.995848	1.000000

#Cálculo de los ponderadores brutos
1-mat_R_F1A -> sum_data_A
colSums(sum_data_A) -> sum_vectorA
sd_vectorA*sum_vectorA -> vj_A
vj_A %>% head() %>% 
  kable(caption = "Ponderadores brutos, método CRITIC", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Ponderadores brutos, método CRITIC
S3	S4	S8
0.487552	0.79129	0.425166

#Cálculo de los ponderadores netos
vj_A/sum(vj_A) -> wj_A
wj_A %>% head() %>% 
  kable(caption = "Ponderadores netos, método CRITIC", 
        align = "c", 
        digits = 7) %>%
  kable_material(html_font = "sans-serif")

Ponderadores netos, método CRITIC
S3	S4	S8
0.2861207	0.4643701	0.2495092

#Ponderadores:
ponderadores_A <- round(wj_A*100,2)
ponderadores_A %>% head() %>% 
  kable(caption = "Ponderadores, método CRITIC", 
        align = "c", 
        digits = 2) %>%
  kable_material(html_font = "sans-serif")

Ponderadores, método CRITIC
S3	S4	S8
28.61	46.44	24.95

Ejercicio 3.

Para el factor 2, utilice el método de Entropía para obtener los ponderadores normalizados para cada variable.

library(dplyr)
#Normalización de los datos
datos_parcial_2 %>% dplyr::select(X1,X2,X7) -> data_norm_A
apply(data_norm_A,2,prop.table) -> data_norm_A
data_norm_A %>% head() %>% 
  kable(caption = "Datos normalizados, método Entropía", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Datos normalizados, método Entropía
X1	X2	X7
0.007812	0.000707	0.001399
0.008681	0.002122	0.007692
0.008681	0.007073	0.011189
0.006944	0.001061	0.024476
0.006076	0.002476	0.005594
0.005208	0.004598	0.017483

#Fórmula del método de entropía
entropia_A <- function(x){
  return(x*log(x))
}
apply(data_norm_A,2,entropia_A) -> data_norm_A_2
data_norm_A_2 %>% head() %>% 
  kable(caption = "Fórmula, método Entropía", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Fórmula, método Entropía
X1	X2	X7
-0.037906	-0.005131	-0.009192
-0.041204	-0.013062	-0.037443
-0.041204	-0.035023	-0.050270
-0.034513	-0.007266	-0.090806
-0.031010	-0.014857	-0.029013
-0.027383	-0.024746	-0.070744

#Número de variables en el factor:
ncol(data_norm_A) -> m_A
#Constante de entropía:
-1/log(m_A) -> K_A
K_A %>% head() %>% 
  kable(caption = "Constante, método Entropía", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Constante, método Entropía
x
-0.910239

#Cálculo de las entropías
K_A*colSums(data_norm_A_2) -> EJM_A
EJM_A %>% head() %>% 
  kable(caption = "Entropías", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Entropías
	x
X1	4.180549
X2	3.202899
X7	3.701923

#Cálculo de las especificidades:
1-EJM_A -> vj_A
vj_A %>% head() %>% 
  kable(caption = "Especificidades, método Entropía", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Especificidades, método Entropía
	x
X1	-3.180549
X2	-2.202899
X7	-2.701923

#Cálculo de los ponderadores:
prop.table(vj_A) -> wj_A 
wj_A %>% head() %>% 
  kable(caption = "Ponderadores, método Entropía", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Ponderadores, método Entropía
	x
X1	0.393371
X2	0.272455
X7	0.334174

Ejercicio 4.

Para el factor 3, utilice el método de Ranking para obtener los ponderadores normalizados para cada variable (utilice la numeración de las variables para establecer la jerarquía).

Jerarquía de Suma

library(magrittr)

# Vector de Jerarquías
rj_A <- c(1,2)
names(rj_A) <- c("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_A <- ponderadores_subjetivos_ranking_suma(rj_A)
#Pesos brutos
pesos_brutos_suma_A <- pesos_ranking_suma_A$w_brutos
pesos_brutos_suma_A %>% head() %>% 
  kable(caption = "Pesos brutos - Método Ranking - Jerarquía de Suma", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Pesos brutos - Método Ranking - Jerarquía de Suma
	x
X5	2
X6	1

#Pesos normalizados
pesos_normalizados_A <- pesos_ranking_suma_A$w_normalizados %>% round(digits = 3)
pesos_normalizados_A %>% head() %>% 
  kable(caption = "Pesos normalizados - Método Ranking - Jerarquía de Suma", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Pesos normalizados - Método Ranking - Jerarquía de Suma
	x
X5	0.667
X6	0.333

#Gráfico de los pesos normalizados
barplot(pesos_ranking_suma_A$w_normalizados,
        main = "Ponderadores Ranking de Suma",
        ylim = c(0,0.9),col = "red")

Jerarquía Recíproca

library(magrittr)

#Vector de Jerarquías
rj_A <- c(1,2)
names(rj_A) <- c("X5", "X6")

#Función para generar los pesos
ponderadores_subjetivos_ranking_reciproco <- function(vector_jerarquias){
  vector_pesos <- 1/vector_jerarquias
  list(w_brutos = vector_pesos,
       w_normalizados = vector_pesos/sum(vector_pesos))
}
#Aplicando la función:
pesos_ranking_reciproco_A <- ponderadores_subjetivos_ranking_reciproco(rj_A)
#Pesos brutos
pesos_brutos_reciproco_A <- pesos_ranking_reciproco_A$w_brutos
pesos_brutos_reciproco_A %>% head() %>% 
  kable(caption = "Pesos brutos - Método Ranking - Jerarquía Recíproca", 
        align = "c", 
        digits = 2) %>%
  kable_material(html_font = "sans-serif")

Pesos brutos - Método Ranking - Jerarquía Recíproca
	x
X5	1.0
X6	0.5

#Pesos normalizados
pesos_normalizados_reciproco_A <- pesos_ranking_reciproco_A$w_normalizados %>% round(digits = 3)
pesos_normalizados_reciproco_A %>% head() %>% 
  kable(caption = "Pesos normalizados - Método Ranking - Jerarquía Recíproca", 
        align = "c", 
        digits = 3) %>%
  kable_material(html_font = "sans-serif")

Pesos normalizados - Método Ranking - Jerarquía Recíproca
	x
X5	0.667
X6	0.333

#Gráfico de los pesos normalizados
barplot(pesos_ranking_reciproco_A$w_normalizados,
        main = "Ponderadores Ranking Recíproco",
        ylim = c(0,0.9),col = "blue")

Jerarquía Exponencial

library(magrittr)

#Vector de Jerarquías
rj_a <- c(1,2)
names(rj_a) <- c("X5", "X6")

#Función para generar los pesos
ponderadores_subjetivos_ranking_exponencial <- function(vector_jerarquias,p=2){
  n <- length(vector_jerarquias)
  vector_pesos <- (n-vector_jerarquias+1)^p
  list(w_brutos = vector_pesos,
       w_normalizados = vector_pesos/sum(vector_pesos))
}
#Aplicando la función:
pesos_ranking_exponencial_A<-ponderadores_subjetivos_ranking_exponencial(rj_a)
#Pesos brutos
pesos_brutos_exponencial_A <- pesos_ranking_exponencial_A$w_brutos
pesos_brutos_exponencial_A %>% head() %>% 
  kable(caption = "Pesos brutos - Método Ranking - Jerarquía Exponencial", 
        align = "c") %>%
  kable_material(html_font = "sans-serif")

Pesos brutos - Método Ranking - Jerarquía Exponencial
	x
X5	4
X6	1

#Pesos normalizados
pesos_normalizados_exponencial_A <- pesos_ranking_exponencial_A$w_normalizados %>% round(digits = 3)
pesos_normalizados_exponencial_A %>% head() %>% 
  kable(caption = "Pesos normalizados - Método Ranking - Jerarquía Exponencial", 
        align = "c",
        digits = 2) %>%
  kable_material(html_font = "sans-serif")

Pesos normalizados - Método Ranking - Jerarquía Exponencial
	x
X5	0.8
X6	0.2

#Gráfico de los pesos normalizados (por default p=2)
barplot(pesos_ranking_suma_A$w_normalizados,
        main = "Ponderadores Ranking Exponencial",
        ylim = c(0,1),col = "lightblue")

#Comparación de valores de "p"

par(mfrow=c(1,3))
for(p in 2:4){
  
  pesos_A <- ponderadores_subjetivos_ranking_exponencial(vector_jerarquias = rj_A,
                                                    p = p)
  barplot(pesos_A$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.

Exámen Clave B

Sección I

Se pretende construir un indicador multivariado sintético sobre el Desarrollo en las Economías.

Los indicadores a considerar son*:

El índice de alfabetización (alfabet)[+]
El incremento de la población (inc_pob)[+]
La esperanza de vida femenina (espvidaf)[+]
La mortalidad infantil (mortinf)[-]
El número promedio de hijos por mujer (fertilid)[+]
La tasa de natalidad (tasa_nat)[+]
El logaritmo del PIB (log_pib)[+]
La población urbana (urbana)[+]
La tasa de mortalidad (tasa_mor)[-]

*Entre Corchetes aparece la correlación teórica esperada entre la variable compleja y el indicador.

Todas las variables se encuentran el archivo data_parcial_2_B.Rdata

Todas los indicadores se encuentran el archivo data_parcial_2_B.Rdata

Ejercicio 1.

Usando Análisis Factorial determine cuántos factores deberían retenerse.

library(dplyr)
library(kableExtra)
load("/cloud/project/data_parcial_2_B_rev.RData")
data_parcial_2 %>% head() %>% 
  kable(caption = "Matriz de variables para el Desarrollo en las Economías", 
        align = "c", 
        digits = 4) %>%
  kable_material(html_font = "sans-serif")

Matriz de variables para el Desarrollo en las Economías
PAÍS	POBLAC	DENSIDAD	URBANA	RELIG	ESPVIDAF	ESPVIDAM	ALFABET	INC_POB	MORTINF	PIB_CAP	REGIÓN	CALORÍAS	SIDA	TASA_NAT	TASA_MOR	TASASIDA	LOG_PIB	LOGTSIDA	NAC_DEF	FERTILID	LOG_POB	CREGRANO	ALFABMAS	ALFABFEM	CLIMA
Acerbaján	7400	86.0	54	Musulma.	75	67	98	1.40	35.0	3000	5	NA	NA	23	7	NA	3.4771	NA	3.2857	2.80	3.8692	18	100	100	3
Afganistán	20500	25.0	18	Musulma.	44	45	29	2.80	168.0	205	3	NA	0	53	22	0.0000	2.3118	0.0000	2.4091	6.90	4.3118	12	44	14	3
Alemania	81200	227.0	85	Protest.	79	73	99	0.36	6.5	17539	1	3443	11179	11	11	13.7672	4.2440	1.6895	1.0000	1.47	4.9096	34	NA	NA	8
Arabia Saudí	18000	7.7	77	Musulma.	70	66	62	3.20	52.0	6651	5	2874	61	38	6	0.3389	3.8229	0.8054	6.3333	6.67	4.2553	1	73	48	1
Argentina	33900	12.0	86	Católica	75	68	95	1.30	25.6	3408	6	3113	3904	20	9	11.5162	3.5325	1.6303	2.2222	2.80	4.5302	9	96	95	8
Armenia	3700	126.0	68	Ortodoxa	75	68	98	1.40	27.0	5000	5	NA	2	23	6	0.0541	3.6990	0.5579	3.8333	3.19	3.5682	17	100	100	NA

Normalización de los datos

library(dplyr)
library(tidyr)

norm_directa_a<-function(x){(x-min(x))/(max(x)-min(x))}
norm_inversa_B<-function(x){(max(x)-x)/(max(x)-min(x))}

data_parcial_2 %>% replace_na(list(ALFABET = 0, INC_POB = 0, ESPVIDAF = 0, MORTINF = 0, FERTILID = 0, TASA_NAT = 0, LOG_PIB = 0, URBANA = 0, TASA_MOR = 0)) -> data_parcial_2

#Seleccionando las variables con correlación positiva para el Desarrollo en las Economías
data_parcial_2 %>% 
  select(ALFABET, INC_POB, ESPVIDAF, FERTILID, TASA_NAT, LOG_PIB, URBANA) %>% 
  apply(MARGIN = 2,FUN = norm_directa_a) %>% as.data.frame() -> variables_corr_positiva_B

#Seleccionando las variables con correlación negativa para el Desarrollo en las Economías
data_parcial_2 %>% 
  select(MORTINF, TASA_MOR) %>% 
  apply(MARGIN = 2,FUN = norm_inversa_B) %>% as.data.frame() -> variables_corr_negativa_B

#Uniendo y reordenando las variables
variables_corr_positiva_B %>% 
  bind_cols(variables_corr_negativa_B) %>% 
  select(ALFABET, INC_POB, ESPVIDAF, MORTINF, FERTILID, TASA_NAT, LOG_PIB, URBANA, TASA_MOR) -> datos_desarrollo_normalizados
datos_desarrollo_normalizados %>% head() %>% 
  kable(caption = "Datos Normalizados", 
        align = "c") %>%
  kable_material(html_font = "sans-serif")

Datos Normalizados
ALFABET	INC_POB	ESPVIDAF	MORTINF	FERTILID	TASA_NAT	LOG_PIB	URBANA	TASA_MOR
0.98	0.3068592	0.8205128	0.8109756	0.3418803	0.3023256	0.6088542	0.54	0.7083333
0.29	0.5595668	0.0256410	0.0000000	0.8424908	1.0000000	0.0986741	0.18	0.0833333
0.99	0.1191336	0.9230769	0.9847561	0.1794872	0.0232558	0.9445842	0.85	0.5416667
0.62	0.6317690	0.6923077	0.7073171	0.8144078	0.6511628	0.7602252	0.77	0.7500000
0.95	0.2888087	0.8205128	0.8682927	0.3418803	0.2325581	0.6330980	0.86	0.6250000
0.98	0.3068592	0.8205128	0.8597561	0.3894994	0.3023256	0.7059762	0.68	0.7500000

Matriz de Correlación & Pruebas de Barlett y KMO

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

La mayoría de las correlaciones son significativas a más del 1%. Hay una evidente correlación entre las variables propuestas en la batería de indicadores.

library(rela)
#KMO
KMO_B <- paf(as.matrix(datos_desarrollo_normalizados))$KMO
print(KMO_B)

## [1] 0.85275

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.85, por lo tanto es apropiado continuar con el análisis.

library(psych)
#Prueba de Barlett
options(scipen = 99999)
Barlett_B <- cortest.bartlett(datos_desarrollo_normalizados)
print(Barlett_B)

## $chisq
## [1] 1478.1
## 
## $p.value
## [1] 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000017846
## 
## $df
## [1] 36

library(FactoMineR)
library(factoextra)
library(kableExtra)

Rx_B <- cor(datos_desarrollo_normalizados)
PC_B <- princomp(x = datos_desarrollo_normalizados,
               cor = TRUE,
               fix_sign = FALSE)
variables_pca_B <- get_pca_var(PC_B)
factoextra::get_eig(PC_B) %>% 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	6.45	71.63	71.63
Dim.2	1.24	13.81	85.44
Dim.3	0.56	6.18	91.62
Dim.4	0.39	4.36	95.98
Dim.5	0.18	2.01	97.99
Dim.6	0.08	0.86	98.85
Dim.7	0.06	0.64	99.49
Dim.8	0.03	0.32	99.81
Dim.9	0.02	0.19	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 dos variables, (Dim 1 y Dim 2) ya que estas 2 variables son superior a $3/4$ partes de la varianza total.

Gráfico de Sedimentación

fviz_eig(PC_B,
         choice = "eigenvalue",
         barcolor = "yellow",
         barfill = "yellow",
         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 el segundo componente. Los criterios de extracción se satisfacen en la misma.

Ejercicio 2.

¿Qué variables quedan representadas en cada factor?

Utilizando corrplot y psych en un modelo de 2 factores

library(corrplot)
library(psych)

# Modelo de 2 Factores (Rotada)
numero_de_factores_B <- 2
modelo_factores_B <- principal(r = Rx_B,
                               nfactors = numero_de_factores_B,
                               covar = FALSE,
                               rotate = "varimax")
print(modelo_factores_B)

## Principal Components Analysis
## Call: principal(r = Rx_B, nfactors = numero_de_factores_B, rotate = "varimax", 
##     covar = FALSE)
## Standardized loadings (pattern matrix) based upon correlation matrix
##            RC1   RC2   h2    u2 com
## ALFABET   0.70  0.51 0.74 0.260 1.8
## INC_POB  -0.98  0.04 0.96 0.041 1.0
## ESPVIDAF  0.62  0.76 0.95 0.048 1.9
## MORTINF   0.65  0.71 0.92 0.075 2.0
## FERTILID -0.87 -0.40 0.91 0.091 1.4
## TASA_NAT -0.90 -0.40 0.96 0.036 1.4
## LOG_PIB   0.62  0.59 0.73 0.270 2.0
## URBANA    0.39  0.71 0.66 0.342 1.6
## TASA_MOR -0.03  0.92 0.85 0.148 1.0
## 
##                        RC1  RC2
## SS loadings           4.35 3.34
## Proportion Var        0.48 0.37
## Cumulative Var        0.48 0.85
## Proportion Explained  0.57 0.43
## Cumulative Proportion 0.57 1.00
## 
## Mean item complexity =  1.6
## Test of the hypothesis that 2 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 2 factores, la primer variable el 0.74% de su varianza explicada por la solución. La segunda variable el 0.96% de su varianza explicada por la extracción. Por lo tanto, es una solución representativa de los datos originales.

En los ponderadores que se han extraído, la primera variable que se construya va a tener un ponderador de 0.57, la segunda tendrá un ponderador de 0.43.

correlaciones_modelo_B <- variables_pca_B$coord
rotacion_B <- varimax(correlaciones_modelo_B[,1:numero_de_factores_B])
correlaciones_modelo_rotada_B <- rotacion_B$loadings

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

La Dimensión 1, está explicado por ALFABET, INC_POB, FERTILID, TASA_NAT y LOG_PIB.
La Dimensión 2, está explicado por ESPVIDAF, MORTINF, URBANA Y TASA_MOR.

Ejercicio 3.

Determine qué pesos deben asignarse a cada factor y a las variables dentro de cada uno de ellos.

library(kableExtra)

cargas_B <- rotacion_B$loadings[1:9,1:numero_de_factores_B]
ponderadores_B <- prop.table(apply(cargas_B^2,MARGIN = 2,sum))
t(ponderadores_B) %>% kable(caption = "Ponderadores de los Factores Extraídos",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

Ponderadores de los Factores Extraídos
Dim.1	Dim.2
0.57	0.43

Para el factor 1 se le debe asignar un peso del 57% y al factor 2 un peso del 43%.

contribuciones_B <- apply(cargas_B^2, 
                          MARGIN = 2,
                          prop.table)
contribuciones_B %>% kable(caption="Contribución de las variables en los Factores",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

Contribución de las variables en los Factores
	Dim.1	Dim.2
ALFABET	0.11	0.08
INC_POB	0.22	0.00
ESPVIDAF	0.09	0.17
MORTINF	0.10	0.15
FERTILID	0.17	0.05
TASA_NAT	0.19	0.05
LOG_PIB	0.09	0.10
URBANA	0.04	0.15
TASA_MOR	0.00	0.25

Sección II

Una empresa se encuentra calculando un Indicador del desempeño de sus líneas de producción, para ello no dispone de información previa, pero hay una importante

consultora que posee expertos en el sector donde se ubica la empresa en cuestión.

La consultora, ha han determinado 4 variables que definen adecuadamente el desempeño de las líneas de producción:

X1: Mantenimiento de la línea de producción
X2: Tamaño de planta
X3: Logística (entradas y salidas de insumos y producción)
X4: Capacidad de innovación.

La consultora jerarquizó las variables de la siguiente manera:

Variable	X1	X2	X3	X4
Ranking	3	4	2	1

Dentro de la consultora hay 3 expertos que propusieron la jerarquía anterior, pero también realizaron un ejercicio de comparación por pares y los resultados fueron los siguientes:

Ejercicio 1.

Calcule los pesos normalizados, de las variables, usando los métodos de ranking directo, por suma, por reciproco y por ranking exponencial (use p=4)

Jerarquía de Suma

library(magrittr)

#Vector de Jerarquías
rj_b <- c(3, 4, 2, 1)
names(rj_b) <- c("X1", "X2", "X3", "X4")
#Función para generar los pesos
ponderadores_subjetivos_rank_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_b <- ponderadores_subjetivos_rank_suma(rj_b)
#Pesos brutos
pesos_brutos_suma_b <- pesos_ranking_suma_b$w_brutos
pesos_brutos_suma_b %>% head() %>% 
  kable(caption = "Pesos brutos - Método Ranking - Jerarquía de Suma", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Pesos brutos - Método Ranking - Jerarquía de Suma
	x
X1	2
X2	1
X3	3
X4	4

library(magrittr)
#Pesos normalizados
pesos_normalizados_b <- pesos_ranking_suma_b$w_normalizados %>% round(digits = 3)
pesos_normalizados_b %>% head() %>% 
  kable(caption = "Pesos normalizados - Método Ranking - Jerarquía de Suma", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Pesos normalizados - Método Ranking - Jerarquía de Suma
	x
X1	0.2
X2	0.1
X3	0.3
X4	0.4

library(magrittr)
#Gráfico de los pesos normalizados
barplot(pesos_ranking_suma_b$w_normalizados,
        main = "Ponderadores Ranking de Suma",
        ylim = c(0,0.5),col = "red")

Jerarquía Recíproca

library(magrittr)

#Vector de Jerarquías
rj_b <- c(3, 4, 2, 1)
names(rj_b) <- c("X1", "X2", "X3", "X4")

#Función para generar los pesos
ponderadores_subjetivos_rank_reciproco <- function(vector_jerarquias){
  vector_pesos <- 1/vector_jerarquias
  list(w_brutos = vector_pesos,
       w_normalizados = vector_pesos/sum(vector_pesos))
}
#Aplicando la función:
pesos_ranking_reciproco_B <- ponderadores_subjetivos_rank_reciproco(rj_b)
#Pesos brutos
pesos_brutos_reciproco_B <- pesos_ranking_reciproco_B$w_brutos
pesos_brutos_reciproco_B %>% head() %>% 
  kable(caption = "Pesos brutos - Método Ranking - Jerarquía Recíproca", 
        align = "c", 
        digits = 2) %>%
  kable_material(html_font = "sans-serif")

Pesos brutos - Método Ranking - Jerarquía Recíproca
	x
X1	0.33
X2	0.25
X3	0.50
X4	1.00

library(magrittr)
#Pesos normalizados
pesos_normalizados_reciproco_B <- pesos_ranking_reciproco_B$w_normalizados %>% round(digits = 3)
pesos_normalizados_reciproco_B %>% head() %>% 
  kable(caption = "Pesos normalizado - Método Ranking - Jerarquía Recíproca", 
        align = "c", 
        digits = 3) %>%
  kable_material(html_font = "sans-serif")

Pesos normalizado - Método Ranking - Jerarquía Recíproca
	x
X1	0.16
X2	0.12
X3	0.24
X4	0.48

library(magrittr)
#Gráfico de los pesos normalizados
barplot(pesos_ranking_reciproco_B$w_normalizados,
        main = "Ponderadores Ranking Recíproco",
        ylim = c(0,0.6),col = "blue")

Jerarquía Exponencial

library(magrittr)

# Vector de Jerarquías
rj_b <- c(3, 4, 2, 1)
names(rj_b) <- c("X1", "X2", "X3", "X4")
# Función para generar los pesos
ponderadores_subjetivos_rankg_exponencial <- function(vector_jerarquias,p=4){
  n <- length(vector_jerarquias)
  vector_pesos <- (n-vector_jerarquias+1)^p
  list(w_brutos = vector_pesos,
       w_normalizados = vector_pesos/sum(vector_pesos))
}
# Aplicando la función:
pesos_ranking_exponencial_b <- ponderadores_subjetivos_rankg_exponencial(rj_b)
# Pesos brutos
pesos_brutos_exponencial_b <- pesos_ranking_exponencial_b$w_brutos
pesos_brutos_exponencial_b %>% head() %>% 
  kable(caption = "Pesos brutos - Método Ranking - Jerarquía Exponencial", 
        align = "c") %>%
  kable_material(html_font = "sans-serif")

Pesos brutos - Método Ranking - Jerarquía Exponencial
	x
X1	16
X2	1
X3	81
X4	256

library(magrittr)
# Pesos normalizados
pesos_normalizados_exponencial_b <- pesos_ranking_exponencial_b$w_normalizados %>% round(digits = 3)
pesos_normalizados_exponencial_b %>% head() %>% 
  kable(caption = "Pesos normalizados - Método Ranking - Jerarquía Exponencial", 
        align = "c",
        digits = 1) %>%
  kable_material(html_font = "sans-serif")

Pesos normalizados - Método Ranking - Jerarquía Exponencial
	x
X1	0.0
X2	0.0
X3	0.2
X4	0.7

library(magrittr)
#Gráfico de los pesos normalizados (donde por default p=2)
barplot(pesos_ranking_suma_b$w_normalizados,
        main = "Ponderadores Ranking Exponencial",
        ylim = c(0,0.5),col = "lightblue")

#Comparación de valores de "p"

par(mfrow=c(1,3))
for(p in 2:4){
  
  pesos_b <- ponderadores_subjetivos_rankg_exponencial(vector_jerarquias = rj_b,
                                                      p = p)
  barplot(pesos_b$w_normalizados,
          main = paste0("p=",p),
          ylim = c(0,1),
          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.

Ejercicio 2.

Usando la técnica de comparación por pares, calcule los pesos normalizados para las variables:

Experto 1

library(FuzzyAHP)
#Matriz comparación Experto 1
valores_matcomp_experto1 = c(1,7,4,5,
                                      NA,1,6,3,
                                      NA,NA,1,2,
                                      NA,NA,NA,1)
matcomp_experto1 <- matrix(valores_matcomp_experto1,
                                    nrow = 4, 
                                    ncol = 4, 
                                    byrow = TRUE)
matcomp_experto1 <- pairwiseComparisonMatrix(matcomp_experto1)
matcomp_experto1@variableNames <- c("X1", "X2", "X3", "X4")
show(matcomp_experto1)

## An object of class "PairwiseComparisonMatrix"
## Slot "valuesChar":
##      [,1]  [,2]  [,3]  [,4]
## [1,] "1"   "7"   "4"   "5" 
## [2,] "1/7" "1"   "6"   "3" 
## [3,] "1/4" "1/6" "1"   "2" 
## [4,] "1/5" "1/3" "1/2" "1" 
## 
## Slot "values":
##         [,1]    [,2] [,3] [,4]
## [1,] 1.00000 7.00000  4.0    5
## [2,] 0.14286 1.00000  6.0    3
## [3,] 0.25000 0.16667  1.0    2
## [4,] 0.20000 0.33333  0.5    1
## 
## Slot "variableNames":
## [1] "X1" "X2" "X3" "X4"

#Cálculo de los pesos:
pesos_normalizados_experto1 = calculateWeights(matcomp_experto1)
show(pesos_normalizados_experto1)

## An object of class "Weights"
## Slot "weights":
##     w_X1     w_X2     w_X3     w_X4 
## 0.606592 0.223310 0.094748 0.075350

#Gráfica de ponderadores por comparación
barplot(pesos_normalizados_experto1@weights,
        main = "Ponderadores por comparación de pares de Experto 1",
        ylim = c(0,0.7),
        col = "pink")

Experto 2

library(FuzzyAHP)
#Matriz de comparación Experto 2
valores_matcomp_experto2 = c(1,7,6,3,
                                      NA,1,5,2,
                                      NA,NA,1,4,
                                      NA,NA,NA,1)
matcomp_experto2 <- matrix(valores_matcomp_experto2,
                                  nrow = 4, 
                                  ncol = 4, 
                                  byrow = TRUE)
matcomp_experto2 <- pairwiseComparisonMatrix(matcomp_experto2)
matcomp_experto2@variableNames <- c("X1", "X2", "X3", "X4")
show(matcomp_experto2)

## An object of class "PairwiseComparisonMatrix"
## Slot "valuesChar":
##      [,1]  [,2]  [,3]  [,4]
## [1,] "1"   "7"   "6"   "3" 
## [2,] "1/7" "1"   "5"   "2" 
## [3,] "1/6" "1/5" "1"   "4" 
## [4,] "1/3" "1/2" "1/4" "1" 
## 
## Slot "values":
##         [,1] [,2] [,3] [,4]
## [1,] 1.00000  7.0 6.00    3
## [2,] 0.14286  1.0 5.00    2
## [3,] 0.16667  0.2 1.00    4
## [4,] 0.33333  0.5 0.25    1
## 
## Slot "variableNames":
## [1] "X1" "X2" "X3" "X4"

#Cálculo de los pesos:
pesos_normalizados_experto2 = calculateWeights(matcomp_experto2)
show(pesos_normalizados_experto2)

## An object of class "Weights"
## Slot "weights":
##    w_X1    w_X2    w_X3    w_X4 
## 0.60919 0.19879 0.10987 0.08215

#Gráfica de ponderadores por comparación 
barplot(pesos_normalizados_experto2@weights,
        main = "Ponderadores por comparación de pares de Experto 2",
        ylim = c(0,0.7),
        col = "orange")

Experto 3

library(FuzzyAHP)
#Matriz de comparación Experto 3
valores_matcomp_experto3 = c(1,7,5,4,
                                      NA,1,3,2,
                                      NA,NA,1,6,
                                      NA,NA,NA,1)
matcomp_experto3 <- matrix(valores_matcomp_experto3,
                                    nrow = 4, 
                                    ncol = 4, 
                                    byrow = TRUE)
matcomp_experto3 <- pairwiseComparisonMatrix(matcomp_experto3)
matcomp_experto3@variableNames <- c("X1", "X2", "X3", "X4")
show(matcomp_experto3)

## An object of class "PairwiseComparisonMatrix"
## Slot "valuesChar":
##      [,1]  [,2]  [,3]  [,4]
## [1,] "1"   "7"   "5"   "4" 
## [2,] "1/7" "1"   "3"   "2" 
## [3,] "1/5" "1/3" "1"   "6" 
## [4,] "1/4" "1/2" "1/6" "1" 
## 
## Slot "values":
##         [,1]    [,2]    [,3] [,4]
## [1,] 1.00000 7.00000 5.00000    4
## [2,] 0.14286 1.00000 3.00000    2
## [3,] 0.20000 0.33333 1.00000    6
## [4,] 0.25000 0.50000 0.16667    1
## 
## Slot "variableNames":
## [1] "X1" "X2" "X3" "X4"

#Cálculo de los pesos:
pesos_normalizados_experto3 = calculateWeights(matcomp_experto3)
show(pesos_normalizados_experto3)

## An object of class "Weights"
## Slot "weights":
##    w_X1    w_X2    w_X3    w_X4 
## 0.61676 0.17252 0.14259 0.06812

#Gráfica de ponderadores por comparación
barplot(pesos_normalizados_experto3@weights,
        main = "Ponderadores por comparación de pares de Experto 3",
        ylim = c(0,0.7),
        col = "yellow")

Parte 1

Asumiendo que la opinión de los 3 expertos es igualmente válida.

library(kableExtra)

ponderacion_igual <- 1/3
ponderacion_expertos_1 <- (pesos_normalizados_experto1@weights+pesos_normalizados_experto2@weights+pesos_normalizados_experto3@weights)

promedio_1 <- ponderacion_igual*ponderacion_expertos_1
promedio_1 %>% head() %>% 
  kable(caption = "Ponderación, Expertos con igual ponderación", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Ponderación, Expertos con igual ponderación
	x
w_X1	0.610848
w_X2	0.198207
w_X3	0.115739
w_X4	0.075207

sum(promedio_1)

## [1] 1

library(kableExtra)
pesos_normalizados_expertos123_1 <- promedio_1/sum(promedio_1)
pesos_normalizados_expertos123_1 %>% head() %>% 
  kable(caption = "Pesos normalizados, Expertos con igual ponderación", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Pesos normalizados, Expertos con igual ponderación
	x
w_X1	0.610848
w_X2	0.198207
w_X3	0.115739
w_X4	0.075207

Parte 2

Si el experto 1 se pondera con 0.25, el experto 2 con 0.35 y el experto 3 con 0.4.

library(kableExtra)
ponderacion_expertos_2 <- (pesos_normalizados_experto1@weights*0.25)+
  (pesos_normalizados_experto2@weights*0.35)+
  (pesos_normalizados_experto3@weights*0.4)
ponderacion_expertos_2 %>% head() %>% 
  kable(caption = "Ponderación, Expertos con poderación asignada", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Ponderación, Expertos con poderación asignada
	x
w_X1	0.611569
w_X2	0.194412
w_X3	0.119180
w_X4	0.074838

sum(ponderacion_expertos_2)

## [1] 1

library(kableExtra)
pesos_normalizados_expertos123_2 <- ponderacion_expertos_2/sum(ponderacion_expertos_2)
pesos_normalizados_expertos123_2 %>% head() %>% 
  kable(caption = "Pesos normalizados, Expertos con ponderación asignada", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "sans-serif")

Pesos normalizados, Expertos con ponderación asignada
	x
w_X1	0.611569
w_X2	0.194412
w_X3	0.119180
w_X4	0.074838

Practica_Unidad_2_MAE_2022

JENNIFER SARAI FLORES MELENDEZ

2022-10-25

Exámen Clave A

Ejercicio 1.

Importación de los datos

Matriz de Información

Normalización de los datos

Matriz de Correlación & Pruebas de Barlett y KMO

Análisis Factorial

Gráfico de Sedimentación

Utilizando Corrplot en un modelo de 3 factores con rotación

Ejercicio 2.

Normalización de datos y realización de cálculos:

Ejercicio 3.

Ejercicio 4.

Exámen Clave B

Sección I

Ejercicio 1.

Normalización de los datos

Matriz de Correlación & Pruebas de Barlett y KMO

Gráfico de Sedimentación

Ejercicio 2.

Utilizando corrplot y psych en un modelo de 2 factores

Ejercicio 3.

Sección II

Ejercicio 1.

Ejercicio 2.

Parte 1

Parte 2