Clave A

Desarrolle el siguiente ejercicio:

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

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.

library(dplyr)
library(kableExtra)

load("C:/Users/Jacqueline Vanessa/Desktop/UES/Ciclo II - 2022/MAE118/TAREAS/UNIDAD 2/Practica - unidad 2/data_parcial_2_A_rev.RData")
datos_parcial_2 %>% head() %>% 
  kable(caption = "Matriz de variables para la Seguridad Municipal", 
        align = "c", 
        digits = 4) %>%
  kable_material(html_font = "Time New Roman")

Matriz de variables para la Seguridad Municipal
ID	Municipio	X1	X2	X3	X4	X5	X6	X7	X8
1	ATIQUIZAYA	9	2	20.0000	20.0000	0.0000	0.0000	2	56.4000
2	EL CARMEN	10	6	62.5000	50.0000	37.5000	3.9474	11	147.3750
3	ALEGRIA	10	20	50.0000	50.0000	50.0000	2.5641	16	135.0000
4	SAN JULIAN	8	3	42.8571	42.8571	14.2857	1.3514	35	121.1429
5	TEJUTLA	7	7	75.0000	75.0000	75.0000	9.0909	8	202.5000
6	PASAQUINA	6	13	30.0000	30.0000	30.0000	8.1081	25	81.0000

library(dplyr)

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

# Seleccionando las variables con correlación positiva para la Seguridad Municipal
datos_parcial_2 %>% 
  select(X1,X2,X3,X5,X7,X8) %>% 
  apply(MARGIN = 2,FUN = norm_directa_a) %>% 
  as.data.frame() -> variables_corr_positiva_a

# Seleccionando las variables con correlación negativa para la Seguridad Municipal
datos_parcial_2 %>% 
  select(X4,X6) %>% 
  apply(MARGIN = 2,
        FUN = norm_inversa_a) %>% 
  as.data.frame() -> variables_corr_negativa_a

# Juntando y reordenando las variables
variables_corr_positiva_a %>% 
  bind_cols(variables_corr_negativa_a) %>% 
  select(X1,X2,X3,X4,X5,X6,X7,X8) -> datos_seguridad_normalizados
datos_seguridad_normalizados %>% head() %>% 
  kable(caption = "Datos normalizados", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "Time New Roman")

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

library(PerformanceAnalytics)

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

Varias de las correlaciones son significativas al 1%. Hay una evidente correlación entre las variables propuestas en la batería de indicadores, se puede ver esto a simple vista por los asteriscos.

library(rela)

# KMO
KMO_a <- paf(as.matrix(datos_seguridad_normalizados))$KMO
print(KMO_a)

## [1] 0.67931

El valor mínimo para considerar aceptable el análisis factorial es de 0.5 y la base de datos tiene el 0.68, podemos considerar que es adecuado hacer el análisis.

library(psych)

# Prueba de Barlett
options(scipen = 99999)
Barlett_a <- cortest.bartlett(datos_seguridad_normalizados)
print(Barlett_a)

## $chisq
## [1] 1025.9
## 
## $p.value
## [1] 0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000046951
## 
## $df
## [1] 28

El \(P-value\) es casi 0, quiere decir que se rechaza la hipótesis nula y no se rechaza la hipótesis alternativa, hay evidencia de correlación poblacional entre la batería de indicadores propuestas.

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

Rx_a <- cor(datos_seguridad_normalizados)
PC_a <- princomp(x = datos_seguridad_normalizados,
                 cor = TRUE,
                 fix_sign = FALSE)
variables_pca_a <- get_pca_var(PC_a)
factoextra::get_eig(PC_a) %>% kable(caption="Resumen de PCA",
                                  align = "c",
                                  digits = 2) %>% 
  kable_material(html_font = "Time New Roman") %>% 
  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

Podemos ver la cantidad de factores a retener:

Por el criterio de raíz latente: tendríamos 2 componentes.
Por el criterio de porcentaje acumulado de la varianza: tedríamos tres componentes ya que esas 3 son superior a las 3 cuartas partes de la varianza total.

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

Mediante este criterio se puede observar que el punto de quiebre ocurre en los primeros dos. Por el momento los criterios de extracción se mantienen entre 2 y 3 factores.

library(corrplot)
library(psych)

# Modelo de 3 Factores (Rotada)
numero_de_factores_a <- 3
modelo_factores_a <- principal(r = Rx_a,
                             nfactors = numero_de_factores_a,
                             covar = FALSE,
                             rotate = "varimax")
modelo_factores_a

## Principal Components Analysis
## Call: principal(r = Rx_a, 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 3 factores, en la primer variable, el 0.67% de su varianza es explicada por la solución. La segunda variable tiene un 0.71% de su varianza explicada por la extracción. De la tercer variable, el 0.95 de su varianza es explicada. Entonces es una solución representativa de los datos originales.

En los ponderadores (Proportion Explained) que se han extraído, la primera variable que se construya va a tener un ponderador de 0.44, la segunda de 0.31 y la tercera de 0.25.

b. Las variables incluidas en cada factor.

library(factoextra)

correlaciones_modelo_a <- variables_pca_a$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="grey",
         number.cex = 0.75)

Para la variable latente 1, está representada con \(X_3\), \(X_4\) y \(X_8\). La dimensión 2 está más asociada con \(X_1\), \(X_2\) y \(X_7\). La dimensión 3 está más asociada con \(X_5\) y \(X_6\).

library(kableExtra)

cargas_a <- rotacion_a$loadings[1:8,1:numero_de_factores_a]
ponderadores_a <- prop.table(apply(cargas_a^2,
                                   MARGIN = 2,sum))
t(ponderadores_a) %>% kable(caption="Ponderadores de los Factores Extraídos",
        align = "c",
        digits = 2) %>% 
  kable_material(html_font = "Time New Roman") %>% 
  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

Al 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_a^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 = "Time New Roman") %>% 
  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

Aquí se pueden observar los pesos que deberían tener cada una de las variables.

Ejercicio 2

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

Normalización de datos y 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_1_a
data_factor_1_a %>% head() %>% 
  kable(caption = "Datos normalizados - método CRITIC", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "Time New Roman")

Datos normalizados - método CRITIC
X3	X4	X8
0.04000	0.80000	0.15823
0.55000	0.50000	0.51675
0.40000	0.50000	0.46798
0.31429	0.57143	0.41337
0.70000	0.25000	0.73399
0.16000	0.70000	0.25517

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

Desviaciones estándar - método CRITIC
S3	S4	S8
0.24628	0.20111	0.20874

# Cálculo de la matriz de correlación
cor(data_factor_1_a) -> mat_R_F1_a
mat_R_F1_a %>% head() %>%
  kable(caption = "Matriz de correlación - método CRITIC", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "Time New Roman")

Matriz de correlación - método CRITIC
	X3	X4	X8
X3	1.00000	-0.93872	0.95905
X4	-0.93872	1.00000	-0.99585
X8	0.95905	-0.99585	1.00000

# Cálculo de los ponderadores brutos
1-mat_R_F1_a -> sum_data_a
colSums(sum_data_a) -> sum_vector_a
sd_vector_a*sum_vector_a -> vj_a
vj_a %>% head() %>% 
  kable(caption = "Ponderadores brutos - método CRITIC", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "Time New Roman")

Ponderadores brutos - método CRITIC
S3	S4	S8
0.48755	0.79129	0.42517

# 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 = "Time New Roman")

Ponderadores netos - método CRITIC
S3	S4	S8
0.28612	0.46437	0.24951

# 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 = "Time New Roman")

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 = "Time New Roman")

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 de entropía
entropy_a <- function(x){
  return(x*log(x))
}
apply(data_norm_a,2,entropy_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 = "Time New Roman")

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 = "Time New Roman")

Constante - método Entropía
x
-0.91024

# Cálculo de las entropías
K_a*colSums(data_norm_a_2) -> Ej_a
Ej_a %>% head() %>% 
  kable(caption = "Entropías", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "Time New Roman")

Entropías
	x
X1	4.1805
X2	3.2029
X7	3.7019

# Cálculo de las especificidades:
1-Ej_a -> vj_a
vj_a %>% head() %>% 
  kable(caption = "Especificidades - método Entropía", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "Time New Roman")

Especificidades - método Entropía
	x
X1	-3.1805
X2	-2.2029
X7	-2.7019

# 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 = "Time New Roman")

Ponderadores - método Entropía
	x
X1	0.39337
X2	0.27246
X7	0.33417

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_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_a <- ponderadores_subjetivos_rank_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 = "Time New Roman")

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 = "Time New Roman")

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 = "mediumslateblue")

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_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_a <- ponderadores_subjetivos_rank_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 = 1) %>%
  kable_material(html_font = "Time New Roman")

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 normalizado - método Ranking - Jerarquía Recíproca", 
        align = "c", 
        digits = 3) %>%
  kable_material(html_font = "Time New Roman")

Pesos normalizado - 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 = "slateblue")

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_rank_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_rank_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 = "Time New Roman")

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 = 1) %>%
  kable_material(html_font = "Time New Roman")

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 = "darkslateblue")

# Comparación de valores de "p"

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

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

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)[+] y la tasa de mortalidad (tasa_mor)[-].

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

Todas las varibles se encuentran en el archivo data_parcial_2_B.Rdata

Todas los indicadores se encuentran en el archivo data_parcial_2_B.Rdata

Parte 1

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

library(dplyr)
library(kableExtra)
load("C:/Users/Jacqueline Vanessa/Desktop/UES/Ciclo II - 2022/MAE118/TAREAS/UNIDAD 2/Practica - unidad 2/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 = "Time New Roman")

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

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

# Juntando 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 = "Time New Roman")

Datos normalizados
ALFABET	INC_POB	ESPVIDAF	MORTINF	FERTILID	TASA_NAT	LOG_PIB	URBANA	TASA_MOR
0.98	0.30686	0.82051	0.81098	0.34188	0.30233	0.60885	0.54	0.70833
0.29	0.55957	0.02564	0.00000	0.84249	1.00000	0.09867	0.18	0.08333
0.99	0.11913	0.92308	0.98476	0.17949	0.02326	0.94458	0.85	0.54167
0.62	0.63177	0.69231	0.70732	0.81441	0.65116	0.76023	0.77	0.75000
0.95	0.28881	0.82051	0.86829	0.34188	0.23256	0.63310	0.86	0.62500
0.98	0.30686	0.82051	0.85976	0.38950	0.30233	0.70598	0.68	0.75000

library(PerformanceAnalytics)

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

Casi todas las correlaciones son significativas al 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 para considerar aceptable el análisis factorial es de 0.5 y la base de datos tiene el 0.85, podemos considerar que es adecuado hacer 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 = "Time New Roman") %>% 
  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

Podemos ver la cantidad de factores a retener:

Por el criterio de raíz latente: solamente tendríamos dos componentes ya que ambos superan la unidad con 6.45 y 1.24 respectivamente.
Por el criterio de porcentaje acumulado de la varianza: también solo tedríamos dos componentes ya que ambos explican más del 75% de la varianza total.

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

Aquí podemos observar que el punto de quiebre se da en el segundo componente. Por el momento los criterios de extracción se satisfacen o concluyen de la misma manera.

Parte 2

¿Qué variables quedan representadas en cada factor?

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")
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

De la primer variable, el 0.74% de su varianza es explicada por la solución. La segunda variable tiene un 0.96% de su varianza explicada por la extracción. Entonces es una solución bastante representativa de los datos originales, se pierde muy poca información al sustituir la batería original de indicadores por los dos componentes que se han estimado.

En los ponderadores (Proportion Explained) que se han extraído, la primera variable va a tener un ponderador de 0.57 y otra 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="grey",
         number.cex = 0.75)

Para el factor 1, este está representad0 con ALFABET, INC_POB, FERTILID, TASA_NAT y LOG_PIB. El factor 2 está más asociado con ESPVIDAF, MORTINF, URBANA Y TASA_MOR.

Parte 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 = "Time New Roman") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

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

Al 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 = "Time New Roman") %>% 
  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

Aquí se pueden observar los pesos que deberían tener cada una de las variables.

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:

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 = "Time New Roman")

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

# 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 = "Time New Roman")

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

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

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 = 1) %>%
  kable_material(html_font = "Time New Roman")

Pesos brutos - método Ranking - Jerarquía Recíproca
	x
X1	0.3
X2	0.2
X3	0.5
X4	1.0

# 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 = "Time New Roman")

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

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

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_rank_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_rank_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 = "Time New Roman")

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

# 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 = "Time New Roman")

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

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

# Comparación de valores de "p"

par(mfrow=c(1,3))
for(p in 2:4){
  
  pesos_b <- ponderadores_subjetivos_rank_exponencial(vector_jerarquias = rj_b,
                                                      p = p)
  barplot(pesos_b$w_normalizados,
          main = paste0("p=",p),
          ylim = c(0,1),
          col = "thistle",
          cex.main = 3,
          cex.axis = 3)
}

A medida aumenta el valor de “p”, se saturan más las variables que tienen mayor importancia, pero se extrae 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)
valores_matriz_comparacion_exper1 = c(1,7,4,5,
                                      NA,1,6,3,
                                      NA,NA,1,2,
                                      NA,NA,NA,1)
matriz_comparacion_exper1 <- matrix(valores_matriz_comparacion_exper1,
                                    nrow = 4, 
                                    ncol = 4, 
                                    byrow = TRUE)
matriz_comparacion_exper1 <- pairwiseComparisonMatrix(matriz_comparacion_exper1)
matriz_comparacion_exper1@variableNames <- c("X1", "X2", "X3", "X4")
show(matriz_comparacion_exper1)

## 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_exper1 = calculateWeights(matriz_comparacion_exper1)
show(pesos_normalizados_exper1)

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

barplot(pesos_normalizados_exper1@weights,
        main = "Ponderadores por comparación de pares de Experto 1",
        ylim = c(0,0.7),
        col = "midnightblue")

Experto 2:

library(FuzzyAHP)
valores_matriz_comparacion_exper2 = c(1,7,6,3,
                                      NA,1,5,2,
                                      NA,NA,1,4,
                                      NA,NA,NA,1)
matriz_comparacion_exper2 <- matrix(valores_matriz_comparacion_exper2,
                                  nrow = 4, 
                                  ncol = 4, 
                                  byrow = TRUE)
matriz_comparacion_exper2 <- pairwiseComparisonMatrix(matriz_comparacion_exper2)
matriz_comparacion_exper2@variableNames <- c("X1", "X2", "X3", "X4")
show(matriz_comparacion_exper2)

## 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_exper2 = calculateWeights(matriz_comparacion_exper2)
show(pesos_normalizados_exper2)

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

barplot(pesos_normalizados_exper2@weights,
        main = "Ponderadores por comparación de pares de Experto 2",
        ylim = c(0,0.7),
        col = "midnightblue")

Experto 3:

library(FuzzyAHP)
valores_matriz_comparacion_exper3 = c(1,7,5,4,
                                      NA,1,3,2,
                                      NA,NA,1,6,
                                      NA,NA,NA,1)
matriz_comparacion_exper3 <- matrix(valores_matriz_comparacion_exper3,
                                    nrow = 4, 
                                    ncol = 4, 
                                    byrow = TRUE)
matriz_comparacion_exper3 <- pairwiseComparisonMatrix(matriz_comparacion_exper3)
matriz_comparacion_exper3@variableNames <- c("X1", "X2", "X3", "X4")
show(matriz_comparacion_exper3)

## 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_exper3 = calculateWeights(matriz_comparacion_exper3)
show(pesos_normalizados_exper3)

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

barplot(pesos_normalizados_exper3@weights,
        main = "Ponderadores por comparación de pares de Experto 3",
        ylim = c(0,0.7),
        col = "midnightblue")

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_exper1@weights+pesos_normalizados_exper2@weights+pesos_normalizados_exper3@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 = "Time New Roman")

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

pesos_normalizados_exper123_1 <- promedio_1/sum(promedio_1)
pesos_normalizados_exper123_1 %>% head() %>% 
  kable(caption = "Pesos normalizados - expertos con igual ponderación", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "Time New Roman")

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

ponderacion_expertos_2 <- (pesos_normalizados_exper1@weights*0.25)+
  (pesos_normalizados_exper2@weights*0.35)+
  (pesos_normalizados_exper3@weights*0.4)
ponderacion_expertos_2 %>% head() %>% 
  kable(caption = "Ponderación - expertos con poderación desigual", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "Time New Roman")

Ponderación - expertos con poderación desigual
	x
w_X1	0.611569
w_X2	0.194412
w_X3	0.119180
w_X4	0.074838

sum(ponderacion_expertos_2)

## [1] 1

pesos_normalizados_exper123_2 <- ponderacion_expertos_2/sum(ponderacion_expertos_2)
pesos_normalizados_exper123_2 %>% head() %>% 
  kable(caption = "Pesos normalizados - expertos con ponderación desigual", 
        align = "c", 
        digits = 6) %>%
  kable_material(html_font = "Time New Roman")

Pesos normalizados - expertos con ponderación desigual
	x
w_X1	0.611569
w_X2	0.194412
w_X3	0.119180
w_X4	0.074838

Práctica - Unidad 2

JACQUELINE VANESSA CLAROS RUIZ

Clave A

Ejercicio 1

Ejercicio 2

Ejercicio 3

Ejercicio 4

Clave B

Sección I

Parte 1

Parte 2

Parte 3

Sección II

Ejercicio 1

Ejercicio 2

Parte 1

Parte 2